Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/NEMO_book.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/NEMO_book.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/NEMO_book.tex	(revision 6808)
@@ -215,6 +215,6 @@
 %\date{\today}
 \date{
-November 2014  \\
-{\small  -- version 3.6 --} \\
+November 2015  \\
+{\small  -- draft of version 4.0 --} \\
 ~  \\
 \textit{\small Note du P\^ole de mod\'{e}lisation de l'Institut Pierre-Simon Laplace No 27 }\\
@@ -301,4 +301,6 @@
 
 \include{./TexFiles/Chapters/Chap_STO}          % Stochastic param.
+
+\include{./TexFiles/Chapters/Chap_DIU}          % Diurnal SST models.
 
 \include{./TexFiles/Chapters/Chap_MISC}			% Miscellaneous topics
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Biblio/Biblio.bib
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Biblio/Biblio.bib	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Biblio/Biblio.bib	(revision 6808)
@@ -149,4 +149,17 @@
   volume = {36},
   pages = {1502--1522}
+}
+
+@ARTICLE{Artale_al_JGR02,
+  author={V. Artale and D. Iudicone and R. Santoleri and V. Rupolo and S. Marullo
+          and F. {D'O}rtenzio},
+  title={{Role of surface fluxes in ocean general circulation models using satellite
+          sea surface temperature: Validation of and sensitivity to the forcing
+          frequency of the Mediterranean thermohaline circulation}},
+  journal=JGR,
+  year={2002},
+  volume={107},
+  pages={1978-2012},
+  doi = {10.1029/2000JC000452},
 }
 
@@ -276,7 +289,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}
 }
@@ -763,4 +776,12 @@
 }
 
+@PHDTHESIS{Demange_PhD2014,
+  author = {J. Farge},
+  title = {Sch\'{e}́mas num\'{e}́riques d’advection et de propagation d’ondes de gravit\'{e}́ 
+           dans les mod\`{e}les de circulation oc\'{e}́anique.},
+  school = {Doctorat es Applied Mathematiques, Grenoble University, France},
+  year = {2014},
+  pages = {138pp}
+}
 
 @ARTICLE{Dobricic_al_OS07,
@@ -983,5 +1004,5 @@
   author = {M. Farge},
   title = {Dynamique non lineaire des ondes et des tourbillons dans les equations de Saint Venant},
-  school = {Doctorat es Mathematiques, Paris VI University},
+  school = {Doctorat es Mathematiques, Paris VI University, France},
   year = {1987},
   pages = {401pp}
@@ -1059,4 +1080,16 @@
   volume = {20},  number = {1},
   pages = {150--155},
+}
+
+@Article{Gentemann_al_JGR09,
+  author = 	 {C. L. Gentemann  and P. J. Minnett and B. Ward},
+  title =        {Profiles of Ocean Surface heating ({POSH}): A new model 
+                  of upper ocean diurnal warming},
+  journal = 	 JGR,
+  year = 	 {2009},
+  Volume = 	 {114},
+  Pages = 	 {C07017},
+  doi = 	 {10.1029/2008JC004825},
+  OPTannote = 	 {}
 }
 
@@ -1122,4 +1155,14 @@
   doi = {10.1029/2006GL028210},
   url = {http://dx.doi.org/10.1029/2006GL028210}
+}
+
+@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}
 }
 
@@ -1347,4 +1390,13 @@
 }
 
+@ARTICLE{Holland1999, 
+  author = {D. Holland and A. Jenkins},
+  title = {Modeling Thermodynamic Ice-Ocean Interactions at the Base of an Ice Shelf},
+  journal = JPO,
+  year = {1999},
+  volume = {29},  
+  pages = {1787--1800},
+}
+
 @ARTICLE{HollowayOM86,
   author = {Greg Holloway},
@@ -1430,4 +1482,14 @@
 }
 
+@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}
+}
+
 @ARTICLE{Iudicone_al_JPO08b,
   author = {D. Iudicone and G. Madec and B. Blanke and S. Speich},
@@ -1493,4 +1555,22 @@
 }
 
+@ARTICLE{Jenkins1991,
+  author = {A. Jenkins},
+  title = {A one-dimensional model of ice shelf-ocean interaction},
+  journal = JGR,
+  year = {1991},
+  volume = {96},  number = {C11},
+  pages = {2298--2312}
+}
+
+@ARTICLE{Jenkins2010,
+  author = {A. Jenkins},
+  title = {observation and parameterization of ablation at the base of Ronne Ice Shelf, Antarctica},
+  journal = JPO,
+  year = {2010},
+  volume = {40},  number = {10},
+  pages = {2298--2312}
+}
+
 @BOOK{Jerlov_Bk68,
   title = {Optical Oceanography},
@@ -1643,4 +1723,17 @@
 }
 
+
+@ARTICLE{Lemarie_OM2015,
+  author = {F. Lemari\'{e} and L. Debreu and J. Demange and  G. Madec and J.M. Molines and M. Honnorat},
+  title = {Stability Constraints for Oceanic Numerical Models: 
+           Implications for the Formulation of time and space Discretizations},
+  journal = OM,
+  year = {2015},
+  volume = {92}, 
+  pages = {124--148},
+  doi = {10.1016/j.ocemod.2015.06.006},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2015.06.006}
+}
+
 @ARTICLE{Lermusiaux2001,
   author = {P. F. J. Lermusiaux},
@@ -1655,5 +1748,5 @@
   author = {M. L\'{e}vy},
   title = {Mod\'{e}lisation des processus biog\'{e}ochimiques en M\'{e}diterran\'{e}e
-	nord-occidentale. Cycle saisonnier et variabilit\'{e} m\'{e}so\'{e}chelle},
+	        nord-occidentale. Cycle saisonnier et variabilit\'{e} m\'{e}so\'{e}chelle},
   school = {Universit\'{e} Pierre et Marie Curie, Paris, France, 207pp},
   year = {1996}
@@ -1796,4 +1889,13 @@
 }
 
+@ARTICLE{Lele_JCP1992,
+  author = {S.K. Lele},
+  title = {Compact finite difference schemes with spectral-like resolution},
+  journal = JCP,
+  year = {1992},
+  volume = {103}
+  pages = {16--42}
+}
+
 @ARTICLE{Lengaigne_al_JC03,
   author = {M. Lengaigne and J.-P. Boulanger and C. Menkes and G. Madec and P.
@@ -1898,4 +2000,12 @@
   volume = {51},
   pages = {737--769}
+}
+
+@ARTICLE{Losch2008,
+  author = {M. Losch},
+  title = {Modeling ice shelf cavities in a z coordinate ocean general circulation model},
+  journal = JGR,
+  year = {2008},
+  volume = {113},  number = {C13},
 }
 
@@ -2488,4 +2598,27 @@
 }
 
+@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},
@@ -2514,4 +2647,14 @@
   volume = {87},
   pages = {394--409}
+}
+
+@ARTICLE{Saunders_JAS82,
+  author={P. M. Saunders},
+  title={{The Temperature at the Ocean-air Interface}},
+  journal=JAS,
+  year={1967},
+  volume={24},
+  pages={269-273},
+  doi = {10.1175/1520-0469(1967)024<0269:TTATOA>2.0.CO;2},
 }
 
@@ -2688,4 +2831,15 @@
   volume = {359},
   pages = {123--129}
+}
+
+@ARTICLE{Takaya_al_JGR10,
+  author = 	 {Y. Takaya and J-R. Bidlot and A. C. M. Beljaars and 
+                  P. A. E. M. Janssen},
+  title =        {Refinements to a prognostic scheme of sea surface skin temperature},
+  journal = 	 JGR,
+  year = 	 {2010},
+  Volume = 	 {115},
+  Pages = 	 {C06009},
+  doi = 	 {10.1029/2009JC005985},
 }
 
@@ -2793,4 +2947,14 @@
 }
 
+@ARTICLE{Tu_Tsuang_GRL05,
+  title={{Cool-skin simulation by a one-column ocean model}},
+  author={{C-Y}. Tu  and {B-J}. Tsuang},
+  journal=GRL,
+  year={2005},
+  volume={32},
+  pages={L22602},
+  doi = {10.1029/2005GL024252},
+}
+
 @ARTICLE{Umlauf_Burchard_JMS03,
   author = {L. Umlauf and H. Burchard},
@@ -2842,4 +3006,13 @@
   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/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Abstracts_Foreword.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Abstracts_Foreword.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Abstracts_Foreword.tex	(revision 6808)
@@ -13,13 +13,13 @@
 be a flexible tool for studying the ocean and its interactions with the others components of 
 the earth climate system over a wide range of space and time scales. 
-Prognostic variables are the three-dimensional velocity field, a linear 
-or non-linear sea surface height, the temperature and the salinity. In the horizontal direction, 
-the model uses a curvilinear orthogonal grid and in the vertical direction, a full or partial step 
-$z$-coordinate, or $s$-coordinate, or a mixture of the two. The distribution of variables is a 
-three-dimensional Arakawa C-type grid. Various physical choices are available to describe 
-ocean physics, including TKE, GLS and KPP vertical physics. Within NEMO, the ocean is 
-interfaced with a sea-ice model (LIM v2 and v3), passive tracer and biogeochemical models (TOP) 
-and, via the OASIS coupler, with several atmospheric general circulation models. It also 
-support two-way grid embedding via the AGRIF software.
+Prognostic variables are the three-dimensional velocity field, a non-linear sea surface height, 
+the \textit{Conservative} Temperature and the \textit{Absolut} Salinity. 
+In the horizontal direction, the model uses a curvilinear orthogonal grid and in the vertical direction, 
+a full or partial step $z$-coordinate, or $s$-coordinate, or a mixture of the two. 
+The distribution of variables is a three-dimensional Arakawa C-type grid. 
+Various physical choices are available to describe ocean physics, including TKE, and GLS vertical physics. 
+Within NEMO, the ocean is interfaced with a sea-ice model (LIM or CICE), passive tracer and 
+biogeochemical models (TOP) and, via the OASIS coupler, with several atmospheric general circulation models. 
+It also support two-way grid embedding via the AGRIF software.
 
 % ================================================================
@@ -31,13 +31,13 @@
 interactions avec les autres composantes du syst\`{e}me climatique terrestre. 
 Les variables pronostiques sont le champ tridimensionnel de vitesse, une hauteur de la mer 
-lin\'{e}aire ou non, la temperature et la salinit\'{e}. 
+lin\'{e}aire, la Ttemperature Conservative et la Salinit\'{e} Absolue. 
 La distribution des variables se fait sur une grille C d'Arakawa tridimensionnelle utilisant une 
 coordonn\'{e}e verticale $z$ \`{a} niveaux entiers ou partiels, ou une coordonn\'{e}e s, ou encore 
 une combinaison des deux. Diff\'{e}rents choix sont propos\'{e}s pour d\'{e}crire la physique 
-oc\'{e}anique, incluant notamment des physiques verticales TKE, GLS et KPP. A travers l'infrastructure 
-NEMO, l'oc\'{e}an est interfac\'{e} avec des mod\`{e}les de glace de mer, de biog\'{e}ochimie 
-et de traceurs passifs, et, via le coupleur OASIS, \`{a} plusieurs mod\`{e}les de circulation 
-g\'{e}n\'{e}rale atmosph\'{e}rique. Il supporte \'{e}galement l'embo\^{i}tement interactif de 
-maillages via le logiciel AGRIF.
+oc\'{e}anique, incluant notamment des physiques verticales TKE et GLS. A travers l'infrastructure 
+NEMO, l'oc\'{e}an est interfac\'{e} avec des mod\`{e}les de glace de mer (LIM ou CICE), 
+de biog\'{e}ochimie marine et de traceurs passifs, et, via le coupleur OASIS, \`{a} plusieurs 
+mod\`{e}les de circulation g\'{e}n\'{e}rale atmosph\'{e}rique. 
+Il supporte \'{e}galement l'embo\^{i}tement interactif de maillages via le logiciel AGRIF.
 } 
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Annex_C.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Annex_C.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Annex_C.tex	(revision 6808)
@@ -410,5 +410,5 @@
 \end{aligned}   } \right.
 \end{equation} 
-where the indices $i_p$ and $k_p$ take the following value: 
+where the indices $i_p$ and $j_p$ take the following value: 
 $i_p = -1/2$ or $1/2$ and $j_p = -1/2$ or $1/2$,
 and the vorticity triads, ${^i_j}\mathbb{Q}^{i_p}_{j_p}$, defined at $T$-point, are given by: 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_DIA.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_DIA.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_DIA.tex	(revision 6808)
@@ -2,10 +2,10 @@
 % Chapter I/O & Diagnostics
 % ================================================================
-\chapter{Ouput and Diagnostics (IOM, DIA, TRD, FLO)}
+\chapter{Output and Diagnostics (IOM, DIA, TRD, FLO)}
 \label{DIA}
 \minitoc
 
 \newpage
-$\ $\newline    % force a new ligne
+$\ $\newline    % force a new line
 
 % ================================================================
@@ -33,5 +33,5 @@
 "\textit{grep -i numout}" in the source code directory.
 
-By default, diagnostic output files are written in NetCDF format but an IEEE binary output format, called DIMG, can be choosen by defining \key{dimgout}. 
+By default, diagnostic output files are written in NetCDF format but an IEEE binary output format, called DIMG, can be chosen by defining \key{dimgout}. 
 
 Since version 3.2, when defining \key{iomput}, an I/O server has been added which provides more flexibility in the choice of the fields to be written as well as how the writing work is distributed over the processors in massively parallel computing. The complete description of the use of this I/O server is presented in the next section. 
@@ -57,5 +57,5 @@
 \item The choice of output frequencies that can be different for each file (including real months and years).
 \item The choice of file contents; includes complete flexibility over which data are written in which files (the same data can be written in different files). 
-\item The possibility to split output files at a choosen frequency.
+\item The possibility to split output files at a chosen frequency.
 \item The possibility to extract a vertical or an horizontal subdomain.
 \item The choice of the temporal operation to perform, e.g.: average, accumulate, instantaneous, min, max and once.
@@ -1319,4 +1319,30 @@
 
 % -------------------------------------------------------------------------------------------------------------
+%       25 hour mean and hourly Surface, Mid and Bed 
+% -------------------------------------------------------------------------------------------------------------
+\section{25 hour mean output for tidal models }
+
+A module is available to compute a crudely detided M2 signal by obtaining a 25 hour mean.
+The 25 hour mean is available for daily runs by summing up the 25 hourly instantananeous hourly values from
+midnight at the start of the day to midight at the day end.
+This diagnostic is actived with the logical  $ln\_dia25h$
+
+%------------------------------------------nam_dia25h------------------------------------------------------
+\namdisplay{nam_dia25h}
+%----------------------------------------------------------------------------------------------------------
+
+\section{Top Middle and Bed hourly output }
+
+A module is available to output the surface (top), mid water and bed diagnostics of a set of standard variables. 
+This can be a useful diagnostic when hourly or sub-hourly output is required in high resolution tidal outputs.
+The tidal signal is retained but the overall data usage is cut to just three vertical levels. Also the bottom level 
+is calculated for each cell.
+This diagnostic is actived with the logical  $ln\_diatmb$
+
+%------------------------------------------nam_diatmb-----------------------------------------------------
+\namdisplay{nam_diatmb}
+%----------------------------------------------------------------------------------------------------------
+
+% -------------------------------------------------------------------------------------------------------------
 %       Sections transports
 % -------------------------------------------------------------------------------------------------------------
@@ -1522,4 +1548,13 @@
 \\
 
+\section{Courant numbers}
+Courant numbers provide a theoretical indication of the model's numerical stability. The advective Courant numbers can be calculated according to
+\begin{equation}
+\label{eq:CFL}
+C_u = |u|\frac{\rdt}{e_{1u}}, \quad C_v = |v|\frac{\rdt}{e_{2v}}, \quad C_w = |w|\frac{\rdt}{e_{3w}}
+\end{equation}
+in the zonal, meridional and vertical directions respectively. The vertical component is included although it is not strictly valid as the vertical velocity is calculated from the continuity equation rather than as a prognostic variable. Physically this represents the rate at which information is propogated across a grid cell. Values greater than 1 indicate that information is propagated across more than one grid cell in a single time step.
+
+The variables can be activated by setting the \np{nn\_diacfl} namelist parameter to 1 in the \ngn{namctl} namelist. The diagnostics will be written out to an ascii file named cfl\_diagnostics.ascii. In this file the maximum value of $C_u$, $C_v$, and $C_w$ are printed at each timestep along with the coordinates of where the maximum value occurs. At the end of the model run the maximum value of $C_u$, $C_v$, and $C_w$ for the whole model run is printed along with the coordinates of each. The maximum values from the run are also copied to the ocean.output file. 
 
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_DIU.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_DIU.tex	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_DIU.tex	(revision 6808)
@@ -0,0 +1,164 @@
+% ================================================================
+% Diurnal SST models (DIU)
+% Edited by James While
+% ================================================================
+\chapter{Diurnal SST models (DIU)}
+\label{DIU}
+
+\minitoc
+
+
+\newpage
+$\ $\newline % force a new line
+
+Code to produce an estimate of the diurnal warming and cooling of the sea surface skin
+temperature (skin SST) is found in the DIU directory.  The skin
+temperature can be split into three parts:
+\begin{itemize}
+\item A foundation SST which is free from diurnal warming.
+\item A warm layer, typically ~3\,m thick, where heating from solar radiation can
+cause a warm stably stratified layer during the daytime
+\item A cool skin, a thin layer, approximately ~1\,mm thick, where long wave cooling
+is dominant and cools the immediate ocean surface.
+\end{itemize}
+
+Models are provided for both the warm layer, diurnal\_bulk.F90, and the cool skin,
+cool\_skin.F90.  Foundation SST is not considered as it can be obtained
+either from the main NEMO model (i.e. from the temperature of the top few model levels)
+or from
+some other source.  It must be noted that both the cool skin and
+warm layer models produce estimates of the change in temperature ($\Delta T_{\rm{cs}}$
+and $\Delta T_{\rm{wl}}$) and both must
+be added to a foundation SST to obtain the true skin temperature.
+
+Both the cool skin and warm layer models are controlled through the namelist `namdiu':
+\namdisplay{namdiu}
+This namelist contains only two variables:
+\begin{description}
+\item[ln\_diurnal] A logical switch for turning on/off both the cool skin and warm layer.
+\item[ln\_diurnal\_only] A logical switch which if .TRUE. will run the diurnal model
+without the other dynamical parts of NEMO.  ln\_diurnal\_only must be
+.FALSE. if ln\_diurnal is .FALSE.
+\end{description}
+
+Output for the diurnal model is through the variables `sst\_wl' (warm\_layer) and
+`sst\_cs' (cool skin).  These are 2-D variables which will be included in the model
+output if they are specified in the iodef.xml file.
+
+Initialisation is through the restart file.  Specifically the code will expect the presence of the 2-D variable ``Dsst'' to initialise the warm layer.  The cool skin model, which is determined purely by the instantaneous fluxes, has no initialisation variable.  
+
+%===============================================================
+
+\section{Warm Layer model}
+\label{warm_layer_sec}
+
+%===============================================================
+
+The warm layer is calculated using the model of \citet{Takaya_al_JGR10} (TAKAYA10 model
+hereafter).  This is a simple flux based model that is defined by the equations
+\begin{eqnarray}
+\frac{\partial{\Delta T_{\rm{wl}}}}{\partial{t}}&=&\frac{Q(\nu+1)}{D_T\rho_w c_p
+\nu}-\frac{(\nu+1)ku^*_{w}f(L_a)\Delta T}{D_T\Phi\!\left(\frac{D_T}{L}\right)} \mbox{,}
+\label{ecmwf1} \\
+L&=&\frac{\rho_w c_p u^{*^3}_{w}}{\kappa g \alpha_w Q }\mbox{,}\label{ecmwf2}
+\end{eqnarray}
+where $\Delta T_{\rm{wl}}$ is the temperature difference between the top of the warm
+layer and the depth $D_T=3$\,m at which there is assumed to be no diurnal signal. In
+equation (\ref{ecmwf1}) $\alpha_w=2\times10^{-4}$ is the thermal expansion
+coefficient of water, $\kappa=0.4$ is von K\'{a}rm\'{a}n's constant, $c_p$ is the heat
+capacity at constant pressure of sea water, $\rho_w$ is the
+water density, and $L$ is the Monin-Obukhov length. The tunable
+variable $\nu$ is a shape parameter that defines the expected
+subskin temperature profile via $T(z)=T(0)-\left(\frac{z}{D_T}\right)^\nu\Delta
+T_{\rm{wl}}$,
+where $T$ is the absolute temperature and $z\le D_T$ is the depth
+below the top of the warm layer.
+The influence of wind on TAKAYA10 comes through the magnitude of the friction velocity
+of the water
+$u^*_{w}$, which can be related to the 10\,m wind speed $u_{10}$ through the relationship
+$u^*_{w} = u_{10}\sqrt{\frac{C_d\rho_a}{\rho_w}}$, where $C_d$ is
+the drag coefficient, and $\rho_a$ is the density of air.  The symbol $Q$ in equation
+(\ref{ecmwf1}) is the instantaneous total thermal energy
+flux into
+the diurnal layer, i.e.
+\begin{equation}
+Q = Q_{\rm{sol}} + Q_{\rm{lw}} + Q_{\rm{h}}\mbox{,} \label{e_flux_eqn}
+\end{equation}
+where $Q_{\rm{h}}$ is the sensible and latent heat flux, $Q_{\rm{lw}}$ is the long
+wave flux, and $Q_{\rm{sol}}$ is the solar flux absorbed
+within the diurnal warm layer. For $Q_{\rm{sol}}$ the 9 term
+representation of \citet{Gentemann_al_JGR09} is used.  In equation \ref{ecmwf1}
+the function $f(L_a)=\max(1,L_a^{\frac{2}{3}})$, where $L_a=0.3$\footnote{This
+is a global average value, more accurately $L_a$ could be computed as
+$L_a=(u^*_{w}/u_s)^{\frac{1}{2}}$, where $u_s$ is the stokes drift, but this is not
+currently done} is the turbulent Langmuir number and is a
+parametrization of the effect of waves.
+The function $\Phi\!\left(\frac{D_T}{L}\right)$ is the similarity function that
+parametrizes the stability of the water column and
+is given by:
+\begin{equation}
+\Phi(\zeta) = \left\{ \begin{array}{cc} 1 + \frac{5\zeta +
+4\zeta^2}{1+3\zeta+0.25\zeta^2} &(\zeta \ge 0) \\
+                                    (1 - 16\zeta)^{-\frac{1}{2}} & (\zeta < 0) \mbox{,}
+                                    \end{array} \right. \label{stab_func_eqn}
+\end{equation}
+where $\zeta=\frac{D_T}{L}$.  It is clear that the first derivative of
+(\ref{stab_func_eqn}), and thus of (\ref{ecmwf1}),
+is discontinuous at $\zeta=0$ (i.e. $Q\rightarrow0$ in equation (\ref{ecmwf2})).
+
+The two terms on the right hand side of (\ref{ecmwf1}) represent different processes.
+The first term is simply the diabatic heating or cooling of the
+diurnal warm
+layer due to thermal energy
+fluxes into and out of the layer.  The second term
+parametrizes turbulent fluxes of heat out of the diurnal warm layer due to wind
+induced mixing. In practice the second term acts as a relaxation
+on the temperature.
+
+%===============================================================
+
+\section{Cool Skin model}
+\label{cool_skin_sec}
+
+%===============================================================
+
+The cool skin is modelled using the framework of \citet{Saunders_JAS82} who used a
+formulation of the near surface temperature difference based upon the heat flux and
+the friction velocity $u^*_{w}$.  As the cool skin
+is so thin (~1\,mm) we ignore the solar flux component to the heat flux and the
+Saunders equation for the cool skin temperature difference $\Delta T_{\rm{cs}}$ becomes
+\begin{equation}
+\label{sunders_eqn}
+\Delta T_{\rm{cs}}=\frac{Q_{\rm{ns}}\delta}{k_t} \mbox{,}
+\end{equation}
+where $Q_{\rm{ns}}$ is the, usually negative, non-solar heat flux into the ocean and
+$k_t$ is the thermal conductivity of sea water. $\delta$ is the thickness of the
+skin layer and is given by
+\begin{equation}
+\label{sunders_thick_eqn}
+\delta=\frac{\lambda \mu}{u^*_{w}} \mbox{,}
+\end{equation}
+where $\mu$ is the kinematic viscosity of sea water and $\lambda$ is a constant of
+proportionality which \citet{Saunders_JAS82} suggested varied between 5 and 10.
+
+The value of $\lambda$ used in equation (\ref{sunders_thick_eqn}) is that of
+\citet{Artale_al_JGR02},
+which is shown in \citet{Tu_Tsuang_GRL05} to outperform a number of other
+parametrisations at both low and high wind speeds. Specifically,
+\begin{equation}
+\label{artale_lambda_eqn}
+\lambda = \frac{ 8.64\times10^4 u^*_{w} k_t }{ \rho c_p h \mu \gamma }\mbox{,}
+\end{equation}
+where $h=10$\,m is a reference depth and
+$\gamma$ is a dimensionless function of wind speed $u$:
+\begin{equation}
+\label{artale_gamma_eqn}
+\gamma = \left\{ \begin{matrix}
+                     0.2u+0.5\mbox{,} & u \le 7.5\,\mbox{ms}^{-1} \\
+                     1.6u-10\mbox{,} & 7.5 < u < 10\,\mbox{ms}^{-1} \\
+                     6\mbox{,} & \ge 10\,\mbox{ms}^{-1} \\
+                 \end{matrix}
+          \right.
+\end{equation}
+
+
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_DOM.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_DOM.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_DOM.tex	(revision 6808)
@@ -1,4 +1,4 @@
 % ================================================================
-% Chapter 2 � Space and Time Domain (DOM)
+% Chapter 2 ——— Space and Time Domain (DOM)
 % ================================================================
 \chapter{Space Domain (DOM) }
@@ -364,5 +364,5 @@
 For both grids here,  the same $w$-point depth has been chosen but in (a) the 
 $t$-points are set half way between $w$-points while in (b) they are defined from 
-an analytical function: $z(k)=5\,(i-1/2)^3 - 45\,(i-1/2)^2 + 140\,(i-1/2) - 150$. 
+an analytical function: $z(k)=5\,(k-1/2)^3 - 45\,(k-1/2)^2 + 140\,(k-1/2) - 150$. 
 Note the resulting difference between the value of the grid-size $\Delta_k$ and 
 those of the scale factor $e_k$. }
@@ -475,11 +475,11 @@
 (d) hybrid $s-z$ coordinate, 
 (e) hybrid $s-z$ coordinate with partial step, and 
-(f) same as (e) but with variable volume associated with the non-linear free surface. 
-Note that the variable volume option (\key{vvl}) can be used with any of the 
+(f) same as (e) but in the non-linear free surface (\np{ln\_linssh}=false). 
+Note that the non-linear free surface can be used with any of the 
 5 coordinates (a) to (e).}
 \end{center}   \end{figure}
 %>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 
-The choice of a vertical coordinate, even if it is made through a namelist parameter, 
+The choice of a vertical coordinate, even if it is made through \ngn{namzgr} namelist parameters, 
 must be done once of all at the beginning of an experiment. It is not intended as an 
 option which can be enabled or disabled in the middle of an experiment. Three main 
@@ -488,18 +488,23 @@
 (\np{ln\_zps}~=~true), or generalized, $s$-coordinate (\np{ln\_sco}~=~true). 
 Hybridation of the three main coordinates are available: $s-z$ or $s-zps$ coordinate 
-(Fig.~\ref{Fig_z_zps_s_sps}d and \ref{Fig_z_zps_s_sps}e). When using the variable 
-volume option \key{vvl} ($i.e.$ non-linear free surface), the coordinate follow the 
-time-variation of the free surface so that the transformation is time dependent: 
-$z(i,j,k,t)$ (Fig.~\ref{Fig_z_zps_s_sps}f). This option can be used with full step 
-bathymetry or $s$-coordinate (hybrid and partial step coordinates have not 
-yet been tested in NEMO v2.3). If using $z$-coordinate with partial step bathymetry
-(\np{ln\_zps}~=~true), ocean cavity beneath ice shelves can be open (\np{ln\_isfcav}~=~true).
+(Fig.~\ref{Fig_z_zps_s_sps}d and \ref{Fig_z_zps_s_sps}e). By default a non-linear free surface is used:
+the coordinate follow the time-variation of the free surface so that the transformation is time dependent: 
+$z(i,j,k,t)$ (Fig.~\ref{Fig_z_zps_s_sps}f). When a linear free surface is assumed (\np{ln\_linssh}=true), 
+the vertical coordinate are fixed in time, but the seawater can move up and down across the z=0 surface 
+(in other words, the top of the ocean in not a rigid-lid). 
+The last choice in terms of vertical coordinate concerns the presence (or not) in the model domain 
+of ocean cavities beneath ice shelves. Setting \np{ln\_isfcav} to true allows to manage ocean cavities, 
+otherwise they are filled in.
 
 Contrary to the horizontal grid, the vertical grid is computed in the code and no 
 provision is made for reading it from a file. The only input file is the bathymetry 
-(in meters) (\ifile{bathy\_meter}) 
+(in meters) (\ifile{bathy\_meter}). 
 \footnote{N.B. in full step $z$-coordinate, a \ifile{bathy\_level} file can replace the 
 \ifile{bathy\_meter} file, so that the computation of the number of wet ocean point 
 in each water column is by-passed}. 
+If \np{ln\_isfcav}~=~true, an extra file input file describing the ice shelf draft 
+(in meters) (\ifile{isf\_draft\_meter}) is needed and all the location where the isf cavity thinnest
+ than \np{rn\_isfhmin} meters are grounded (ie masked). 
+
 After reading the bathymetry, the algorithm for vertical grid definition differs 
 between the different options:
@@ -519,17 +524,12 @@
 %%%
 
-The arrays describing the grid point depths and vertical scale factors 
-are three dimensional arrays $(i,j,k)$ even in the case of $z$-coordinate with 
-full step bottom topography. In non-linear free surface (\key{vvl}), their knowledge
-is required at \textit{before}, \textit{now} and \textit{after} time step, while they 
-do not vary in time in linear free surface case. 
-To improve the code readability while providing this flexibility, the vertical coordinate 
-and scale factors are defined as functions of 
-$(i,j,k)$ with "fs" as prefix (examples: \textit{fse3t\_b, fse3t\_n, fse3t\_a,} 
-for the  \textit{before}, \textit{now} and \textit{after} scale factors at $t$-point) 
-that can be either three different arrays when \key{vvl} is defined, or a single fixed arrays. 
-These functions are defined in the file \hf{domzgr\_substitute} of the DOM directory. 
-They are used throughout the code, and replaced by the corresponding arrays at 
-the time of pre-processing (CPP capability).
+Unless a linear free surface is used (\np{ln\_linssh}=false), the arrays describing 
+the grid point depths and vertical scale factors are three set of three dimensional arrays $(i,j,k)$ 
+defined at \textit{before}, \textit{now} and \textit{after} time step. The time at which they are
+defined is indicated by a suffix:$\_b$, $\_n$, or $\_a$, respectively. They are updated at each model time step
+using a fixed reference coordinate system which computer names have a $\_0$ suffix. 
+When the linear free surface option is used (\np{ln\_linssh}=true), \textit{before}, \textit{now} 
+and \textit{after} arrays are simply set one for all to their reference counterpart. 
+
 
 % -------------------------------------------------------------------------------------------------------------
@@ -840,6 +840,6 @@
 %        z*- or s*-coordinate
 % -------------------------------------------------------------------------------------------------------------
-\subsection{$z^*$- or $s^*$-coordinate (add \key{vvl}) }
-\label{DOM_zgr_vvl}
+\subsection{$z^*$- or $s^*$-coordinate (\np{ln\_linssh}=false) }
+\label{DOM_zgr_star}
 
 This option is described in the Report by Levier \textit{et al.} (2007), available on 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_DYN.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_DYN.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_DYN.tex	(revision 6808)
@@ -1,10 +1,8 @@
 % ================================================================
-% Chapter � Ocean Dynamics (DYN)
+% Chapter ——— Ocean Dynamics (DYN)
 % ================================================================
 \chapter{Ocean Dynamics (DYN)}
 \label{DYN}
 \minitoc
-
-% add a figure for  dynvor ens, ene latices
 
 %\vspace{2.cm}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_LDF.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_LDF.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_LDF.tex	(revision 6808)
@@ -1,5 +1,5 @@
 
 % ================================================================
-% Chapter � Lateral Ocean Physics (LDF)
+% Chapter ———  Lateral Ocean Physics (LDF)
 % ================================================================
 \chapter{Lateral Ocean Physics (LDF)}
@@ -15,12 +15,11 @@
 described in \S\ref{PE_zdf} and their discrete formulation in \S\ref{TRA_ldf} 
 and \S\ref{DYN_ldf}). In this section we further discuss each lateral physics option. 
-Choosing one lateral physics scheme means for the user defining, (1) the space 
-and time variations of the eddy coefficients ; (2) the direction along which the 
-lateral diffusive fluxes are evaluated (model level, geopotential or isopycnal 
-surfaces); and (3) the type of operator used (harmonic, or biharmonic operators, 
-and for tracers only, eddy induced advection on tracers). These three aspects 
-of the lateral diffusion are set through namelist parameters and CPP keys 
-(see the \textit{\ngn{nam\_traldf}} and \textit{\ngn{nam\_dynldf}} below). Note
-that this chapter describes the default implementation of iso-neutral
+Choosing one lateral physics scheme means for the user defining, 
+(1) the type of operator used (laplacian or bilaplacian operators, or no lateral mixing term) ; 
+(2) the direction along which the lateral diffusive fluxes are evaluated (model level, geopotential or isopycnal surfaces) ; and 
+(3) the space and time variations of the eddy coefficients. 
+These three aspects of the lateral diffusion are set through namelist parameters 
+(see the \textit{\ngn{nam\_traldf}} and \textit{\ngn{nam\_dynldf}} below). 
+Note that this chapter describes the standard implementation of iso-neutral
 tracer mixing, and Griffies's implementation, which is used if
 \np{traldf\_grif}=true, is described in Appdx\ref{sec:triad}
@@ -33,4 +32,283 @@
 
 % ================================================================
+% Direction of lateral Mixing
+% ================================================================
+\section  [Direction of Lateral Mixing (\textit{ldfslp})]
+		{Direction of Lateral Mixing (\mdl{ldfslp})}
+\label{LDF_slp}
+
+%%%
+\gmcomment{  we should emphasize here that the implementation is a rather old one. 
+Better work can be achieved by using \citet{Griffies_al_JPO98, Griffies_Bk04} iso-neutral scheme. }
+
+A direction for lateral mixing has to be defined when the desired operator does 
+not act along the model levels. This occurs when $(a)$ horizontal mixing is 
+required on tracer or momentum (\np{ln\_traldf\_hor} or \np{ln\_dynldf\_hor}) 
+in $s$- or mixed $s$-$z$- coordinates, and $(b)$ isoneutral mixing is required 
+whatever the vertical coordinate is. This direction of mixing is defined by its 
+slopes in the \textbf{i}- and \textbf{j}-directions at the face of the cell of the 
+quantity to be diffused. For a tracer, this leads to the following four slopes : 
+$r_{1u}$, $r_{1w}$, $r_{2v}$, $r_{2w}$ (see \eqref{Eq_tra_ldf_iso}), while 
+for momentum the slopes are  $r_{1t}$, $r_{1uw}$, $r_{2f}$, $r_{2uw}$ for 
+$u$ and  $r_{1f}$, $r_{1vw}$, $r_{2t}$, $r_{2vw}$ for $v$. 
+
+%gm% add here afigure of the slope in i-direction
+
+\subsection{slopes for tracer geopotential mixing in the $s$-coordinate}
+
+In $s$-coordinates, geopotential mixing ($i.e.$ horizontal mixing) $r_1$ and 
+$r_2$ are the slopes between the geopotential and computational surfaces. 
+Their discrete formulation is found by locally solving \eqref{Eq_tra_ldf_iso} 
+when the diffusive fluxes in the three directions are set to zero and $T$ is 
+assumed to be horizontally uniform, $i.e.$ a linear function of $z_T$, the 
+depth of a $T$-point. 
+%gm { Steven : My version is obviously wrong since I'm left with an arbitrary constant which is the local vertical temperature gradient}
+
+\begin{equation} \label{Eq_ldfslp_geo}
+\begin{aligned}
+ r_{1u} &= \frac{e_{3u}}{ \left( e_{1u}\;\overline{\overline{e_{3w}}}^{\,i+1/2,\,k} \right)}
+ 			  \;\delta_{i+1/2}[z_t] 
+ 		&\approx \frac{1}{e_{1u}}\; \delta_{i+1/2}[z_t] 
+\\
+ r_{2v} &= \frac{e_{3v}}{\left( e_{2v}\;\overline{\overline{e_{3w}}}^{\,j+1/2,\,k} \right)} 
+ 			  \;\delta_{j+1/2} [z_t] 
+		&\approx \frac{1}{e_{2v}}\; \delta_{j+1/2}[z_t] 
+\\
+ r_{1w} &= \frac{1}{e_{1w}}\;\overline{\overline{\delta_{i+1/2}[z_t]}}^{\,i,\,k+1/2}
+ 		&\approx \frac{1}{e_{1w}}\; \delta_{i+1/2}[z_{uw}] 
+ \\
+ r_{2w} &= \frac{1}{e_{2w}}\;\overline{\overline{\delta_{j+1/2}[z_t]}}^{\,j,\,k+1/2}
+		&\approx \frac{1}{e_{2w}}\; \delta_{j+1/2}[z_{vw}] 
+ \\
+\end{aligned}
+\end{equation}
+
+%gm%  caution I'm not sure the simplification was a good idea! 
+
+These slopes are computed once in \rou{ldfslp\_init} when \np{ln\_sco}=True, 
+and either \np{ln\_traldf\_hor}=True or \np{ln\_dynldf\_hor}=True. 
+
+\subsection{Slopes for tracer iso-neutral mixing}\label{LDF_slp_iso}
+In iso-neutral mixing  $r_1$ and $r_2$ are the slopes between the iso-neutral 
+and computational surfaces. Their formulation does not depend on the vertical 
+coordinate used. Their discrete formulation is found using the fact that the 
+diffusive fluxes of locally referenced potential density ($i.e.$ $in situ$ density) 
+vanish. So, substituting $T$ by $\rho$ in \eqref{Eq_tra_ldf_iso} and setting the 
+diffusive fluxes in the three directions to zero leads to the following definition for 
+the neutral slopes:
+
+\begin{equation} \label{Eq_ldfslp_iso}
+\begin{split}
+ r_{1u} &= \frac{e_{3u}}{e_{1u}}\; \frac{\delta_{i+1/2}[\rho]}
+ 								{\overline{\overline{\delta_{k+1/2}[\rho]}}^{\,i+1/2,\,k}}
+\\
+ r_{2v} &= \frac{e_{3v}}{e_{2v}}\; \frac{\delta_{j+1/2}\left[\rho \right]}
+ 								{\overline{\overline{\delta_{k+1/2}[\rho]}}^{\,j+1/2,\,k}}
+\\
+ r_{1w} &= \frac{e_{3w}}{e_{1w}}\; 
+ 			\frac{\overline{\overline{\delta_{i+1/2}[\rho]}}^{\,i,\,k+1/2}}
+				 {\delta_{k+1/2}[\rho]}
+\\
+ r_{2w} &= \frac{e_{3w}}{e_{2w}}\; 
+ 			\frac{\overline{\overline{\delta_{j+1/2}[\rho]}}^{\,j,\,k+1/2}}
+				 {\delta_{k+1/2}[\rho]}
+\\
+\end{split}
+\end{equation}
+
+%gm% rewrite this as the explanation is not very clear !!!
+%In practice, \eqref{Eq_ldfslp_iso} is of little help in evaluating the neutral surface slopes. Indeed, for an unsimplified equation of state, the density has a strong dependancy on pressure (here approximated as the depth), therefore applying \eqref{Eq_ldfslp_iso} using the $in situ$ density, $\rho$, computed at T-points leads to a flattening of slopes as the depth increases. This is due to the strong increase of the $in situ$ density with depth. 
+
+%By definition, neutral surfaces are tangent to the local $in situ$ density \citep{McDougall1987}, therefore in \eqref{Eq_ldfslp_iso}, all the derivatives have to be evaluated at the same local pressure (which in decibars is approximated by the depth in meters).
+
+%In the $z$-coordinate, the derivative of the  \eqref{Eq_ldfslp_iso} numerator is evaluated at the same depth \nocite{as what?} ($T$-level, which is the same as the $u$- and $v$-levels), so  the $in situ$ density can be used for its evaluation. 
+
+As the mixing is performed along neutral surfaces, the gradient of $\rho$ in 
+\eqref{Eq_ldfslp_iso} has to be evaluated at the same local pressure (which, 
+in decibars, is approximated by the depth in meters in the model). Therefore 
+\eqref{Eq_ldfslp_iso} cannot be used as such, but further transformation is 
+needed depending on the vertical coordinate used:
+
+\begin{description}
+
+\item[$z$-coordinate with full step : ] in \eqref{Eq_ldfslp_iso} the densities 
+appearing in the $i$ and $j$ derivatives  are taken at the same depth, thus 
+the $in situ$ density can be used. This is not the case for the vertical 
+derivatives: $\delta_{k+1/2}[\rho]$ is replaced by $-\rho N^2/g$, where $N^2$ 
+is the local Brunt-Vais\"{a}l\"{a} frequency evaluated following 
+\citet{McDougall1987} (see \S\ref{TRA_bn2}). 
+
+\item[$z$-coordinate with partial step : ] this case is identical to the full step 
+case except that at partial step level, the \emph{horizontal} density gradient 
+is evaluated as described in \S\ref{TRA_zpshde}.
+
+\item[$s$- or hybrid $s$-$z$- coordinate : ] in the current release of \NEMO, 
+iso-neutral mixing is only employed for $s$-coordinates if the
+Griffies scheme is used (\np{traldf\_grif}=true; see Appdx \ref{sec:triad}). 
+In other words, iso-neutral mixing will only be accurately represented with a 
+linear equation of state (\np{nn\_eos}=1 or 2). In the case of a "true" equation 
+of state, the evaluation of $i$ and $j$ derivatives in \eqref{Eq_ldfslp_iso} 
+will include a pressure dependent part, leading to the wrong evaluation of 
+the neutral slopes.
+
+%gm% 
+Note: The solution for $s$-coordinate passes trough the use of different 
+(and better) expression for the constraint on iso-neutral fluxes. Following 
+\citet{Griffies_Bk04}, instead of specifying directly that there is a zero neutral 
+diffusive flux of locally referenced potential density, we stay in the $T$-$S$ 
+plane and consider the balance between the neutral direction diffusive fluxes 
+of potential temperature and salinity:
+\begin{equation}
+\alpha \ \textbf{F}(T) = \beta \ \textbf{F}(S)
+\end{equation}
+%gm{  where vector F is ....}
+
+This constraint leads to the following definition for the slopes:
+
+\begin{equation} \label{Eq_ldfslp_iso2}
+\begin{split}
+ r_{1u} &= \frac{e_{3u}}{e_{1u}}\; \frac
+ 		{\alpha_u \;\delta_{i+1/2}[T] - \beta_u \;\delta_{i+1/2}[S]}
+		{\alpha_u \;\overline{\overline{\delta_{k+1/2}[T]}}^{\,i+1/2,\,k}
+		 -\beta_u  \;\overline{\overline{\delta_{k+1/2}[S]}}^{\,i+1/2,\,k} }
+\\
+ r_{2v} &= \frac{e_{3v}}{e_{2v}}\; \frac
+ 		{\alpha_v \;\delta_{j+1/2}[T] - \beta_v \;\delta_{j+1/2}[S]}
+		{\alpha_v \;\overline{\overline{\delta_{k+1/2}[T]}}^{\,j+1/2,\,k}
+		 -\beta_v  \;\overline{\overline{\delta_{k+1/2}[S]}}^{\,j+1/2,\,k} }
+\\
+ r_{1w} &= \frac{e_{3w}}{e_{1w}}\; \frac
+		{\alpha_w \;\overline{\overline{\delta_{i+1/2}[T]}}^{\,i,\,k+1/2}
+		 -\beta_w  \;\overline{\overline{\delta_{i+1/2}[S]}}^{\,i,\,k+1/2} }
+ 		{\alpha_w \;\delta_{k+1/2}[T] - \beta_w \;\delta_{k+1/2}[S]}
+\\
+ r_{2w} &= \frac{e_{3w}}{e_{2w}}\; \frac
+		{\alpha_w \;\overline{\overline{\delta_{j+1/2}[T]}}^{\,j,\,k+1/2}
+		 -\beta_w  \;\overline{\overline{\delta_{j+1/2}[S]}}^{\,j,\,k+1/2} }
+ 		{\alpha_w \;\delta_{k+1/2}[T] - \beta_w \;\delta_{k+1/2}[S]}
+\\
+\end{split}
+\end{equation}
+where $\alpha$ and $\beta$, the thermal expansion and saline contraction 
+coefficients introduced in \S\ref{TRA_bn2}, have to be evaluated at the three 
+velocity points. In order to save computation time, they should be approximated 
+by the mean of their values at $T$-points (for example in the case of $\alpha$:  
+$\alpha_u=\overline{\alpha_T}^{i+1/2}$,  $\alpha_v=\overline{\alpha_T}^{j+1/2}$ 
+and $\alpha_w=\overline{\alpha_T}^{k+1/2}$).
+
+Note that such a formulation could be also used in the $z$-coordinate and 
+$z$-coordinate with partial steps cases.
+
+\end{description}
+
+This implementation is a rather old one. It is similar to the one
+proposed by Cox [1987], except for the background horizontal
+diffusion. Indeed, the Cox implementation of isopycnal diffusion in
+GFDL-type models requires a minimum background horizontal diffusion
+for numerical stability reasons.  To overcome this problem, several
+techniques have been proposed in which the numerical schemes of the
+ocean model are modified \citep{Weaver_Eby_JPO97,
+  Griffies_al_JPO98}. Griffies's scheme is now available in \NEMO if
+\np{traldf\_grif\_iso} is set true; see Appdx \ref{sec:triad}. Here,
+another strategy is presented \citep{Lazar_PhD97}: a local
+filtering of the iso-neutral slopes (made on 9 grid-points) prevents
+the development of grid point noise generated by the iso-neutral
+diffusion operator (Fig.~\ref{Fig_LDF_ZDF1}). This allows an
+iso-neutral diffusion scheme without additional background horizontal
+mixing. This technique can be viewed as a diffusion operator that acts
+along large-scale (2~$\Delta$x) \gmcomment{2deltax doesnt seem very
+  large scale} iso-neutral surfaces. The diapycnal diffusion required
+for numerical stability is thus minimized and its net effect on the
+flow is quite small when compared to the effect of an horizontal
+background mixing.
+
+Nevertheless, this iso-neutral operator does not ensure that variance cannot increase, 
+contrary to the \citet{Griffies_al_JPO98} operator which has that property. 
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht]      \begin{center}
+\includegraphics[width=0.70\textwidth]{./TexFiles/Figures/Fig_LDF_ZDF1.pdf}
+\caption {    \label{Fig_LDF_ZDF1}
+averaging procedure for isopycnal slope computation.}
+\end{center}    \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+%There are three additional questions about the slope calculation. 
+%First the expression for the rotation tensor has been obtain assuming the "small slope" approximation, so a bound has to be imposed on slopes. 
+%Second, numerical stability issues also require a bound on slopes. 
+%Third, the question of boundary condition specified on slopes...
+
+%from griffies: chapter 13.1....
+
+
+
+% In addition and also for numerical stability reasons \citep{Cox1987, Griffies_Bk04}, 
+% the slopes are bounded by $1/100$ everywhere. This limit is decreasing linearly 
+% to zero fom $70$ meters depth and the surface (the fact that the eddies "feel" the 
+% surface motivates this flattening of isopycnals near the surface).
+
+For numerical stability reasons \citep{Cox1987, Griffies_Bk04}, the slopes must also 
+be bounded by $1/100$ everywhere. This constraint is applied in a piecewise linear 
+fashion, increasing from zero at the surface to $1/100$ at $70$ metres and thereafter 
+decreasing to zero at the bottom of the ocean. (the fact that the eddies "feel" the 
+surface motivates this flattening of isopycnals near the surface).
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht]     \begin{center}
+\includegraphics[width=0.70\textwidth]{./TexFiles/Figures/Fig_eiv_slp.pdf}
+\caption {     \label{Fig_eiv_slp}
+Vertical profile of the slope used for lateral mixing in the mixed layer : 
+\textit{(a)} in the real ocean the slope is the iso-neutral slope in the ocean interior, 
+which has to be adjusted at the surface boundary (i.e. it must tend to zero at the 
+surface since there is no mixing across the air-sea interface: wall boundary 
+condition). Nevertheless, the profile between the surface zero value and the interior 
+iso-neutral one is unknown, and especially the value at the base of the mixed layer ; 
+\textit{(b)} profile of slope using a linear tapering of the slope near the surface and 
+imposing a maximum slope of 1/100 ; \textit{(c)} profile of slope actually used in 
+\NEMO: a linear decrease of the slope from zero at the surface to its ocean interior 
+value computed just below the mixed layer. Note the huge change in the slope at the 
+base of the mixed layer between  \textit{(b)}  and \textit{(c)}.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+\colorbox{yellow}{add here a discussion about the flattening of the slopes, vs  tapering the coefficient.}
+
+\subsection{slopes for momentum iso-neutral mixing}
+
+The iso-neutral diffusion operator on momentum is the same as the one used on 
+tracers but applied to each component of the velocity separately (see 
+\eqref{Eq_dyn_ldf_iso} in section~\ref{DYN_ldf_iso}). The slopes between the 
+surface along which the diffusion operator acts and the surface of computation 
+($z$- or $s$-surfaces) are defined at $T$-, $f$-, and \textit{uw}- points for the 
+$u$-component, and $T$-, $f$- and \textit{vw}- points for the $v$-component. 
+They are computed from the slopes used for tracer diffusion, $i.e.$ 
+\eqref{Eq_ldfslp_geo} and \eqref{Eq_ldfslp_iso} :
+
+\begin{equation} \label{Eq_ldfslp_dyn}
+\begin{aligned}
+&r_{1t}\ \ = \overline{r_{1u}}^{\,i}       &&&    r_{1f}\ \ &= \overline{r_{1u}}^{\,i+1/2} \\
+&r_{2f} \ \ = \overline{r_{2v}}^{\,j+1/2} &&& 	r_{2t}\ &= \overline{r_{2v}}^{\,j} \\
+&r_{1uw}  = \overline{r_{1w}}^{\,i+1/2} &&\ \ \text{and} \ \ &   r_{1vw}&= \overline{r_{1w}}^{\,j+1/2} \\
+&r_{2uw}= \overline{r_{2w}}^{\,j+1/2} &&&         r_{2vw}&= \overline{r_{2w}}^{\,j+1/2}\\
+\end{aligned}
+\end{equation}
+
+The major issue remaining is in the specification of the boundary conditions. 
+The same boundary conditions are chosen as those used for lateral 
+diffusion along model level surfaces, i.e. using the shear computed along 
+the model levels and with no additional friction at the ocean bottom (see 
+{\S\ref{LBC_coast}).
+
+
+% ================================================================
+% Lateral Mixing Operator
+% ================================================================
+\section [Lateral Mixing Operators (\textit{ldftra}, \textit{ldfdyn})] 
+		  {Lateral Mixing Operators (\mdl{traldf}, \mdl{traldf}) }
+\label{LDF_op}
+
+
+   
+% ================================================================
 % Lateral Mixing Coefficients
 % ================================================================
@@ -38,5 +316,4 @@
 		  {Lateral Mixing Coefficient (\mdl{ldftra}, \mdl{ldfdyn}) }
 \label{LDF_coef}
-
 
 Introducing a space variation in the lateral eddy mixing coefficients changes 
@@ -165,274 +442,4 @@
 
 % ================================================================
-% Direction of lateral Mixing
-% ================================================================
-\section  [Direction of Lateral Mixing (\textit{ldfslp})]
-		{Direction of Lateral Mixing (\mdl{ldfslp})}
-\label{LDF_slp}
-
-%%%
-\gmcomment{  we should emphasize here that the implementation is a rather old one. 
-Better work can be achieved by using \citet{Griffies_al_JPO98, Griffies_Bk04} iso-neutral scheme. }
-
-A direction for lateral mixing has to be defined when the desired operator does 
-not act along the model levels. This occurs when $(a)$ horizontal mixing is 
-required on tracer or momentum (\np{ln\_traldf\_hor} or \np{ln\_dynldf\_hor}) 
-in $s$- or mixed $s$-$z$- coordinates, and $(b)$ isoneutral mixing is required 
-whatever the vertical coordinate is. This direction of mixing is defined by its 
-slopes in the \textbf{i}- and \textbf{j}-directions at the face of the cell of the 
-quantity to be diffused. For a tracer, this leads to the following four slopes : 
-$r_{1u}$, $r_{1w}$, $r_{2v}$, $r_{2w}$ (see \eqref{Eq_tra_ldf_iso}), while 
-for momentum the slopes are  $r_{1t}$, $r_{1uw}$, $r_{2f}$, $r_{2uw}$ for 
-$u$ and  $r_{1f}$, $r_{1vw}$, $r_{2t}$, $r_{2vw}$ for $v$. 
-
-%gm% add here afigure of the slope in i-direction
-
-\subsection{slopes for tracer geopotential mixing in the $s$-coordinate}
-
-In $s$-coordinates, geopotential mixing ($i.e.$ horizontal mixing) $r_1$ and 
-$r_2$ are the slopes between the geopotential and computational surfaces. 
-Their discrete formulation is found by locally solving \eqref{Eq_tra_ldf_iso} 
-when the diffusive fluxes in the three directions are set to zero and $T$ is 
-assumed to be horizontally uniform, $i.e.$ a linear function of $z_T$, the 
-depth of a $T$-point. 
-%gm { Steven : My version is obviously wrong since I'm left with an arbitrary constant which is the local vertical temperature gradient}
-
-\begin{equation} \label{Eq_ldfslp_geo}
-\begin{aligned}
- r_{1u} &= \frac{e_{3u}}{ \left( e_{1u}\;\overline{\overline{e_{3w}}}^{\,i+1/2,\,k} \right)}
- 			  \;\delta_{i+1/2}[z_t] 
- 		&\approx \frac{1}{e_{1u}}\; \delta_{i+1/2}[z_t] 
-\\
- r_{2v} &= \frac{e_{3v}}{\left( e_{2v}\;\overline{\overline{e_{3w}}}^{\,j+1/2,\,k} \right)} 
- 			  \;\delta_{j+1/2} [z_t] 
-		&\approx \frac{1}{e_{2v}}\; \delta_{j+1/2}[z_t] 
-\\
- r_{1w} &= \frac{1}{e_{1w}}\;\overline{\overline{\delta_{i+1/2}[z_t]}}^{\,i,\,k+1/2}
- 		&\approx \frac{1}{e_{1w}}\; \delta_{i+1/2}[z_{uw}] 
- \\
- r_{2w} &= \frac{1}{e_{2w}}\;\overline{\overline{\delta_{j+1/2}[z_t]}}^{\,j,\,k+1/2}
-		&\approx \frac{1}{e_{2w}}\; \delta_{j+1/2}[z_{vw}] 
- \\
-\end{aligned}
-\end{equation}
-
-%gm%  caution I'm not sure the simplification was a good idea! 
-
-These slopes are computed once in \rou{ldfslp\_init} when \np{ln\_sco}=True, 
-and either \np{ln\_traldf\_hor}=True or \np{ln\_dynldf\_hor}=True. 
-
-\subsection{Slopes for tracer iso-neutral mixing}\label{LDF_slp_iso}
-In iso-neutral mixing  $r_1$ and $r_2$ are the slopes between the iso-neutral 
-and computational surfaces. Their formulation does not depend on the vertical 
-coordinate used. Their discrete formulation is found using the fact that the 
-diffusive fluxes of locally referenced potential density ($i.e.$ $in situ$ density) 
-vanish. So, substituting $T$ by $\rho$ in \eqref{Eq_tra_ldf_iso} and setting the 
-diffusive fluxes in the three directions to zero leads to the following definition for 
-the neutral slopes:
-
-\begin{equation} \label{Eq_ldfslp_iso}
-\begin{split}
- r_{1u} &= \frac{e_{3u}}{e_{1u}}\; \frac{\delta_{i+1/2}[\rho]}
- 								{\overline{\overline{\delta_{k+1/2}[\rho]}}^{\,i+1/2,\,k}}
-\\
- r_{2v} &= \frac{e_{3v}}{e_{2v}}\; \frac{\delta_{j+1/2}\left[\rho \right]}
- 								{\overline{\overline{\delta_{k+1/2}[\rho]}}^{\,j+1/2,\,k}}
-\\
- r_{1w} &= \frac{e_{3w}}{e_{1w}}\; 
- 			\frac{\overline{\overline{\delta_{i+1/2}[\rho]}}^{\,i,\,k+1/2}}
-				 {\delta_{k+1/2}[\rho]}
-\\
- r_{2w} &= \frac{e_{3w}}{e_{2w}}\; 
- 			\frac{\overline{\overline{\delta_{j+1/2}[\rho]}}^{\,j,\,k+1/2}}
-				 {\delta_{k+1/2}[\rho]}
-\\
-\end{split}
-\end{equation}
-
-%gm% rewrite this as the explanation is not very clear !!!
-%In practice, \eqref{Eq_ldfslp_iso} is of little help in evaluating the neutral surface slopes. Indeed, for an unsimplified equation of state, the density has a strong dependancy on pressure (here approximated as the depth), therefore applying \eqref{Eq_ldfslp_iso} using the $in situ$ density, $\rho$, computed at T-points leads to a flattening of slopes as the depth increases. This is due to the strong increase of the $in situ$ density with depth. 
-
-%By definition, neutral surfaces are tangent to the local $in situ$ density \citep{McDougall1987}, therefore in \eqref{Eq_ldfslp_iso}, all the derivatives have to be evaluated at the same local pressure (which in decibars is approximated by the depth in meters).
-
-%In the $z$-coordinate, the derivative of the  \eqref{Eq_ldfslp_iso} numerator is evaluated at the same depth \nocite{as what?} ($T$-level, which is the same as the $u$- and $v$-levels), so  the $in situ$ density can be used for its evaluation. 
-
-As the mixing is performed along neutral surfaces, the gradient of $\rho$ in 
-\eqref{Eq_ldfslp_iso} has to be evaluated at the same local pressure (which, 
-in decibars, is approximated by the depth in meters in the model). Therefore 
-\eqref{Eq_ldfslp_iso} cannot be used as such, but further transformation is 
-needed depending on the vertical coordinate used:
-
-\begin{description}
-
-\item[$z$-coordinate with full step : ] in \eqref{Eq_ldfslp_iso} the densities 
-appearing in the $i$ and $j$ derivatives  are taken at the same depth, thus 
-the $in situ$ density can be used. This is not the case for the vertical 
-derivatives: $\delta_{k+1/2}[\rho]$ is replaced by $-\rho N^2/g$, where $N^2$ 
-is the local Brunt-Vais\"{a}l\"{a} frequency evaluated following 
-\citet{McDougall1987} (see \S\ref{TRA_bn2}). 
-
-\item[$z$-coordinate with partial step : ] this case is identical to the full step 
-case except that at partial step level, the \emph{horizontal} density gradient 
-is evaluated as described in \S\ref{TRA_zpshde}.
-
-\item[$s$- or hybrid $s$-$z$- coordinate : ] in the current release of \NEMO, 
-iso-neutral mixing is only employed for $s$-coordinates if the
-Griffies scheme is used (\np{traldf\_grif}=true; see Appdx \ref{sec:triad}). 
-In other words, iso-neutral mixing will only be accurately represented with a 
-linear equation of state (\np{nn\_eos}=1 or 2). In the case of a "true" equation 
-of state, the evaluation of $i$ and $j$ derivatives in \eqref{Eq_ldfslp_iso} 
-will include a pressure dependent part, leading to the wrong evaluation of 
-the neutral slopes.
-
-%gm% 
-Note: The solution for $s$-coordinate passes trough the use of different 
-(and better) expression for the constraint on iso-neutral fluxes. Following 
-\citet{Griffies_Bk04}, instead of specifying directly that there is a zero neutral 
-diffusive flux of locally referenced potential density, we stay in the $T$-$S$ 
-plane and consider the balance between the neutral direction diffusive fluxes 
-of potential temperature and salinity:
-\begin{equation}
-\alpha \ \textbf{F}(T) = \beta \ \textbf{F}(S)
-\end{equation}
-%gm{  where vector F is ....}
-
-This constraint leads to the following definition for the slopes:
-
-\begin{equation} \label{Eq_ldfslp_iso2}
-\begin{split}
- r_{1u} &= \frac{e_{3u}}{e_{1u}}\; \frac
- 		{\alpha_u \;\delta_{i+1/2}[T] - \beta_u \;\delta_{i+1/2}[S]}
-		{\alpha_u \;\overline{\overline{\delta_{k+1/2}[T]}}^{\,i+1/2,\,k}
-		 -\beta_u  \;\overline{\overline{\delta_{k+1/2}[S]}}^{\,i+1/2,\,k} }
-\\
- r_{2v} &= \frac{e_{3v}}{e_{2v}}\; \frac
- 		{\alpha_v \;\delta_{j+1/2}[T] - \beta_v \;\delta_{j+1/2}[S]}
-		{\alpha_v \;\overline{\overline{\delta_{k+1/2}[T]}}^{\,j+1/2,\,k}
-		 -\beta_v  \;\overline{\overline{\delta_{k+1/2}[S]}}^{\,j+1/2,\,k} }
-\\
- r_{1w} &= \frac{e_{3w}}{e_{1w}}\; \frac
-		{\alpha_w \;\overline{\overline{\delta_{i+1/2}[T]}}^{\,i,\,k+1/2}
-		 -\beta_w  \;\overline{\overline{\delta_{i+1/2}[S]}}^{\,i,\,k+1/2} }
- 		{\alpha_w \;\delta_{k+1/2}[T] - \beta_w \;\delta_{k+1/2}[S]}
-\\
- r_{2w} &= \frac{e_{3w}}{e_{2w}}\; \frac
-		{\alpha_w \;\overline{\overline{\delta_{j+1/2}[T]}}^{\,j,\,k+1/2}
-		 -\beta_w  \;\overline{\overline{\delta_{j+1/2}[S]}}^{\,j,\,k+1/2} }
- 		{\alpha_w \;\delta_{k+1/2}[T] - \beta_w \;\delta_{k+1/2}[S]}
-\\
-\end{split}
-\end{equation}
-where $\alpha$ and $\beta$, the thermal expansion and saline contraction 
-coefficients introduced in \S\ref{TRA_bn2}, have to be evaluated at the three 
-velocity points. In order to save computation time, they should be approximated 
-by the mean of their values at $T$-points (for example in the case of $\alpha$:  
-$\alpha_u=\overline{\alpha_T}^{i+1/2}$,  $\alpha_v=\overline{\alpha_T}^{j+1/2}$ 
-and $\alpha_w=\overline{\alpha_T}^{k+1/2}$).
-
-Note that such a formulation could be also used in the $z$-coordinate and 
-$z$-coordinate with partial steps cases.
-
-\end{description}
-
-This implementation is a rather old one. It is similar to the one
-proposed by Cox [1987], except for the background horizontal
-diffusion. Indeed, the Cox implementation of isopycnal diffusion in
-GFDL-type models requires a minimum background horizontal diffusion
-for numerical stability reasons.  To overcome this problem, several
-techniques have been proposed in which the numerical schemes of the
-ocean model are modified \citep{Weaver_Eby_JPO97,
-  Griffies_al_JPO98}. Griffies's scheme is now available in \NEMO if
-\np{traldf\_grif\_iso} is set true; see Appdx \ref{sec:triad}. Here,
-another strategy is presented \citep{Lazar_PhD97}: a local
-filtering of the iso-neutral slopes (made on 9 grid-points) prevents
-the development of grid point noise generated by the iso-neutral
-diffusion operator (Fig.~\ref{Fig_LDF_ZDF1}). This allows an
-iso-neutral diffusion scheme without additional background horizontal
-mixing. This technique can be viewed as a diffusion operator that acts
-along large-scale (2~$\Delta$x) \gmcomment{2deltax doesnt seem very
-  large scale} iso-neutral surfaces. The diapycnal diffusion required
-for numerical stability is thus minimized and its net effect on the
-flow is quite small when compared to the effect of an horizontal
-background mixing.
-
-Nevertheless, this iso-neutral operator does not ensure that variance cannot increase, 
-contrary to the \citet{Griffies_al_JPO98} operator which has that property. 
-
-%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-\begin{figure}[!ht]      \begin{center}
-\includegraphics[width=0.70\textwidth]{./TexFiles/Figures/Fig_LDF_ZDF1.pdf}
-\caption {    \label{Fig_LDF_ZDF1}
-averaging procedure for isopycnal slope computation.}
-\end{center}    \end{figure}
-%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-
-%There are three additional questions about the slope calculation. 
-%First the expression for the rotation tensor has been obtain assuming the "small slope" approximation, so a bound has to be imposed on slopes. 
-%Second, numerical stability issues also require a bound on slopes. 
-%Third, the question of boundary condition specified on slopes...
-
-%from griffies: chapter 13.1....
-
-
-
-% In addition and also for numerical stability reasons \citep{Cox1987, Griffies_Bk04}, 
-% the slopes are bounded by $1/100$ everywhere. This limit is decreasing linearly 
-% to zero fom $70$ meters depth and the surface (the fact that the eddies "feel" the 
-% surface motivates this flattening of isopycnals near the surface).
-
-For numerical stability reasons \citep{Cox1987, Griffies_Bk04}, the slopes must also 
-be bounded by $1/100$ everywhere. This constraint is applied in a piecewise linear 
-fashion, increasing from zero at the surface to $1/100$ at $70$ metres and thereafter 
-decreasing to zero at the bottom of the ocean. (the fact that the eddies "feel" the 
-surface motivates this flattening of isopycnals near the surface).
-
-%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-\begin{figure}[!ht]     \begin{center}
-\includegraphics[width=0.70\textwidth]{./TexFiles/Figures/Fig_eiv_slp.pdf}
-\caption {     \label{Fig_eiv_slp}
-Vertical profile of the slope used for lateral mixing in the mixed layer : 
-\textit{(a)} in the real ocean the slope is the iso-neutral slope in the ocean interior, 
-which has to be adjusted at the surface boundary (i.e. it must tend to zero at the 
-surface since there is no mixing across the air-sea interface: wall boundary 
-condition). Nevertheless, the profile between the surface zero value and the interior 
-iso-neutral one is unknown, and especially the value at the base of the mixed layer ; 
-\textit{(b)} profile of slope using a linear tapering of the slope near the surface and 
-imposing a maximum slope of 1/100 ; \textit{(c)} profile of slope actually used in 
-\NEMO: a linear decrease of the slope from zero at the surface to its ocean interior 
-value computed just below the mixed layer. Note the huge change in the slope at the 
-base of the mixed layer between  \textit{(b)}  and \textit{(c)}.}
-\end{center}   \end{figure}
-%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-
-\colorbox{yellow}{add here a discussion about the flattening of the slopes, vs  tapering the coefficient.}
-
-\subsection{slopes for momentum iso-neutral mixing}
-
-The iso-neutral diffusion operator on momentum is the same as the one used on 
-tracers but applied to each component of the velocity separately (see 
-\eqref{Eq_dyn_ldf_iso} in section~\ref{DYN_ldf_iso}). The slopes between the 
-surface along which the diffusion operator acts and the surface of computation 
-($z$- or $s$-surfaces) are defined at $T$-, $f$-, and \textit{uw}- points for the 
-$u$-component, and $T$-, $f$- and \textit{vw}- points for the $v$-component. 
-They are computed from the slopes used for tracer diffusion, $i.e.$ 
-\eqref{Eq_ldfslp_geo} and \eqref{Eq_ldfslp_iso} :
-
-\begin{equation} \label{Eq_ldfslp_dyn}
-\begin{aligned}
-&r_{1t}\ \ = \overline{r_{1u}}^{\,i}       &&&    r_{1f}\ \ &= \overline{r_{1u}}^{\,i+1/2} \\
-&r_{2f} \ \ = \overline{r_{2v}}^{\,j+1/2} &&& 	r_{2t}\ &= \overline{r_{2v}}^{\,j} \\
-&r_{1uw}  = \overline{r_{1w}}^{\,i+1/2} &&\ \ \text{and} \ \ &   r_{1vw}&= \overline{r_{1w}}^{\,j+1/2} \\
-&r_{2uw}= \overline{r_{2w}}^{\,j+1/2} &&&         r_{2vw}&= \overline{r_{2w}}^{\,j+1/2}\\
-\end{aligned}
-\end{equation}
-
-The major issue remaining is in the specification of the boundary conditions. 
-The same boundary conditions are chosen as those used for lateral 
-diffusion along model level surfaces, i.e. using the shear computed along 
-the model levels and with no additional friction at the ocean bottom (see 
-{\S\ref{LBC_coast}).
-
-
-% ================================================================
 % Eddy Induced Mixing
 % ================================================================
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_Model_Basics.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_Model_Basics.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_Model_Basics.tex	(revision 6808)
@@ -247,75 +247,15 @@
 sufficient to solve a linearized version of (\ref{Eq_PE_ssh}), which still allows 
 to take into account freshwater fluxes applied at the ocean surface \citep{Roullet_Madec_JGR00}.
+Nevertheless, with the linearization, an exact conservation of heat and salt contents is lost.
 
 The filtering of EGWs in models with a free surface is usually a matter of discretisation 
-of the temporal derivatives, using the time splitting method \citep{Killworth_al_JPO91, Zhang_Endoh_JGR92} 
-or the implicit scheme \citep{Dukowicz1994}. In \NEMO, we use a slightly different approach 
-developed by \citet{Roullet_Madec_JGR00}: the damping of EGWs is ensured by introducing an 
-additional force in the momentum equation. \eqref{Eq_PE_dyn} becomes: 
-\begin{equation} \label{Eq_PE_flt}
-\frac{\partial {\rm {\bf U}}_h }{\partial t}= {\rm {\bf M}}
-- g \nabla \left( \tilde{\rho} \ \eta \right) 
-- g \ T_c \nabla \left( \widetilde{\rho} \ \partial_t \eta \right) 
-\end{equation}
-where $T_c$, is a parameter with dimensions of time which characterizes the force, 
-$\widetilde{\rho} = \rho / \rho_o$ is the dimensionless density, and $\rm {\bf M}$ 
-represents the collected contributions of the Coriolis, hydrostatic pressure gradient, 
-non-linear and viscous terms in \eqref{Eq_PE_dyn}.
-
-The new force can be interpreted as a diffusion of vertically integrated volume flux divergence. 
-The time evolution of $D$ is thus governed by a balance of two terms, $-g$ \textbf{A} $\eta$ 
-and $g \, T_c \,$ \textbf{A} $D$, associated with a propagative regime and a diffusive regime 
-in the temporal spectrum, respectively. In the diffusive regime, the EGWs no longer propagate, 
-$i.e.$ they are stationary and damped. The diffusion regime applies to the modes shorter than 
-$T_c$. For longer ones, the diffusion term vanishes. Hence, the temporally unresolved EGWs 
-can be damped by choosing $T_c > \rdt$. \citet{Roullet_Madec_JGR00} demonstrate that 
-(\ref{Eq_PE_flt}) can be integrated with a leap frog scheme except the additional term which 
-has to be computed implicitly. This is not surprising since the use of a large time step has a 
-necessarily numerical cost. Two gains arise in comparison with the previous formulations. 
-Firstly, the damping of EGWs can be quantified through the magnitude of the additional term. 
-Secondly, the numerical scheme does not need any tuning. Numerical stability is ensured as 
-soon as $T_c > \rdt$.
-
-When the variations of free surface elevation are small compared to the thickness of the first 
-model layer, the free surface equation (\ref{Eq_PE_ssh}) can be linearized. As emphasized 
-by \citet{Roullet_Madec_JGR00} the linearization of (\ref{Eq_PE_ssh}) has consequences on the 
-conservation of salt in the model. With the nonlinear free surface equation, the time evolution 
-of the total salt content is 
-\begin{equation} \label{Eq_PE_salt_content}
-    \frac{\partial }{\partial t}\int\limits_{D\eta } {S\;dv} 
-                        =\int\limits_S {S\;(-\frac{\partial \eta }{\partial t}-D+P-E)\;ds}
-\end{equation}
-where $S$ is the salinity, and the total salt is integrated over the whole ocean volume 
-$D_\eta$ bounded by the time-dependent free surface. The right hand side (which is an 
-integral over the free surface) vanishes when the nonlinear equation (\ref{Eq_PE_ssh}) 
-is satisfied, so that the salt is perfectly conserved. When the free surface equation is 
-linearized, \citet{Roullet_Madec_JGR00} show that the total salt content integrated in the fixed 
-volume $D$ (bounded by the surface $z=0$) is no longer conserved:
-\begin{equation} \label{Eq_PE_salt_content_linear}
-         \frac{\partial }{\partial t}\int\limits_D {S\;dv} 
-         		= - \int\limits_S {S\;\frac{\partial \eta }{\partial t}ds} 
-\end{equation}
-
-The right hand side of (\ref{Eq_PE_salt_content_linear}) is small in equilibrium solutions 
-\citep{Roullet_Madec_JGR00}. It can be significant when the freshwater forcing is not balanced and 
-the globally averaged free surface is drifting. An increase in sea surface height \textit{$\eta $} 
-results in a decrease of the salinity in the fixed volume $D$. Even in that case though, 
-the total salt integrated in the variable volume $D_{\eta}$ varies much less, since 
-(\ref{Eq_PE_salt_content_linear}) can be rewritten as 
-\begin{equation} \label{Eq_PE_salt_content_corrected}
-\frac{\partial }{\partial t}\int\limits_{D\eta } {S\;dv} 
-=\frac{\partial}{\partial t} \left[ \;{\int\limits_D {S\;dv} +\int\limits_S {S\eta \;ds} } \right]
-=\int\limits_S {\eta \;\frac{\partial S}{\partial t}ds}
-\end{equation}
-
-Although the total salt content is not exactly conserved with the linearized free surface, 
-its variations are driven by correlations of the time variation of surface salinity with the 
-sea surface height, which is a negligible term. This situation contrasts with the case of 
-the rigid lid approximation in which case freshwater forcing is represented by a virtual 
-salt flux, leading to a spurious source of salt at the ocean surface 
-\citep{Huang_JPO93, Roullet_Madec_JGR00}.
-
-\newpage
-$\ $\newline    % force a new ligne
+of the temporal derivatives, using a split-explicit method \citep{Killworth_al_JPO91, Zhang_Endoh_JGR92} 
+or the implicit scheme \citep{Dukowicz1994} or the addition of a filtering force in the momentum equation 
+\citep{Roullet_Madec_JGR00}. With the present release, \NEMO offers the choice between 
+an explicit free surface (see \S\ref{DYN_spg_exp}) or a split-explicit scheme strongly 
+inspired the one proposed by \citet{Shchepetkin_McWilliams_OM05} (see \S\ref{DYN_spg_ts}).
+
+%\newpage
+%$\ $\newline    % force a new ligne
 
 % ================================================================
@@ -655,9 +595,5 @@
 the surface pressure, is given by:
 \begin{equation} \label{Eq_PE_spg}
-p_s = \left\{ \begin{split} 
-\rho \,g \,\eta &                                 \qquad  \qquad  \;   \qquad \text{ standard free surface} \\ 
-\rho \,g \,\eta &+ \rho_o \,\mu \,\frac{\partial \eta }{\partial t}      \qquad \text{ filtered     free surface}    
-\end{split} 
-\right.
+p_s =  \rho \,g \,\eta 
 \end{equation}
 with $\eta$ is solution of \eqref{Eq_PE_ssh}
@@ -773,10 +709,10 @@
 \end{equation}
 
-The equations solved by the ocean model \eqref{Eq_PE} in $s-$coordinate can be written as follows:
+The equations solved by the ocean model \eqref{Eq_PE} in $s-$coordinate can be written as follows (see Appendix~\ref{Apdx_A_momentum}):
 
  \vspace{0.5cm}
-* momentum equation:
+$\bullet$ Vector invariant form of the momentum equation :
 \begin{multline} \label{Eq_PE_sco_u}
-\frac{1}{e_3} \frac{\partial \left(  e_3\,u  \right) }{\partial t}=
+\frac{\partial  u   }{\partial t}=
 	+   \left( {\zeta +f} \right)\,v                                    
 	-   \frac{1}{2\,e_1} \frac{\partial}{\partial i} \left(  u^2+v^2   \right) 
@@ -787,5 +723,5 @@
 \end{multline}
 \begin{multline} \label{Eq_PE_sco_v}
-\frac{1}{e_3} \frac{\partial \left(  e_3\,v  \right) }{\partial t}=
+\frac{\partial v }{\partial t}=
 	-   \left( {\zeta +f} \right)\,u   
 	-   \frac{1}{2\,e_2 }\frac{\partial }{\partial j}\left(  u^2+v^2  \right)     	
@@ -795,9 +731,38 @@
 	+  D_v^{\vect{U}}  +   F_v^{\vect{U}} \quad
 \end{multline}
+
+ \vspace{0.5cm}
+$\bullet$ Vector invariant form of the momentum equation :
+\begin{multline} \label{Eq_PE_sco_u}
+\frac{1}{e_3} \frac{\partial \left(  e_3\,u  \right) }{\partial t}=
+   +   \left( { f + \frac{1}{e_1 \; e_2 }
+					\left( 	 v \frac{\partial e_2}{\partial i}
+						-u \frac{\partial e_1}{\partial j} 	\right)} 	\right) \, v    \\
+   - \frac{1}{e_1 \; e_2 \; e_3 } 	\left( 
+					\frac{\partial \left( {e_2 \, e_3 \, u\,u} \right)}{\partial i}
+		+			\frac{\partial \left( {e_1 \, e_3 \, v\,u} \right)}{\partial j}	\right)
+   - \frac{1}{e_3 }\frac{\partial \left( { \omega\,u} \right)}{\partial k}    \\
+	- \frac{1}{e_1} \frac{\partial}{\partial i} \left( \frac{p_s + p_h}{\rho _o}    \right)    
+	+  g\frac{\rho }{\rho _o}\sigma _1 
+	+   D_u^{\vect{U}}  +   F_u^{\vect{U}} \quad
+\end{multline}
+\begin{multline} \label{Eq_PE_sco_v}
+\frac{1}{e_3} \frac{\partial \left(  e_3\,v  \right) }{\partial t}=
+   -   \left( { f + \frac{1}{e_1 \; e_2}
+					\left( 	 v \frac{\partial e_2}{\partial i}
+						-u \frac{\partial e_1}{\partial j} 	\right)} 	\right) \, u   \\
+   - \frac{1}{e_1 \; e_2 \; e_3 } 	\left( 
+					\frac{\partial \left( {e_2 \; e_3  \,u\,v} \right)}{\partial i}
+		+			\frac{\partial \left( {e_1 \; e_3  \,v\,v} \right)}{\partial j}	\right)
+                 - \frac{1}{e_3 } \frac{\partial \left( { \omega\,v} \right)}{\partial k}    \\
+	-   \frac{1}{e_2 }\frac{\partial }{\partial j}\left( \frac{p_s+p_h }{\rho _o}  \right) 
+	 +  g\frac{\rho }{\rho _o }\sigma _2   
+	+  D_v^{\vect{U}}  +   F_v^{\vect{U}} \quad
+\end{multline}
+
 where the relative vorticity, \textit{$\zeta $}, the surface pressure gradient, and the hydrostatic 
 pressure have the same expressions as in $z$-coordinates although they do not represent 
 exactly the same quantities. $\omega$ is provided by the continuity equation 
 (see Appendix~\ref{Apdx_A}):
-
 \begin{equation} \label{Eq_PE_sco_continuity}
 \frac{\partial e_3}{\partial t} + e_3 \; \chi + \frac{\partial \omega }{\partial s} = 0   
@@ -809,5 +774,5 @@
 
  \vspace{0.5cm}
-* tracer equations:
+$\bullet$ tracer equations:
 \begin{multline} \label{Eq_PE_sco_t}
 \frac{1}{e_3} \frac{\partial \left(  e_3\,T  \right) }{\partial t}=
@@ -1024,5 +989,7 @@
 
 The $\tilde{z}$-coordinate has been developed by \citet{Leclair_Madec_OM10s}.
-It is not available in the current version of \NEMO.
+It is available in \NEMO since the version 3.4. Nevertheless, it is currently not robust enough 
+to be used in all possible configurations. Its use is therefore not recommended.
+We 
 
 \newpage 
@@ -1180,8 +1147,10 @@
 ocean (see Appendix~\ref{Apdx_B}).
 
+For \textit{iso-level} diffusion, $r_1$ and $r_2 $ are zero. $\Re $ reduces to the identity 
+in the horizontal direction, no rotation is applied. 
+
 For \textit{geopotential} diffusion, $r_1$ and $r_2 $ are the slopes between the 
-geopotential and computational surfaces: in $z$-coordinates they are zero 
-($r_1 = r_2 = 0$) while in $s$-coordinate (including $\textit{z*}$ case) they are 
-equal to $\sigma _1$ and $\sigma _2$, respectively (see \eqref{Eq_PE_sco_slope} ).
+geopotential and computational surfaces: they are equal to $\sigma _1$ and $\sigma _2$, 
+respectively (see \eqref{Eq_PE_sco_slope} ).
 
 For \textit{isoneutral} diffusion $r_1$ and $r_2$ are the slopes between the isoneutral 
@@ -1235,10 +1204,9 @@
 The lateral fourth order tracer diffusive operator is defined by:
 \begin{equation} \label{Eq_PE_bilapT}
-D^{lT}=\Delta \left( {A^{lT}\;\Delta T} \right) 
-\qquad \text{where} \  D^{lT}=\Delta \left( {A^{lT}\;\Delta T} \right)
+D^{lT}=\Delta \left( \;\Delta T \right) 
+\qquad \text{where} \;\; \Delta \bullet = \nabla \left( {\sqrt{B^{lT}\,}\;\Re \;\nabla \bullet} \right)
  \end{equation}
-
 It is the second order operator given by \eqref{Eq_PE_iso_tensor} applied twice with 
-the eddy diffusion coefficient correctly placed. 
+the harmonic eddy diffusion coefficient set to the square root of the biharmonic one. 
 
 
@@ -1262,13 +1230,13 @@
 
 Such a formulation ensures a complete separation between the vorticity and 
-horizontal divergence fields (see Appendix~\ref{Apdx_C}). Unfortunately, it is not 
-available for geopotential diffusion in $s-$coordinates and for isoneutral 
-diffusion in both $z$- and $s$-coordinates ($i.e.$ when a rotation is required). 
-In these two cases, the $u$ and $v-$fields are considered as independent scalar 
-fields, so that the diffusive operator is given by:
+horizontal divergence fields (see Appendix~\ref{Apdx_C}). 
+Unfortunately, it is only available in \textit{iso-level} direction. 
+When a rotation is required ($i.e.$ geopotential diffusion in $s-$coordinates 
+or isoneutral diffusion in both $z$- and $s$-coordinates), the $u$ and $v-$fields 
+are considered as independent scalar fields, so that the diffusive operator is given by:
 \begin{equation} \label{Eq_PE_lapU_iso}
 \begin{split}
- D_u^{l{\rm {\bf U}}} &= \nabla .\left( {\Re \;\nabla u} \right) \\ 
- D_v^{l{\rm {\bf U}}} &= \nabla .\left( {\Re \;\nabla v} \right)
+ D_u^{l{\rm {\bf U}}} &= \nabla .\left( {A^{lm} \;\Re \;\nabla u} \right) \\ 
+ D_v^{l{\rm {\bf U}}} &= \nabla .\left( {A^{lm} \;\Re \;\nabla v} \right)
  \end{split}
  \end{equation}
@@ -1282,29 +1250,5 @@
 
 As for tracers, the fourth order momentum diffusive operator along $z$ or $s$-surfaces 
-is a re-entering second order operator \eqref{Eq_PE_lapU} or \eqref{Eq_PE_lapU} 
-with the eddy viscosity coefficient correctly placed:
-
-geopotential diffusion in $z$-coordinate:
-\begin{equation} \label{Eq_PE_bilapU}
-\begin{split}
-{\rm {\bf D}}^{l{\rm {\bf U}}} &=\nabla _h \left\{ {\;\nabla _h {\rm {\bf 
-.}}\left[ {A^{lm}\,\nabla _h \left( \chi \right)} \right]\;} 
-\right\}\;   \\
-&+\nabla _h \times \left\{ {\;{\rm {\bf k}}\cdot \nabla \times 
-\left[ {A^{lm}\,\nabla _h \times \left( {\zeta \;{\rm {\bf k}}} \right)} 
-\right]\;} \right\}
-\end{split}
-\end{equation}
-
-\gmcomment{  change the position of the coefficient, both here and in the code}
-
-geopotential diffusion in $s$-coordinate:
-\begin{equation} \label{Eq_bilapU_iso}
-   \left\{   \begin{aligned}
-         D_u^{l{\rm {\bf U}}} =\Delta \left( {A^{lm}\;\Delta u} \right) \\ 
-         D_v^{l{\rm {\bf U}}} =\Delta \left( {A^{lm}\;\Delta v} \right)
-   \end{aligned}    \right.
-   \quad \text{where} \quad 
-   \Delta \left( \bullet \right) = \nabla \cdot \left( \Re \nabla(\bullet) \right) 
-\end{equation}
-
+is a re-entering second order operator \eqref{Eq_PE_lapU} or \eqref{Eq_PE_lapU_iso} 
+with the harmonic eddy diffusion coefficient set to the square root of the biharmonic one.
+
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_Model_Basics_zstar.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_Model_Basics_zstar.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_Model_Basics_zstar.tex	(revision 6808)
@@ -1,4 +1,4 @@
 % ================================================================
-% Chapter 1 � Model Basics
+% Chapter 1 ——— Model Basics
 % ================================================================
 % ================================================================
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_OBS.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_OBS.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_OBS.tex	(revision 6808)
@@ -18,10 +18,10 @@
 location and nearest model timestep. The resulting data are saved in a ``feedback'' file (or
 files). The code was originally developed for use with the NEMOVAR data assimilation code, but
-can be used for validation or verification of model or  any other data assimilation system.
-
-The OBS code is called from \mdl{nemogcm.F90} for model initialisation and to calculate the model
+can be used for validation or verification of the model or with any other data assimilation system.
+
+The OBS code is called from \mdl{nemogcm} for model initialisation and to calculate the model
 equivalent values for observations on the 0th timestep. The code is then called again after
-each timestep from \mdl{step.F90}. To build with the OBS code active \key{diaobs} must be
-set.
+each timestep from \mdl{step}. The code is only activated if the namelist logical \np{ln\_diaobs}
+is set to true.
 
 For all data types a 2D horizontal  interpolator is needed to interpolate the model fields to
@@ -29,13 +29,15 @@
 addition to provide model fields at the observation depths. Currently this only works in
 z-level model configurations, but is being developed to work with a generalised vertical
-coordinate system. Temperature data from moored buoys (TAO, TRITON, PIRATA) in the
-ENACT/ENSEMBLES data-base are available as daily averaged quantities. For this type of
-observation the observation operator will compare such observations to the model temperature
-fields averaged over one day. The relevant observation type may be specified in the namelist
-using \np{endailyavtypes}. Otherwise the model value from the nearest timestep to the
+coordinate system. 
+
+Some profile observation types (e.g. tropical moored buoys) are made available as daily averaged quantities.
+The observation operator code can be set-up to calculated the equivalent daily average model temperature fields
+using the \np{nn\_profdavtypes} namelist array. Some SST observations are equivalent to a night-time
+average value and the observation operator code can calculate equivalent night-time average model SST fields by
+setting the namelist value \np{ln\_sstnight} to true. Otherwise the model value from the nearest timestep to the
 observation time is used.
 
 The code is controlled by the namelist \textit{nam\_obs}. See the following sections for more
-details on setting up the namelist. 
+details on setting up the namelist.
 
 Section~\ref{OBS_example} introduces a test example of the observation operator code including
@@ -59,14 +61,23 @@
 
 \begin{enumerate}
-\item Compile NEMO with \key{diaobs} set.
-
-\item Download some ENSEMBLES EN3 data from 
-\href{http://www.hadobs.org}{http://www.hadobs.org}. Choose observations which are
+\item Compile NEMO.
+
+\item Download some EN4 data from 
+\href{http://www.metoffice.gov.uk/hadobs}{http://www.metoffice.gov.uk/hadobs}. Choose observations which are
 valid for the period of your test run because the observation operator compares
 the model and observations for a matching date and time. 
 
-\item Add the following to the NEMO namelist to run the observation
-operator on this data. Set the \np{enactfiles} namelist variable to the
-observation  file name:
+\item Compile the OBSTOOLS code using: 
+\begin{verbatim}
+./maketools -n OBSTOOLS -m [ARCH].
+\end{verbatim}
+
+\item Convert the EN4 data into feedback format: 
+\begin{verbatim}
+enact2fb.exe profiles_01.nc EN.4.1.1.f.profiles.g10.YYYYMM.nc
+\end{verbatim}
+
+\item Include the following in the NEMO namelist to run the observation
+operator on this data:
 \end{enumerate}
 
@@ -77,7 +88,6 @@
 Options are defined through the  \ngn{namobs} namelist variables.
 The options \np{ln\_t3d} and \np{ln\_s3d} switch on the temperature and salinity
-profile observation operator code. The \np{ln\_ena} switch turns on the reading
-of ENACT/ENSEMBLES type profile data. The filename or array of filenames are
-specified using the \np{enactfiles} variable. The model grid points for a
+profile observation operator code. The filename or array of filenames are
+specified using the \np{cn\_profbfiles} variable. The model grid points for a
 particular  observation latitude and longitude are found using the grid
 searching part of the code. This can be expensive, particularly for large
@@ -92,4 +102,6 @@
 A number of utilities are now provided to plot the feedback files, convert and
 recombine the files. These are explained in more detail in section~\ref{OBS_obsutils}.
+Utilites to convert other input data formats into the feedback format are also 
+described in section~\ref{OBS_obsutils}.
 
 \section{Technical details}
@@ -104,6 +116,6 @@
 %-------------------------------------------------------------------------------------------------------------
 
-This name list uses the "feedback" type observation file input format for
-profile, sea level anomaly and sea surface temperature data. All the
+The observation operator code uses the "feedback" observation file format for
+all data types. All the
 observation files must be in NetCDF format. Some example headers (produced using
 \mbox{\textit{ncdump~-h}}) for profile
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_SBC.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_SBC.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_SBC.tex	(revision 6808)
@@ -49,6 +49,5 @@
 (\np{nn\_ice}~=~0,1, 2 or 3); the addition of river runoffs as surface freshwater 
 fluxes or lateral inflow (\np{ln\_rnf}~=~true); the addition of isf melting as lateral inflow (parameterisation) 
-(\np{nn\_isf}~=~2 or 3 and \np{ln\_isfcav}~=~false) or as surface flux at the land-ice ocean interface
-(\np{nn\_isf}~=~1 or 4 and \np{ln\_isfcav}~=~true); 
+ or as surface flux at the land-ice ocean interface (\np{ln\_isf}=~true); 
 the addition of a freshwater flux adjustment in order to avoid a mean sea-level drift (\np{nn\_fwb}~=~0,~1~or~2); the 
 transformation of the solar radiation (if provided as daily mean) into a diurnal 
@@ -958,8 +957,9 @@
 \namdisplay{namsbc_isf}
 %--------------------------------------------------------------------------------------------------------
-Namelist variable in \ngn{namsbc}, \np{nn\_isf},  control the kind of ice shelf representation used. 
+Namelist variable in \ngn{namsbc}, \np{nn\_isf}, control the kind of ice shelf representation used. 
 \begin{description}
 \item[\np{nn\_isf}~=~1]
-The ice shelf cavity is represented. The fwf and heat flux are computed. 
+The ice shelf cavity is represented. The fwf and heat flux are computed. 2 bulk formulations are available: the ISOMIP one (\np{nn\_isfblk = 1}) described in (\np{nn\_isfblk = 2}), the 3 equation formulation described in \citet{Jenkins1991}. In addition to this, 
+3 different way to compute the exchange coefficient are available. $\gamma\_{T/S}$ is constant (\np{nn\_gammablk = 0}), $\gamma\_{T/S}$ is velocity dependant \citep{Jenkins2010} (\np{nn\_gammablk = 1}) and $\gamma\_{T/S}$ is velocity dependant and stratification dependent \citep{Holland1999} (\np{nn\_gammablk = 2}). For each of them, the thermal/salt exchange coefficient (\np{rn\_gammat0} and \np{rn\_gammas0}) have to be specified (the default values are for the ISOMIP case). 
 Full description, sensitivity and validation in preparation. 
 
@@ -969,5 +969,5 @@
 (\np{sn\_depmax\_isf}) and the base of the ice shelf along the calving front (\np{sn\_depmin\_isf}) as in (\np{nn\_isf}~=~3). 
 Furthermore the fwf is computed using the \citet{Beckmann2003} parameterisation of isf melting. 
-The effective melting length (\np{sn\_Leff\_isf}) is read from a file.
+The effective melting length (\np{sn\_Leff\_isf}) is read from a file and the exchange coefficients are set as (\np{rn\_gammat0}) and (\np{rn\_gammas0}).
 
 \item[\np{nn\_isf}~=~3]
@@ -987,13 +987,45 @@
 \np{nn\_isf}~=~3 and \np{nn\_isf}~=~4 read the melt rate and heat flux from a file. You have total control of the fwf scenario.
 
- This can be usefull if the water masses on the shelf are not realistic or the resolution (horizontal/vertical) are too 
+This can be usefull if the water masses on the shelf are not realistic or the resolution (horizontal/vertical) are too 
 coarse to have realistic melting or for sensitivity studies where you want to control your input. 
 Full description, sensitivity and validation in preparation. 
 
-There is 2 ways to apply the fwf to NEMO. The first possibility (\np{ln\_divisf}~=~false) applied the fwf
- and heat flux directly on the salinity and temperature tendancy. The second possibility (\np{ln\_divisf}~=~true)
- apply the fwf as for the runoff fwf (see \S\ref{SBC_rnf}). The mass/volume addition due to the ice shelf melting is,
- at each relevant depth level, added to the horizontal divergence (\textit{hdivn}) in the subroutine \rou{sbc\_isf\_div} 
-(called from \mdl{divcur}). 
+\np{rn\_hisf\_tbl} is the top boundary layer (tbl) thickness used by the Losch parametrisation \citep{Losch2008} to compute the melt. if 0, temperature/salt/velocity in the top cell is used to compute the melt.
+Otherwise, NEMO used the mean value into the tbl. 
+
+\section{ Ice sheet coupling}
+\label{SBC_iscpl}
+%------------------------------------------namsbc_iscpl----------------------------------------------------
+\namdisplay{namsbc_iscpl}
+%--------------------------------------------------------------------------------------------------------
+Ice sheet/ocean coupling is done through file exchange at the restart step. NEMO, at each restart step, 
+read the bathymetry and ice shelf draft variable in a netcdf file. 
+If \np{ln\_iscpl = ~true}, the isf draft is assume to be different at each restart step 
+with potentially some new wet/dry cells due to the ice sheet dynamics/thermodynamics.
+The wetting and drying scheme applied on the restart is very simple and described below for the 6 different cases:
+\begin{description}
+\item[Thin a cell down:]
+	T/S/ssh are unchanged and U/V in the top cell are corrected to keep the barotropic transport (bt) constant ($bt_b=bt_n$).
+\item[Enlarge  a cell:]
+	See case "Thin a cell down"
+\item[Dry a cell:]
+	mask, T/S, U/V and ssh are set to 0. Furthermore, U/V into the water column are modified to satisfy ($bt_b=bt_n$).
+\item[Wet a cell:] 
+	mask is set to 1, T/S is extrapolated from neighbours, $ssh_n = ssh_b$ and U/V set to 0. If no neighbours along i,j and k, T/S/U/V and mask are set to 0.
+\item[Dry a column:]
+	mask, T/S, U/V are set to 0 everywhere in the column and ssh set to 0.
+\item[Wet a column:]
+	set mask to 1, T/S is extrapolated from neighbours, ssh is extrapolated from neighbours and U/V set to 0. If no neighbour, T/S/U/V and mask set to 0.
+\end{description}
+The extrapolation is call \np{nn\_drown} times. It means that if the grounding line retreat by more than \np{nn\_drown} cells between 2 coupling steps,
+ the code will be unable to fill all the new wet cells properly. The default number is set up for the MISOMIP idealised experiments.\\
+This coupling procedure is able to take into account grounding line and calving front migration. However, it is a non-conservative processe. 
+This could lead to a trend in heat/salt content and volume. In order to remove the trend and keep the conservation level as close to 0 as possible,
+ a simple conservation scheme is available with \np{ln\_hsb = ~true}. The heat/salt/vol. gain/loss is diagnose, as well as the location. 
+Based on what is done on sbcrnf to prescribed a source of heat/salt/vol., the heat/salt/vol. gain/loss is removed/added,
+ over a period of \np{rn\_fiscpl} time step, into the system. 
+So after \np{rn\_fiscpl} time step, all the heat/salt/vol. gain/loss due to extrapolation process is canceled.\\
+
+As the before and now fields are not compatible (modification of the geometry), the restart time step is prescribed to be an euler time step instead of a leap frog and $fields_b = fields_n$.
 %
 % ================================================================
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_STP.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_STP.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_STP.tex	(revision 6808)
@@ -1,5 +1,5 @@
 
 % ================================================================
-% Chapter 2 � Time Domain (step.F90)
+% Chapter 2 ——— Time Domain (step.F90)
 % ================================================================
 \chapter{Time Domain (STP) }
@@ -21,5 +21,7 @@
 
 Having defined the continuous equations in Chap.~\ref{PE}, we need now to choose 
-a time discretization. In the present chapter, we provide a general description of the \NEMO 
+a time discretization, a key feature of an ocean model as it exerts a strong influence  
+on the structure of the computer code ($i.e.$ on its flowchart). 
+In the present chapter, we provide a general description of the \NEMO 
 time stepping strategy and the consequences for the order in which the equations are
 solved.
@@ -158,4 +160,8 @@
 \end{equation} 
 
+%%gm
+%%gm   UPDATE the next paragraphs with time varying thickness ...
+%%gm
+
 This scheme is rather time consuming since it requires a matrix inversion, 
 but it becomes attractive since a value of 3 or more is needed for N in
@@ -188,8 +194,10 @@
 
 % -------------------------------------------------------------------------------------------------------------
-%        Hydrostatic Pressure gradient
-% -------------------------------------------------------------------------------------------------------------
-\section{Hydrostatic Pressure Gradient --- semi-implicit scheme}
-\label{STP_hpg_imp}
+%        Surface Pressure gradient
+% -------------------------------------------------------------------------------------------------------------
+\section{Surface Pressure Gradient}
+\label{STP_spg_ts}
+
+===>>>>  TO BE written....  :-)
 
 %\gmcomment{ 
@@ -209,34 +217,4 @@
 %>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 %}
-
-The range of stability of the Leap-Frog scheme can be extended by a factor of two
-by introducing a semi-implicit computation of the hydrostatic pressure gradient term
-\citep{Brown_Campana_MWR78}. Instead of evaluating the pressure at $t$, a linear 
-combination of values at $t-\rdt$, $t$ and $t+\rdt$ is used (see \S~\ref{DYN_hpg_imp}).  
-This technique, controlled by the \np{nn\_dynhpg\_rst} namelist parameter, does not 
-introduce a significant additional computational cost when tracers and thus density 
-is time stepped before the dynamics. This time step ordering is used in \NEMO 
-(Fig.\ref{Fig_TimeStep_flowchart}).
-
-
-This technique, used in several GCMs (\NEMO, POP or MOM for instance), 
-makes the Leap-Frog scheme as efficient 
-\footnote{The efficiency is defined as the maximum allowed Courant number of the time 
-stepping scheme divided by the number of computations of the right-hand side per time step.} 
-as the Forward-Backward scheme used in MOM \citep{Griffies_al_OS05} and more 
-efficient than the LF-AM3 scheme (leapfrog time stepping combined with a third order
-Adams-Moulthon interpolation for the predictor phase) used in ROMS 
-\citep{Shchepetkin_McWilliams_OM05}. 
-
-In fact, this technique is efficient when the physical phenomenon that 
-limits the time-step is internal gravity waves (IGWs). Indeed, it is 
-equivalent to applying a time filter to the pressure gradient to eliminate high 
-frequency IGWs. Obviously, the doubling of the time-step is achievable only 
-if no other factors control the time-step, such as the stability limits associated 
-with advection, diffusion or Coriolis terms. For example, it is inefficient in low resolution
-global ocean configurations, since inertial oscillations in the vicinity of the North Pole 
-are the limiting factor for the time step. It is also often inefficient in very high 
-resolution configurations where strong currents and small grid cells exert 
-the strongest constraint on the time step.
 
 % -------------------------------------------------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_TRA.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_TRA.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Chap_TRA.tex	(revision 6808)
@@ -1,4 +1,4 @@
 % ================================================================
-% Chapter 1 � Ocean Tracers (TRA)
+% Chapter 1 ——— Ocean Tracers (TRA)
 % ================================================================
 \chapter{Ocean Tracers (TRA)}
@@ -40,9 +40,7 @@
 described in chapters \S\ref{SBC}, \S\ref{LDF} and  \S\ref{ZDF}, respectively. 
 Note that \mdl{tranpc}, the non-penetrative convection module,  although 
-(temporarily) located in the NEMO/OPA/TRA directory, is described with the 
-model vertical physics (ZDF).
-%%%
-\gmcomment{change the position of eosbn2 in the reference code}
-%%%
+located in the NEMO/OPA/TRA directory as it directly modifies the tracer fields, 
+is described with the model vertical physics (ZDF) together with other available 
+parameterization of convection.
 
 In the present chapter we also describe the diagnostic equations used to compute 
@@ -50,12 +48,12 @@
 freezing point with associated modules \mdl{eosbn2} and \mdl{phycst}).
 
-The different options available to the user are managed by namelist logicals or 
-CPP keys. For each equation term \textit{ttt}, the namelist logicals are \textit{ln\_trattt\_xxx}, 
+The different options available to the user are managed by namelist logicals or CPP keys. 
+For each equation term  \textit{TTT}, the namelist logicals are \textit{ln\_traTTT\_xxx}, 
 where \textit{xxx} is a 3 or 4 letter acronym corresponding to each optional scheme. 
-The CPP key (when it exists) is \textbf{key\_trattt}. The equivalent code can be 
-found in the \textit{trattt} or \textit{trattt\_xxx} module, in the NEMO/OPA/TRA directory.
+The CPP key (when it exists) is \textbf{key\_traTTT}. The equivalent code can be 
+found in the \textit{traTTT} or \textit{traTTT\_xxx} module, in the NEMO/OPA/TRA directory.
 
 The user has the option of extracting each tendency term on the rhs of the tracer 
-equation for output (\key{trdtra} is defined), as described in Chap.~\ref{MISC}.
+equation for output (\np{ln\_tra\_trd} or \np{ln\_tra\_mxl}~=~true), as described in Chap.~\ref{MISC}.
 
 $\ $\newline    % force a new ligne
@@ -82,10 +80,10 @@
 implicitly requires the use of the continuity equation. Indeed, it is obtained
 by using the following equality : $\nabla \cdot \left( \vect{U}\,T \right)=\vect{U} \cdot \nabla T$ 
-which results from the use of the continuity equation, $\nabla \cdot \vect{U}=0$ or 
-$ \partial _t e_3 + e_3\;\nabla \cdot \vect{U}=0$ in constant volume or variable volume case, respectively. 
+which results from the use of the continuity equation,  $\partial _t e_3 + e_3\;\nabla \cdot \vect{U}=0$ 
+(which reduces to $\nabla \cdot \vect{U}=0$ in linear free surface, $i.e.$ \np{ln\_linssh}=true). 
 Therefore it is of paramount importance to design the discrete analogue of the 
 advection tendency so that it is consistent with the continuity equation in order to 
 enforce the conservation properties of the continuous equations. In other words, 
-by replacing $\tau$ by the number 1 in (\ref{Eq_tra_adv}) we recover the discrete form of 
+by setting $\tau = 1$ in (\ref{Eq_tra_adv}) we recover the discrete form of 
 the continuity equation which is used to calculate the vertical velocity.
 %>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -113,5 +111,5 @@
 boundary condition depends on the type of sea surface chosen: 
 \begin{description}
-\item [linear free surface:] the first level thickness is constant in time: 
+\item [linear free surface:] (\np{ln\_linssh}=true) the first level thickness is constant in time: 
 the vertical boundary condition is applied at the fixed surface $z=0$ 
 rather than on the moving surface $z=\eta$. There is a non-zero advective 
@@ -119,5 +117,5 @@
 $\left. {\tau _w } \right|_{k=1/2} =T_{k=1} $, $i.e.$ 
 the product of surface velocity (at $z=0$) by the first level tracer value.
-\item [non-linear free surface:] (\key{vvl} is defined) 
+\item [non-linear free surface:] (\np{ln\_linssh}=false) 
 convergence/divergence in the first ocean level moves the free surface 
 up/down. There is no tracer advection through it so that the advective 
@@ -125,29 +123,37 @@
 \end{description}
 In all cases, this boundary condition retains local conservation of tracer. 
-Global conservation is obtained in both rigid-lid and non-linear free surface 
-cases, but not in the linear free surface case. Nevertheless, in the latter
-case, it is achieved to a good approximation since the non-conservative 
+Global conservation is obtained in non-linear free surface case, 
+but \textit{not} in the linear free surface case. Nevertheless, in the latter case, 
+it is achieved to a good approximation since the non-conservative 
 term is the product of the time derivative of the tracer and the free surface 
-height, two quantities that are not correlated (see \S\ref{PE_free_surface}, 
-and also \citet{Roullet_Madec_JGR00,Griffies_al_MWR01,Campin2004}).
+height, two quantities that are not correlated \citep{Roullet_Madec_JGR00,Griffies_al_MWR01,Campin2004}.
 
 The velocity field that appears in (\ref{Eq_tra_adv}) and (\ref{Eq_tra_adv_zco}) 
-is the centred (\textit{now}) \textit{eulerian} ocean velocity (see Chap.~\ref{DYN}). 
-When eddy induced velocity (\textit{eiv}) parameterisation is used it is the \textit{now} 
-\textit{effective} velocity ($i.e.$ the sum of the eulerian and eiv velocities) which is used.
-
-The choice of an advection scheme is made in the \textit{\ngn{nam\_traadv}} namelist, by 
-setting to \textit{true} one and only one of the logicals \textit{ln\_traadv\_xxx}. The 
-corresponding code can be found in the \textit{traadv\_xxx.F90} module, where 
-\textit{xxx} is a 3 or 4 letter acronym corresponding to each scheme. Details 
-of the advection schemes are given below. The choice of an advection scheme 
+is the centred (\textit{now}) \textit{effective} ocean velocity, $i.e.$ the \textit{eulerian} velocity
+(see Chap.~\ref{DYN}) plus the eddy induced velocity (\textit{eiv}) 
+and/or the mixed layer eddy induced velocity (\textit{eiv})
+when those parameterisations are used (see Chap.~\ref{LDF}).
+
+Several tracer advection scheme are proposed, namely 
+a $2^{nd}$ or $4^{th}$ order centred schemes (CEN), 
+a $2^{nd}$ or $4^{th}$ order Flux Corrected Transport scheme (FCT),
+a Monotone Upstream Scheme for Conservative Laws scheme (MUSCL),
+a $3^{rd}$ Upstream Biased Scheme (UBS, also often called UP3), and
+a Quadratic Upstream Interpolation for Convective Kinematics with 
+Estimated Streaming Terms scheme (QUICKEST).
+The choice is made in the \textit{\ngn{namtra\_adv}} namelist, by 
+setting to \textit{true} one of the logicals \textit{ln\_traadv\_xxx}. 
+The corresponding code can be found in the \textit{traadv\_xxx.F90} module, 
+where \textit{xxx} is a 3 or 4 letter acronym corresponding to each scheme. 
+By default ($i.e.$ in the reference namelist, \ngn{namelist\_ref}), all the logicals 
+are set to \textit{false}. If the user does not select an advection scheme 
+in the configuration namelist (\ngn{namelist\_cfg}), the tracers will \textit{not} be advected !
+
+Details of the advection schemes are given below. The choosing an advection scheme 
 is a complex matter which depends on the model physics, model resolution, 
-type of tracer, as well as the issue of numerical cost. 
-
-Note that 
-(1) cen2, cen4 and TVD schemes require an explicit diffusion 
-operator while the other schemes are diffusive enough so that they do not 
-require additional diffusion ; 
-(2) cen2, cen4, MUSCL2, and UBS are not \textit{positive} schemes
+type of tracer, as well as the issue of numerical cost. In particular, we note that
+(1) CEN and FCT schemes require an explicit diffusion operator 
+while the other schemes are diffusive enough so that they do not necessarily need additional diffusion ; 
+(2) CEN and UBS are not \textit{positive} schemes
 \footnote{negative values can appear in an initially strictly positive tracer field 
 which is advected}
@@ -163,12 +169,19 @@
 
 % -------------------------------------------------------------------------------------------------------------
+%        2nd and 4th order centred schemes
+% -------------------------------------------------------------------------------------------------------------
+\subsection [centred schemes (CEN) (\np{ln\_traadv\_cen})]
+			   {centred schemes (CEN) (\np{ln\_traadv\_cen}=true)}
+\label{TRA_adv_cen}
+
 %        2nd order centred scheme  
-% -------------------------------------------------------------------------------------------------------------
-\subsection   [$2^{nd}$ order centred scheme (cen2) (\np{ln\_traadv\_cen2})]
-			{$2^{nd}$ order centred scheme (cen2) (\np{ln\_traadv\_cen2}=true)}
-\label{TRA_adv_cen2}
-
-In the centred second order formulation, the tracer at velocity points is 
-evaluated as the mean of the two neighbouring $T$-point values. 
+
+The centred advection scheme (CEN) is used when \np{ln\_traadv\_cen}~=~\textit{true}. 
+Its order ($2^{nd}$ or $4^{th}$) can be chosen independently on horizontal (iso-level) 
+and vertical direction by setting \np{nn\_cen\_h} and \np{nn\_cen\_v} to $2$ or $4$. 
+CEN implementation can be found in the \mdl{traadv\_cen} module.
+
+In the $2^{nd}$ order centred formulation (CEN2), the tracer at velocity points 
+is evaluated as the mean of the two neighbouring $T$-point values. 
 For example, in the $i$-direction :
 \begin{equation} \label{Eq_tra_adv_cen2}
@@ -176,73 +189,70 @@
 \end{equation}
 
-The scheme is non diffusive ($i.e.$ it conserves the tracer variance, $\tau^2)$ 
+CEN2 is non diffusive ($i.e.$ it conserves the tracer variance, $\tau^2)$ 
 but dispersive ($i.e.$ it may create false extrema). It is therefore notoriously 
 noisy and must be used in conjunction with an explicit diffusion operator to 
 produce a sensible solution. The associated time-stepping is performed using 
 a leapfrog scheme in conjunction with an Asselin time-filter, so $T$ in 
-(\ref{Eq_tra_adv_cen2}) is the \textit{now} tracer value. The centered second 
-order advection is computed in the \mdl{traadv\_cen2} module. In this module,
-it is advantageous to combine the \textit{cen2} scheme with an upstream scheme
-in specific areas which require a strong diffusion in order to avoid the generation 
-of false extrema. These areas are the vicinity of large river mouths, some straits 
-with coarse resolution, and the vicinity of ice cover area ($i.e.$ when the ocean 
-temperature is close to the freezing point).
-This combined scheme has been included for specific grid points in the ORCA2 
-and ORCA4 configurations only. This is an obsolescent feature as the recommended 
-advection scheme for the ORCA configuration is TVD (see  \S\ref{TRA_adv_tvd}).
-
-Note that using the cen2 scheme, the overall tracer advection is of second 
+(\ref{Eq_tra_adv_cen2}) is the \textit{now} tracer value. 
+
+Note that using the CEN2, the overall tracer advection is of second 
 order accuracy since both (\ref{Eq_tra_adv}) and (\ref{Eq_tra_adv_cen2}) 
-have this order of accuracy. \gmcomment{Note also that ... blah, blah}
-
-% -------------------------------------------------------------------------------------------------------------
+have this order of accuracy.
+
 %        4nd order centred scheme  
-% -------------------------------------------------------------------------------------------------------------
-\subsection   [$4^{nd}$ order centred scheme (cen4) (\np{ln\_traadv\_cen4})]
-		     {$4^{nd}$ order centred scheme (cen4) (\np{ln\_traadv\_cen4}=true)}
-\label{TRA_adv_cen4}
-
-In the $4^{th}$ order formulation (to be implemented), tracer values are 
-evaluated at velocity points as a $4^{th}$ order interpolation, and thus depend on 
-the four neighbouring $T$-points. For example, in the $i$-direction:
+
+In the $4^{th}$ order formulation (CEN4), tracer values are evaluated at u- and v-points as 
+a $4^{th}$ order interpolation, and thus depend on the four neighbouring $T$-points. 
+For example, in the $i$-direction:
 \begin{equation} \label{Eq_tra_adv_cen4}
 \tau _u^{cen4} 
 =\overline{   T - \frac{1}{6}\,\delta _i \left[ \delta_{i+1/2}[T] \,\right]   }^{\,i+1/2}
 \end{equation}
-
-Strictly speaking, the cen4 scheme is not a $4^{th}$ order advection scheme 
+In the vertical direction (\np{nn\_cen\_v}=$4$), a $4^{th}$ COMPACT interpolation 
+has been prefered \citep{Demange_PhD2014}.
+In the COMPACT scheme, both the field and its derivative are interpolated, 
+which leads, after a matrix inversion, spectral characteristics 
+similar to schemes of higher order \citep{Lele_JCP1992}.
+ 
+
+Strictly speaking, the CEN4 scheme is not a $4^{th}$ order advection scheme 
 but a $4^{th}$ order evaluation of advective fluxes, since the divergence of 
-advective fluxes \eqref{Eq_tra_adv} is kept at $2^{nd}$ order. The phrase ``$4^{th}$ 
-order scheme'' used in oceanographic literature is usually associated 
-with the scheme presented here. Introducing a \textit{true} $4^{th}$ order advection 
-scheme is feasible but, for consistency reasons, it requires changes in the 
-discretisation of the tracer advection together with changes in both the 
-continuity equation and the momentum advection terms.  
+advective fluxes \eqref{Eq_tra_adv} is kept at $2^{nd}$ order. 
+The expression \textit{$4^{th}$ order scheme} used in oceanographic literature 
+is usually associated with the scheme presented here. 
+Introducing a \textit{true} $4^{th}$ order advection scheme is feasible but, 
+for consistency reasons, it requires changes in the discretisation of the tracer 
+advection together with changes in the continuity equation, 
+and the momentum advection and pressure terms.  
 
 A direct consequence of the pseudo-fourth order nature of the scheme is that 
-it is not non-diffusive, i.e. the global variance of a tracer is not preserved using 
-\textit{cen4}. Furthermore, it must be used in conjunction with an explicit 
-diffusion operator to produce a sensible solution. The time-stepping is also 
-performed using a leapfrog scheme in conjunction with an Asselin time-filter, 
-so $T$ in (\ref{Eq_tra_adv_cen4}) is the \textit{now} tracer.
-
-At a $T$-grid cell adjacent to a boundary (coastline, bottom and surface), an 
-additional hypothesis must be made to evaluate $\tau _u^{cen4}$. This 
-hypothesis usually reduces the order of the scheme. Here we choose to set 
-the gradient of $T$ across the boundary to zero. Alternative conditions can be 
-specified, such as a reduction to a second order scheme for these near boundary 
-grid points.
-
-% -------------------------------------------------------------------------------------------------------------
-%        TVD scheme  
-% -------------------------------------------------------------------------------------------------------------
-\subsection   [Total Variance Dissipation scheme (TVD) (\np{ln\_traadv\_tvd})]
-			{Total Variance Dissipation scheme (TVD) (\np{ln\_traadv\_tvd}=true)}
+it is not non-diffusive, $i.e.$ the global variance of a tracer is not preserved using CEN4. 
+Furthermore, it must be used in conjunction with an explicit diffusion operator 
+to produce a sensible solution. 
+As in CEN2 case, the time-stepping is performed using a leapfrog scheme in conjunction 
+with an Asselin time-filter, so $T$ in (\ref{Eq_tra_adv_cen4}) is the \textit{now} tracer.
+
+At a $T$-grid cell adjacent to a boundary (coastline, bottom and surface), 
+an additional hypothesis must be made to evaluate $\tau _u^{cen4}$. 
+This hypothesis usually reduces the order of the scheme. 
+Here we choose to set the gradient of $T$ across the boundary to zero. 
+Alternative conditions can be specified, such as a reduction to a second order scheme 
+for these near boundary grid points.
+
+% -------------------------------------------------------------------------------------------------------------
+%        FCT scheme  
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Flux Corrected Transport schemes (FCT) (\np{ln\_traadv\_fct})]
+			{Flux Corrected Transport schemes (FCT) (\np{ln\_traadv\_fct}=true)}
 \label{TRA_adv_tvd}
 
-In the Total Variance Dissipation (TVD) formulation, the tracer at velocity 
-points is evaluated using a combination of an upstream and a centred scheme. 
-For example, in the $i$-direction :
-\begin{equation} \label{Eq_tra_adv_tvd}
+The Flux Corrected Transport schemes (FCT) is used when \np{ln\_traadv\_fct}~=~\textit{true}. 
+Its order ($2^{nd}$ or $4^{th}$) can be chosen independently on horizontal (iso-level) 
+and vertical direction by setting \np{nn\_fct\_h} and \np{nn\_fct\_v} to $2$ or $4$.
+FCT implementation can be found in the \mdl{traadv\_fct} module.
+
+In FCT formulation, the tracer at velocity points is evaluated using a combination of 
+an upstream and a centred scheme. For example, in the $i$-direction :
+\begin{equation} \label{Eq_tra_adv_fct}
 \begin{split}
 \tau _u^{ups}&= \begin{cases}
@@ -251,35 +261,44 @@
 				  \end{cases}     \\
 \\
-\tau _u^{tvd}&=\tau _u^{ups} +c_u \;\left( {\tau _u^{cen2} -\tau _u^{ups} } \right)
+\tau _u^{fct}&=\tau _u^{ups} +c_u \;\left( {\tau _u^{cen} -\tau _u^{ups} } \right)
 \end{split}
 \end{equation}
 where $c_u$ is a flux limiter function taking values between 0 and 1. 
+The FCT order is the one of the centred scheme used ($i.e.$ it depends on the setting of
+\np{nn\_fct\_h} and \np{nn\_fct\_v}.
 There exist many ways to define $c_u$, each corresponding to a different 
-total variance decreasing scheme. The one chosen in \NEMO is described in 
-\citet{Zalesak_JCP79}. $c_u$ only departs from $1$ when the advective term 
-produces a local extremum in the tracer field. The resulting scheme is quite 
-expensive but \emph{positive}. It can be used on both active and passive tracers. 
-This scheme is tested and compared with MUSCL and the MPDATA scheme in 
-\citet{Levy_al_GRL01}; note that in this paper it is referred to as "FCT" (Flux corrected 
-transport) rather than TVD. The TVD scheme is implemented in the \mdl{traadv\_tvd} module.
-
-For stability reasons (see \S\ref{STP}),
-$\tau _u^{cen2}$ is evaluated  in (\ref{Eq_tra_adv_tvd}) using the \textit{now} tracer while $\tau _u^{ups}$ 
-is evaluated using the \textit{before} tracer. In other words, the advective part of 
-the scheme is time stepped with a leap-frog scheme while a forward scheme is 
-used for the diffusive part. 
+FCT scheme. The one chosen in \NEMO is described in \citet{Zalesak_JCP79}. 
+$c_u$ only departs from $1$ when the advective term produces a local extremum in the tracer field. 
+The resulting scheme is quite expensive but \emph{positive}. 
+It can be used on both active and passive tracers. 
+A comparison of FCT-2 with MUSCL and a MPDATA scheme can be found in \citet{Levy_al_GRL01}. 
+
+An additional option has been added controlled by \np{nn\_fct\_zts}. By setting this integer to 
+a value larger than zero, a $2^{nd}$ order FCT scheme is used on both horizontal and vertical direction, 
+but on the latter, a split-explicit time stepping is used, with a number of sub-timestep equals
+to \np{nn\_fct\_zts}. This option can be useful when the size of the timestep is limited 
+by vertical advection \citep{Lemarie_OM2015)}. Note that in this case, a similar split-explicit 
+time stepping should be used on vertical advection of momentum to insure a better stability
+(see \S\ref{DYN_zad}).
+
+For stability reasons (see \S\ref{STP}), $\tau _u^{cen}$ is evaluated in (\ref{Eq_tra_adv_fct}) 
+using the \textit{now} tracer while $\tau _u^{ups}$ is evaluated using the \textit{before} tracer. In other words, 
+the advective part of the scheme is time stepped with a leap-frog scheme 
+while a forward scheme is used for the diffusive part. 
 
 % -------------------------------------------------------------------------------------------------------------
 %        MUSCL scheme  
 % -------------------------------------------------------------------------------------------------------------
-\subsection[MUSCL scheme  (\np{ln\_traadv\_muscl})]
-	{Monotone Upstream Scheme for Conservative Laws (MUSCL) (\np{ln\_traadv\_muscl}=T)}
-\label{TRA_adv_muscl}
-
-The Monotone Upstream Scheme for Conservative Laws (MUSCL) has been 
-implemented by \citet{Levy_al_GRL01}. In its formulation, the tracer at velocity points 
+\subsection[MUSCL scheme  (\np{ln\_traadv\_mus})]
+	{Monotone Upstream Scheme for Conservative Laws (MUSCL) (\np{ln\_traadv\_mus}=T)}
+\label{TRA_adv_mus}
+
+The Monotone Upstream Scheme for Conservative Laws (MUSCL) is used when \np{ln\_traadv\_mus}~=~\textit{true}. 
+MUSCL implementation can be found in the \mdl{traadv\_mus} module.
+
+MUSCL has been first implemented in \NEMO by \citet{Levy_al_GRL01}. In its formulation, the tracer at velocity points 
 is evaluated assuming a linear tracer variation between two $T$-points 
 (Fig.\ref{Fig_adv_scheme}). For example, in the $i$-direction :
-\begin{equation} \label{Eq_tra_adv_muscl}
+\begin{equation} \label{Eq_tra_adv_mus}
    \tau _u^{mus} = \left\{      \begin{aligned}
          &\tau _i  &+ \frac{1}{2} \;\left( 1-\frac{u_{i+1/2} \;\rdt}{e_{1u}} \right)
@@ -296,10 +315,8 @@
 
 For an ocean grid point adjacent to land and where the ocean velocity is 
-directed toward land, two choices are available: an upstream flux 
-(\np{ln\_traadv\_muscl}=true) or a second order flux 
-(\np{ln\_traadv\_muscl2}=true). Note that the latter choice does not ensure 
-the \textit{positive} character of the scheme. Only the former can be used 
-on both active and passive tracers. The two MUSCL schemes are implemented 
-in the \mdl{traadv\_tvd} and \mdl{traadv\_tvd2} modules.
+directed toward land, an upstream flux is used. This choice ensure 
+the \textit{positive} character of the scheme. 
+In addition, fluxes round a grid-point where a runoff is applied can optionally be 
+computed using upstream fluxes (\np{ln\_mus\_ups}~=~\textit{true}).
 
 % -------------------------------------------------------------------------------------------------------------
@@ -310,8 +327,11 @@
 \label{TRA_adv_ubs}
 
-The UBS advection scheme is an upstream-biased third order scheme based on 
-an upstream-biased parabolic interpolation. It is also known as the Cell 
-Averaged QUICK scheme (Quadratic Upstream Interpolation for Convective 
-Kinematics). For example, in the $i$-direction :
+The Upstream-Biased Scheme (UBS) is used when \np{ln\_traadv\_ubs}~=~\textit{true}. 
+UBS implementation can be found in the \mdl{traadv\_mus} module.
+
+The UBS scheme, often called UP3, is also known as the Cell Averaged QUICK scheme 
+(Quadratic Upstream Interpolation for Convective Kinematics). It is an upstream-biased 
+third order scheme based on an upstream-biased parabolic interpolation.  
+For example, in the $i$-direction :
 \begin{equation} \label{Eq_tra_adv_ubs}
    \tau _u^{ubs} =\overline T ^{i+1/2}-\;\frac{1}{6} \left\{      
@@ -324,21 +344,21 @@
 
 This results in a dissipatively dominant (i.e. hyper-diffusive) truncation 
-error \citep{Shchepetkin_McWilliams_OM05}. The overall performance of the advection 
-scheme is similar to that reported in \cite{Farrow1995}. 
+error \citep{Shchepetkin_McWilliams_OM05}. The overall performance of
+ the advection scheme is similar to that reported in \cite{Farrow1995}. 
 It is a relatively good compromise between accuracy and smoothness. 
-It is not a \emph{positive} scheme, meaning that false extrema are permitted, 
+Nevertheless the scheme is not \emph{positive}, meaning that false extrema are permitted, 
 but the amplitude of such are significantly reduced over the centred second 
-order method. Nevertheless it is not recommended that it should be applied 
-to a passive tracer that requires positivity. 
+or fourth order method. therefore it is not recommended that it should be 
+applied to a passive tracer that requires positivity. 
 
 The intrinsic diffusion of UBS makes its use risky in the vertical direction 
-where the control of artificial diapycnal fluxes is of paramount importance. 
-Therefore the vertical flux is evaluated using the TVD scheme when 
-\np{ln\_traadv\_ubs}=true.
+where the control of artificial diapycnal fluxes is of paramount importance \citep{Shchepetkin_McWilliams_OM05, Demange_PhD2014}. 
+Therefore the vertical flux is evaluated using either a $2^nd$ order FCT scheme 
+or a $4^th$ order COMPACT scheme (\np{nn\_cen\_v}=2 or 4).
 
 For stability reasons  (see \S\ref{STP}),
-the first term  in \eqref{Eq_tra_adv_ubs} (which corresponds to a second order centred scheme) 
-is evaluated using the \textit{now} tracer (centred in time) while the 
-second term (which is the diffusive part of the scheme), is 
+the first term  in \eqref{Eq_tra_adv_ubs} (which corresponds to a second order 
+centred scheme) is evaluated using the \textit{now} tracer (centred in time) 
+while the second term (which is the diffusive part of the scheme), is 
 evaluated using the \textit{before} tracer (forward in time). 
 This choice is discussed by \citet{Webb_al_JAOT98} in the context of the 
@@ -350,23 +370,5 @@
 substitution in the \mdl{traadv\_ubs} module and obtain a QUICK scheme.
 
-Four different options are possible for the vertical 
-component used in the UBS scheme. $\tau _w^{ubs}$ can be evaluated 
-using either \textit{(a)} a centred $2^{nd}$ order scheme, or  \textit{(b)} 
-a TVD scheme, or  \textit{(c)} an interpolation based on conservative 
-parabolic splines following the \citet{Shchepetkin_McWilliams_OM05} 
-implementation of UBS in ROMS, or  \textit{(d)} a UBS. The $3^{rd}$ case 
-has dispersion properties similar to an eighth-order accurate conventional scheme.
-The current reference version uses method b)
-
-Note that :
-
-(1) When a high vertical resolution $O(1m)$ is used, the model stability can 
-be controlled by vertical advection (not vertical diffusion which is usually 
-solved using an implicit scheme). Computer time can be saved by using a 
-time-splitting technique on vertical advection. Such a technique has been 
-implemented and validated in ORCA05 with 301 levels. It is not available 
-in the current reference version. 
-
-(2) It is straightforward to rewrite \eqref{Eq_tra_adv_ubs} as follows:
+Note that it is straightforward to rewrite \eqref{Eq_tra_adv_ubs} as follows:
 \begin{equation} \label{Eq_traadv_ubs2}
 \tau _u^{ubs} = \tau _u^{cen4} + \frac{1}{12} \left\{	 
@@ -390,9 +392,6 @@
 Thirdly, the diffusion term is in fact a biharmonic operator with an eddy 
 coefficient which is simply proportional to the velocity:
- $A_u^{lm}= - \frac{1}{12}\,{e_{1u}}^3\,|u|$. Note that NEMO v3.4 still uses 
- \eqref{Eq_tra_adv_ubs}, not \eqref{Eq_traadv_ubs2}.
- %%%
- \gmcomment{the change in UBS scheme has to be done}
- %%%
+ $A_u^{lm}= \frac{1}{12}\,{e_{1u}}^3\,|u|$. Note the current version of NEMO uses 
+the computationally more efficient formulation \eqref{Eq_tra_adv_ubs}.
 
 % -------------------------------------------------------------------------------------------------------------
@@ -405,5 +404,8 @@
 The Quadratic Upstream Interpolation for Convective Kinematics with 
 Estimated Streaming Terms (QUICKEST) scheme proposed by \citet{Leonard1979} 
-is the third order Godunov scheme. It is associated with the ULTIMATE QUICKEST 
+is used when \np{ln\_traadv\_qck}~=~\textit{true}. 
+QUICKEST implementation can be found in the \mdl{traadv\_mus} module.
+
+QUICKEST is the third order Godunov scheme which is associated with the ULTIMATE QUICKEST 
 limiter \citep{Leonard1991}. It has been implemented in NEMO by G. Reffray 
 (MERCATOR-ocean) and can be found in the \mdl{traadv\_qck} module.
@@ -416,18 +418,6 @@
 direction (as for the UBS case) should be implemented to restore this property.
 
-
-% -------------------------------------------------------------------------------------------------------------
-%        PPM scheme  
-% -------------------------------------------------------------------------------------------------------------
-\subsection   [Piecewise Parabolic Method (PPM) (\np{ln\_traadv\_ppm})]
-			{Piecewise Parabolic Method (PPM) (\np{ln\_traadv\_ppm}=true)}
-\label{TRA_adv_ppm}
-
-The Piecewise Parabolic Method (PPM) proposed by Colella and Woodward (1984) 
-\sgacomment{reference?}
-is based on a quadradic piecewise construction. Like the QCK scheme, it is associated 
-with the ULTIMATE QUICKEST limiter \citep{Leonard1991}. It has been implemented 
-in \NEMO by G. Reffray (MERCATOR-ocean) but is not yet offered in the reference 
-version 3.3.
+%%%gmcomment   :  Cross term are missing in the current implementation....
+
 
 % ================================================================
@@ -1167,61 +1157,116 @@
 %        Equation of State
 % -------------------------------------------------------------------------------------------------------------
-\subsection{Equation of State (\np{nn\_eos} = 0, 1 or 2)}
+\subsection{Equation Of Seawater (\np{nn\_eos} = -1, 0, or 1)}
 \label{TRA_eos}
 
-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$. 
+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$. 
 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 $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.
+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}.
 With such an equation of state there is no longer a distinction between 
-\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}
+\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}
 \begin{split}
-  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    
+  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
 \end{split}
 \end{equation} 
-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.
+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{rn\_a0}     & 1.6550 $10^{-1}$ &  linear thermal expansion coeff. 	\\ \hline
+$b_0$	      & \np{rn\_b0} 	   & 7.6554 $10^{-1}$ &  linear haline  expansion coeff. 	\\ \hline
+$\lambda_1$	& \np{rn\_lambda1}& 5.9520 $10^{-2}$ &  cabbeling coeff. in $T^2$ 	      \\ \hline
+$\lambda_2$	& \np{rn\_lambda2}& 5.4914 $10^{-4}$ &  cabbeling coeff. in $S^2$	 	   \\ \hline
+$\nu$       & \np{rn\_nu}     & 2.4341 $10^{-3}$ &  cabbeling coeff. in $T \, S$ 	   \\ \hline
+$\mu_1$     & \np{rn\_mu1} 	& 1.4970 $10^{-4}$ &  thermobaric coeff. in T    	   \\ \hline
+$\mu_2$     & \np{rn\_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}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
 
 % -------------------------------------------------------------------------------------------------------------
@@ -1232,50 +1277,18 @@
 
 An accurate computation of the ocean stability (i.e. of $N$, the brunt-Vais\"{a}l\"{a}
- 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): 
+ 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: 
 \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 $\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. 
-
+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}.
 
 % -------------------------------------------------------------------------------------------------------------
@@ -1298,6 +1311,17 @@
 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{tfreez}, a \textsc{Fortran} function that can be found 
+point is computed through \textit{eos\_fzp}, a \textsc{Fortran} function that can be found 
 in \mdl{eosbn2}.  
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        Potential Energy     
+% -------------------------------------------------------------------------------------------------------------
+%\subsection{Potential Energy anomalies}
+%\label{TRA_bn2}
+
+%    =====>>>>> TO BE written
+%
+
 
 % ================================================================
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Introduction.tex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Introduction.tex	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Chapters/Introduction.tex	(revision 6808)
@@ -24,15 +24,14 @@
 release 8.2, described in \citet{Madec1998}. This model has been used for a wide 
 range of applications, both regional or global, as a forced ocean model and as a 
-model coupled with the atmosphere. A complete list of references is found on the 
-\NEMO web site. 
+model coupled with the sea-ice and/or the atmosphere.  
 
 This manual is organised in as follows. Chapter~\ref{PE} presents the model basics, 
 $i.e.$ the equations and their assumptions, the vertical coordinates used, and the 
 subgrid scale physics. This part deals with the continuous equations of the model 
-(primitive equations, with potential temperature, salinity and an equation of state). 
+(primitive equations, with temperature, salinity and an equation of seawater). 
 The equations are written in a curvilinear coordinate system, with a choice of vertical 
-coordinates ($z$ or $s$, with the rescaled height coordinate formulation \textit{z*}, or  
-\textit{s*}). Momentum equations are formulated in the vector invariant form or in the 
-flux form. Dimensional units in the meter, kilogram, second (MKS) international system 
+coordinates ($z$, $s$, \textit{z*}, \textit{s*}, $\tilde{z}$, $\tilde{s}$, and a mixture of them). 
+Momentum equations are formulated in the vector invariant form or in the flux form. 
+Dimensional units in the meter, kilogram, second (MKS) international system 
 are used throughout.
 
@@ -79,9 +78,10 @@
 space and time variable coefficient \citet{Treguier1997}. The model has vertical harmonic 
 viscosity and diffusion with a space and time variable coefficient, with options to compute 
-the coefficients with \citet{Blanke1993}, \citet{Large_al_RG94}, \citet{Pacanowski_Philander_JPO81}, 
+the coefficients with \citet{Blanke1993}, \citet{Pacanowski_Philander_JPO81}, 
 or \citet{Umlauf_Burchard_JMS03} mixing schemes.
  \vspace{1cm}
  
- 
+%%gm    To be put somewhere else ....
+
 \noindent CPP keys and namelists are used for inputs to the code.  \newline
 
@@ -112,4 +112,5 @@
  \vspace{1cm}
 
+%%gm  end
 
 Model outputs management and specific online diagnostics are described in chapters~\ref{DIA}.
@@ -249,2 +250,16 @@
 
 
+ \vspace{1cm}
+$\bullet$ The main modifications from NEMO/OPA v3.4 and  v3.6 are :\\
+\begin{enumerate}
+\item ... ; 
+\end{enumerate}
+
+
+ \vspace{1cm}
+$\bullet$ The main modifications from NEMO/OPA v3.6 and  v4.0 are :\\
+\begin{enumerate}
+\item ... ; 
+\end{enumerate}
+
+
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nam_dia25h
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nam_dia25h	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nam_dia25h	(revision 6808)
@@ -0,0 +1,5 @@
+!-----------------------------------------------------------------------
+&nam_dia25h  !   25h Mean Output
+!-----------------------------------------------------------------------
+   ln_dia25h  = .true.    !  Choose 25 mean output or not
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nam_diatmb
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nam_diatmb	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nam_diatmb	(revision 6808)
@@ -0,0 +1,5 @@
+!-----------------------------------------------------------------------
+&nam_diatmb  !   25h Mean Output
+!-----------------------------------------------------------------------
+   ln_diatmb  = .true.    !  Choose Top Middle and Bottom output or not
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nam_tide
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nam_tide	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nam_tide	(revision 6808)
@@ -1,16 +1,8 @@
 !-----------------------------------------------------------------------
-&nam_tide      !   tide parameters (#ifdef key_tide)
+&nam_tide      !   tide parameters                                      ("key_tide")
 !-----------------------------------------------------------------------
    ln_tide_pot   = .true.   !  use tidal potential forcing
-   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'
+   ln_tide_ramp  = .false.  !
+   rdttideramp   =    0.    !
+   clname(1)     = 'DUMMY'  !  name of constituent - all tidal components must be set in namelist_cfg
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namagrif
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namagrif	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namagrif	(revision 6808)
@@ -6,3 +6,4 @@
    rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
    rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+   ln_chk_bathy  = .FALSE. !
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambbl
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambbl	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambbl	(revision 6808)
@@ -1,4 +1,4 @@
 !-----------------------------------------------------------------------
-&nambbl        !   bottom boundary layer scheme
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
 !-----------------------------------------------------------------------
    nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambdy
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambdy	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambdy	(revision 6808)
@@ -2,22 +2,33 @@
 &nambdy        !  unstructured open boundaries                          ("key_bdy")
 !-----------------------------------------------------------------------
-    nb_bdy = 1                            !  number of open boundary sets
+    nb_bdy         = 0                    !  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.)
-    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields
-    nn_dyn2d_dta  =  3                    !  = 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.)
+    cn_dyn2d       = 'none'               !
+    nn_dyn2d_dta   =  0                   !  = 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
-    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities
+    cn_dyn3d      =  'none'               !
     nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
-                           !  = 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
+                                          !  = 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
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambdy_dta
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambdy_dta	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambdy_dta	(revision 6808)
@@ -1,15 +1,24 @@
 !-----------------------------------------------------------------------
-&nambdy_dta      !  open boundaries - external data           ("key_bdy")
+&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_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.
+!              !  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'  ,    ''    ,   ''     , ''
+
+   cn_dir      =    'bdydta/'   !  root directory for the location of the bulk files
+   ln_full_vel = .false.        !  
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambdy_tide
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambdy_tide	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambdy_tide	(revision 6808)
@@ -2,6 +2,6 @@
 &nambdy_tide     ! tidal forcing at open boundaries
 !-----------------------------------------------------------------------
-   filtide          = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files
-   ln_bdytide_2ddta = .false.
-   ln_bdytide_conj  = .false.
+   filtide          = 'bdydta/amm12_bdytide_'   !  file name root of tidal forcing files
+   ln_bdytide_2ddta = .false.   !
+   ln_bdytide_conj  = .false.   ! 
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namberg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namberg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namberg	(revision 6808)
@@ -1,6 +1,6 @@
 !-----------------------------------------------------------------------
-&namberg       !   iceberg parameters
+&namberg       !   iceberg parameters                                   (default: No iceberg)
 !-----------------------------------------------------------------------
-      ln_icebergs              = .false.
+      ln_icebergs              = .false.              ! iceberg floats or not
       ln_bergdia               = .true.               ! Calculate budgets
       nn_verbose_level         = 1                    ! Turn on more verbose output if level > 0
@@ -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
 
-               ! 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 = './' 
+!              ! 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 = './'
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambfr
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambfr	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nambfr	(revision 6808)
@@ -1,4 +1,4 @@
 !-----------------------------------------------------------------------
-&nambfr        !   bottom friction
+&nambfr        !   bottom friction                                      (default: linear)
 !-----------------------------------------------------------------------
    nn_bfr      =    1      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namctl
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namctl	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namctl	(revision 6808)
@@ -13,3 +13,4 @@
                            !     (no physical validity of the results)
    nn_timing   =    0      !  timing by routine activated (=1) creates timing.output file, or not (=0)
+   nn_diacfl   =    0      !  Write out cfl diagnostics (=1) in cfl_diagnostics.ascii, or not (=0)
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdct
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdct	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdct	(revision 6808)
@@ -1,4 +1,4 @@
 !-----------------------------------------------------------------------
-&namdct        ! transports through sections
+&namdct        ! transports through some sections
 !-----------------------------------------------------------------------
     nn_dct      = 15       !  time step frequency for transports computing
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdiu
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdiu	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdiu	(revision 6808)
@@ -0,0 +1,6 @@
+!-----------------------------------------------------------------------
+&namdiu        !   Control of diurnal SST models
+!-----------------------------------------------------------------------
+   ln_diurnal = .TRUE.   ! Turn diurnal models on/off
+   ln_diurnal_only = .FALSE.   ! Only run diurnal model, dynamical models switched off
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdom
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdom	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdom	(revision 6808)
@@ -3,7 +3,9 @@
 !-----------------------------------------------------------------------
    nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
-   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_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)
    rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_isfhmin  =    1.00   !  treshold (m) to discriminate grounding ice to floating ice
    rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
    rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
@@ -16,4 +18,5 @@
    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/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_adv
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_adv	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_adv	(revision 6808)
@@ -1,7 +1,9 @@
 !-----------------------------------------------------------------------
-&namdyn_adv    !   formulation of the momentum advection
+&namdyn_adv    !   formulation of the momentum advection                (default: vector form)
 !-----------------------------------------------------------------------
-   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)  
+   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_cen2= .false. !  flux form - 2nd order centered scheme
-   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
-/  
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_hpg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_hpg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_hpg	(revision 6808)
@@ -1,12 +1,10 @@
 !-----------------------------------------------------------------------
-&namdyn_hpg    !   Hydrostatic pressure gradient option
+&namdyn_hpg    !   Hydrostatic pressure gradient option                 (default: zps)
 !-----------------------------------------------------------------------
    ln_hpg_zco  = .false.   !  z-coordinate - full steps
    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 ice shelf cavity
+   ln_hpg_isf  = .false.   !  s-coordinate (sco ) adapted to isf
    ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
    ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
-   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
-                                 !           centered      time scheme  (F)
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_ldf
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_ldf	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_ldf	(revision 6808)
@@ -1,20 +1,26 @@
 !-----------------------------------------------------------------------
-&namdyn_ldf    !   lateral diffusion on momentum
+&namdyn_ldf    !   lateral diffusion on momentum                        (default: NO)
 !-----------------------------------------------------------------------
    !                       !  Type of the operator :
-   ln_dynldf_lap    =  .true.   !  laplacian operator
-   ln_dynldf_bilap  =  .false.  !  bilaplacian operator
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
    !                       !  Direction of action  :
-   ln_dynldf_level  =  .false.  !  iso-level
-   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
-   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
+   ln_dynldf_lev =  .false.    !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
    !                       !  Coefficient
-   rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s]
-   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
-   rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s]
-   rn_cmsmag_1      =     3.    !  constant in laplacian Smagorinsky viscosity
-   rn_cmsmag_2      =     3     !  constant in bilaplacian Smagorinsky viscosity
-   rn_cmsh          =     1.    !  1 or 0 , if 0 -use only shear for Smagorinsky viscosity
-   rn_ahm_m_blp     =    -1.e12 !  upper limit for bilap  abs(ahm) < min( dx^4/128rdt, rn_ahm_m_blp)
-   rn_ahm_m_lap     = 40000.    !  upper limit for lap  ahm < min(dx^2/16rdt, rn_ahm_m_lap)
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_spg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_spg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_spg	(revision 6808)
@@ -1,6 +1,14 @@
 !-----------------------------------------------------------------------
-!namdyn_spg    !   surface pressure gradient   (CPP key only)
+&namdyn_spg    !   surface pressure gradient                            (default: NO)
 !-----------------------------------------------------------------------
-!                          !  explicit free surface                     ("key_dynspg_exp")
-!                          !  filtered free surface                     ("key_dynspg_flt")
-!                          !  split-explicit free surface               ("key_dynspg_ts")
+   ln_dynspg_exp  = .false.   ! explicit free surface
+   ln_dynspg_ts   = .false.   ! split-explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         rn_bt_cmax   =  0.8        ! =T : the Maximum Courant Number allowed
+         nn_baro      = 30          ! =F : the number of sub-step in rn_rdt seconds
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_vor
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_vor	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namdyn_vor	(revision 6808)
@@ -1,8 +1,10 @@
 !-----------------------------------------------------------------------
-&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+&namdyn_vor    !   option of physics/algorithm                          (default: NO)
 !-----------------------------------------------------------------------
    ln_dynvor_ene = .false. !  enstrophy conserving scheme
    ln_dynvor_ens = .false. !  energy conserving scheme
    ln_dynvor_mix = .false. !  mixed scheme
-   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 1          ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+   ln_dynvor_msk = .false. !  vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes)  ! PLEASE DO NOT USE
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nameos
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nameos	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/nameos	(revision 6808)
@@ -2,9 +2,18 @@
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
-   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)
+   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)
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namhsb
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namhsb	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namhsb	(revision 6808)
@@ -1,4 +1,4 @@
 !-----------------------------------------------------------------------
-&namhsb       !  Heat and salt budgets 
+&namhsb       !  Heat and salt budgets                                  (default F)
 !-----------------------------------------------------------------------
    ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namlbc
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namlbc	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namlbc	(revision 6808)
@@ -2,6 +2,6 @@
 &namlbc        !   lateral momentum boundary condition
 !-----------------------------------------------------------------------
+   !                       !  free slip  !   partial slip  !   no slip   ! strong slip
    rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
-                           !  free slip  !   partial slip  !   no slip   ! strong slip
-   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical eqs.
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical Eqs.
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namobs
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namobs	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namobs	(revision 6808)
@@ -1,63 +1,34 @@
 !-----------------------------------------------------------------------
-&namobs       !  observation usage switch                               ('key_diaobs')
+&namobs       !  observation usage switch
 !-----------------------------------------------------------------------
-   ln_t3d     = .false.    ! Logical switch for T profile observations
-   ln_s3d     = .false.    ! Logical switch for S profile observations
-   ln_ena     = .false.    ! Logical switch for ENACT 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                  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                  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   ENACT daily average types
-   ln_grid_global = .true.
-   ln_grid_search_lookup = .false.
+   ln_diaobs  = .true.                 ! Logical switch for the observation operator
+   ln_t3d     = .true.                 ! Logical switch for T profile observations
+   ln_s3d     = .true.                 ! Logical switch for S profile observations
+   ln_sla     = .true.                 ! Logical switch for SLA observations
+   ln_sst     = .true.                 ! Logical switch for SST observations
+   ln_sic     = .false.                ! Logical switch for Sea Ice observations
+   ln_vel3d   = .false.                ! Logical switch for velocity observations
+   ln_altbias = .false.                ! Logical switch for altimeter bias correction
+   ln_nea     = .false.                ! Logical switch for rejection of observations near land
+   ln_grid_global = .true.             ! Logical switch for global distribution of observations
+   ln_grid_search_lookup = .false.     ! Logical switch for obs grid search w/lookup table
+   ln_ignmis  = .true.                 ! Logical switch for ignoring missing files
+   ln_s_at_t  = .false.                ! Logical switch for computing model S at T obs if not there
+   ln_sstnight = .false.               ! Logical switch for calculating night-time average for SST obs
+   cn_profbfiles = 'profiles_01.nc'    ! Profile feedback input observation file names
+   cn_slafbfiles = 'sla_01.nc'         ! SLA feedback input observation file names
+   cn_sstfbfiles = 'sst_01.nc'         ! SST feedback input observation file names
+   cn_sicfbfiles = 'sic_01.nc'         ! SIC feedback input observation file names
+   cn_velfbfiles = 'vel_01.nc'         ! Velocity feedback input observation file names
+   cn_altbiasfile = 'altbias.nc'       ! Altimeter bias input file name
+   cn_gridsearchfile = 'gridsearch.nc' ! Grid search file name
+   rn_gridsearchres = 0.5              ! Grid search resolution
+   rn_dobsini = 20150101.000000        ! Initial date in window YYYYMMDD.HHMMSS
+   rn_dobsend = 20150102.000000        ! Final date in window YYYYMMDD.HHMMSS
+   nn_1dint = 0                        ! Type of vertical interpolation method
+   nn_2dint = 0                        ! Type of horizontal interpolation method
+   nn_msshc = 0                        ! MSSH correction scheme
+   rn_mdtcorr = 1.61                   ! MDT  correction
+   rn_mdtcutoff = 65.0                 ! MDT cutoff for computed correction
+   nn_profdavtypes = -1                ! Profile daily average types - array
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namobs_example
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namobs_example	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namobs_example	(revision 6808)
@@ -1,63 +1,34 @@
 !-----------------------------------------------------------------------
-!       namobs    observation usage switch
+&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.  
-/ 
+   ln_diaobs  = .true.                 ! Logical switch for the observation operator
+   ln_t3d     = .true.                 ! Logical switch for T profile observations
+   ln_s3d     = .true.                 ! Logical switch for S profile observations
+   ln_sla     = .false.                ! Logical switch for SLA observations
+   ln_sst     = .false.                ! Logical switch for SST observations
+   ln_sic     = .false.                ! Logical switch for Sea Ice observations
+   ln_vel3d   = .false.                ! Logical switch for velocity observations
+   ln_altbias = .false.                ! Logical switch for altimeter bias correction
+   ln_nea     = .false.                ! Logical switch for rejection of observations near land
+   ln_grid_global = .true.             ! Logical switch for global distribution of observations
+   ln_grid_search_lookup = .false.     ! Logical switch for obs grid search w/lookup table
+   ln_ignmis  = .true.                 ! Logical switch for ignoring missing files
+   ln_s_at_t  = .false.                ! Logical switch for computing model S at T obs if not there
+   ln_sstnight = .false.               ! Logical switch for calculating night-time average for SST obs
+   cn_profbfiles = 'profiles_01.nc'    ! Profile feedback input observation file names
+   cn_slafbfiles = 'sla_01.nc'         ! SLA feedback input observation file names
+   cn_sstfbfiles = 'sst_01.nc'         ! SST feedback input observation file names
+   cn_sicfbfiles = 'sic_01.nc'         ! SIC feedback input observation file names
+   cn_velfbfiles = 'vel_01.nc'         ! Velocity feedback input observation file names
+   cn_altbiasfile = 'altbias.nc'       ! Altimeter bias input file name
+   cn_gridsearchfile = 'gridsearch.nc' ! Grid search file name
+   rn_gridsearchres = 0.5              ! Grid search resolution
+   rn_dobsini = 00010101.000000        ! Initial date in window YYYYMMDD.HHMMSS
+   rn_dobsend = 00010102.000000        ! Final date in window YYYYMMDD.HHMMSS
+   nn_1dint = 0                        ! Type of vertical interpolation method
+   nn_2dint = 0                        ! Type of horizontal interpolation method
+   nn_msshc = 0                        ! MSSH correction scheme
+   rn_mdtcorr = 1.61                   ! MDT  correction
+   rn_mdtcutoff = 65.0                 ! MDT cutoff for computed correction
+   nn_profdavtypes = -1                ! Profile daily average types - array
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namptr
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namptr	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namptr	(revision 6808)
@@ -1,11 +1,6 @@
 !-----------------------------------------------------------------------
-&namptr       !   Poleward Transport Diagnostic
+&namptr       !   Poleward Transport Diagnostic                         (default F)
 !-----------------------------------------------------------------------
    ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
-   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]
+   ln_subbas  = .false.     !  Atlantic/Pacific/Indian basins computation (T) or not
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namrun
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namrun	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namrun	(revision 6808)
@@ -9,16 +9,23 @@
    nn_leapy    =       0   !  Leap year calendar (1) or not (0)
    ln_rstart   = .false.   !  start from rest (F) or from a restart file (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_out = "restart"   !  suffix of ocean restart name (output)
+      nn_euler    =    1         !  = 0 : start with forward time step 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
+   ln_iscpl    = .false.   !  cavity evolution forcing or coupling to ice sheet model (ln_iscpl = T => namsbc_iscpl)
    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_clobber  = .false.   !  clobber (overwrite) an existing file
+   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard
+   ln_clobber  = .true.    !  clobber (overwrite) an existing file
    nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc	(revision 6808)
@@ -3,5 +3,6 @@
 !-----------------------------------------------------------------------
    nn_fsbc     = 5         !  frequency of surface boundary condition computation
-                           !     (also = the frequency of sea-ice model call)
+                           !     (also = the frequency of sea-ice & iceberg model call)
+                     ! Type of air-sea fluxes 
    ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana )
    ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
@@ -9,29 +10,35 @@
    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.   !  Coupled formulation                       (T => fill namsbc_cpl )
-   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+                     ! Type of coupling (Ocean/Ice/Atmosphere) :
+   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 
+   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)
+                     ! Sea-ice :
    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 = 0         !  =0 levitating ice (no mass exchange, concentration/dilution effect)
+                           !  =2 ice-model used                         ("key_lim3", "key_lim2", "key_cice")
+   nn_ice_embd = 1         !  =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
+                     ! Misc. options of sbc : 
+   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr )
+      ln_dm2dc = .false.      !  daily mean to diurnal cycle on short wave
    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
-                           !  2 = bg03 parametrisation   3 = rnf file for isf
-                           !  4 = ISF fwf specified
-                           !  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      = 3         !  FreshWater Budget: =0 unchecked
+   nn_fwb      = 2         !  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 (the field land/sea mask filename
-                           !       is left empty in namelist)  ,
-                           !  =1:n number of iterations of land/sea mask application for input fields
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   ln_isf      = .false.   !  ice shelf melting/freezing                (T => fill namsbc_isf)
+   ln_wave = .false.       !  coupling with surface wave                    (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)
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_apr
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_apr	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_apr	(revision 6808)
@@ -1,11 +1,11 @@
 !-----------------------------------------------------------------------
-&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+&namsbc_apr    !   Atmospheric pressure forcing (in ocean or bulk)      (ln_apr_dyn=T)
 !-----------------------------------------------------------------------
-!              ! 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'  ,  ''      ,   ''     , ''
+!              !  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'  ,  ''      ,   ''     , ''
 
    cn_dir      = './'       !  root directory for the location of the bulk files
-   rn_pref     = 101000._wp !  reference atmospheric pressure   [N/m2]/
+   rn_pref     = 101000.    !  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/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_core
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_core	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_core	(revision 6808)
@@ -2,19 +2,23 @@
 &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_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'  , ''       , ''       , ''
-!
+!              !  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'  , ''       , ''
+
    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/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_cpl
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_cpl	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_cpl	(revision 6808)
@@ -1,23 +1,27 @@
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
 !-----------------------------------------------------------------------
-!                    !     description       !  multiple  !    vector   !      vector          ! vector !
-!                    !                       ! categories !  reference  !    orientation       ! grids  !
+!                    !     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'    ,     ''      ,         ''          ,   ''
+   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)
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_iscpl
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_iscpl	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_iscpl	(revision 6808)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+&namsbc_iscpl  !   land ice / ocean coupling option
+!-----------------------------------------------------------------------
+   nn_drown  = 10       ! number of iterations of the extrapolation loop (fill the new wet cells)
+   ln_hsb    = .false.  ! activate conservation module (conservation exact after a time of rn_fiscpl)
+   nn_fiscpl = 43800    ! (number of time step) conservation period (maybe should be fix to the coupling frequencey of restart frequency)
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_isf
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_isf	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_isf	(revision 6808)
@@ -1,27 +1,31 @@
 !-----------------------------------------------------------------------
-&namsbc_isf    !  Top boundary layer (ISF)
+&namsbc_isf    !  Top boundary layer (ISF)                              (nn_isf >0)
 !-----------------------------------------------------------------------
+   nn_isf      = -99       !  ice shelf melting/freezing                (/=0 => fill namsbc_isf)
+                           !  1 = ISF explicit (cavity open)
+                           !  2 = bg03 parametrisation (cavity closed)  
+                           !  3 = ISF  specified in depth along the calving front (cavity closed)
+                           !  4 = ISF melting specified (cavity open)
+                           !  option 1 and 4 need ln_isfcav = .true. (domzgr)
 !              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
 !              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
 ! nn_isf == 4
-   sn_qisf      = 'rnfisf' ,         -12      ,'sohflisf',    .false.      , .true.  , 'yearly'  ,  ''      ,   ''
-   sn_fwfisf    = 'rnfisf' ,         -12      ,'sowflisf',    .false.      , .true.  , 'yearly'  ,  ''      ,   ''
+   sn_fwfisf     = 'rnfisf',         -12       ,'sowflisf',    .false.      , .true.  , 'yearly'  ,  ''      ,   ''
 ! nn_isf == 3
-   sn_rnfisf    = 'runoffs' ,         -12      ,'sofwfisf',    .false.      , .true.  , 'yearly'  ,  ''      ,   ''
-! nn_isf == 2 and 3
-   sn_depmax_isf = 'runoffs' ,       -12        ,'sozisfmax' ,   .false.  , .true.  , 'yearly'  ,  ''      ,   ''
-   sn_depmin_isf = 'runoffs' ,       -12        ,'sozisfmin' ,   .false.  , .true.  , 'yearly'  ,  ''      ,   ''
+   sn_rnfisf     = 'rnfisf',         -12       ,'sofwfisf',    .false.   , .true. , 'yearly'  ,  ''      ,   ''
+! nn_isf == 2 or 3
+   sn_depmax_isf = 'rnfisf',         -12       ,'sozisfmax',   .false.   , .true. , 'yearly'  ,  ''      ,   ''
+   sn_depmin_isf = 'rnfisf',         -12       ,'sozisfmin',   .false.   , .true. , 'yearly'  ,  ''      ,   ''
 ! nn_isf == 2
-   sn_Leff_isf = 'rnfisf' ,       0          ,'Leff'         ,   .false.  , .true.  , 'yearly'  ,  ''      ,   ''
-! for all case
-   ln_divisf   = .true.  ! apply isf melting as a mass flux or in the salinity trend. (maybe I should remove this option as for runoff?)
+   sn_Leff_isf = 'rnfisf'  ,         -12       ,'Leff'     ,    .false.  , .true. , 'yearly'  ,  ''      ,   ''
+
 ! only for nn_isf = 1 or 2
-   rn_gammat0  = 1.0e-4   ! gammat coefficient used in blk formula
-   rn_gammas0  = 1.0e-4   ! gammas coefficient used in blk formula
+   rn_gammat0  = 1.e-4    ! gammat coefficient used in blk formula
+   rn_gammas0  = 1.e-4    ! gammas coefficient used in blk formula
+! only for nn_isf = 1 or 4
+   nn_isfblk   =  1       ! 1 ISOMIP ; 2 conservative (3 equation formulation, Jenkins et al. 1991 ??)
 ! only for nn_isf = 1
-   nn_isfblk   =  1       ! 1 ISOMIP ; 2 conservative (3 equation formulation, Jenkins et al. 1991 ??)
-   rn_hisf_tbl =  30.      ! thickness of the top boundary layer           (Losh et al. 2008)
+   rn_hisf_tbl =  30.     ! thickness of the top boundary layer           (Losh et al. 2008)
                           ! 0 => thickness of the tbl = thickness of the first wet cell
-   ln_conserve = .true.   ! conservative case (take into account meltwater advection)
    nn_gammablk = 1        ! 0 = cst Gammat (= gammat/s)
                           ! 1 = velocity dependend Gamma (u* * gammat/s)  (Jenkins et al. 2010)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_mfs
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_mfs	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_mfs	(revision 6808)
@@ -2,13 +2,14 @@
 &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     =   'precip'  ,        6          , 'precip'  ,    .true.    , .false. , 'daily'  ,'bicubic'    , ''    , ''
-   cn_dir      =   './'      !  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     =   'ecmwf'   ,        6          , 'precip' ,    .true.    , .true. , 'daily'   ,'bicubic.nc' ,   ''     ,   ''
+
+   cn_dir      = './ECMWF/'      !  root directory for the location of the bulk files
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_rnf
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_rnf	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_rnf	(revision 6808)
@@ -1,15 +1,14 @@
 !-----------------------------------------------------------------------
-&namsbc_rnf    !   runoffs namelist surface boundary condition
+&namsbc_rnf    !   runoffs namelist surface boundary condition          (ln_rnf=T)
 !-----------------------------------------------------------------------
-!              !  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
@@ -19,3 +18,7 @@
    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/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_sas
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_sas	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_sas	(revision 6808)
@@ -4,11 +4,14 @@
 !              !  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_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'  , ''       , ''             , ''
 
-   ln_3d_uv    = .true.    !  specify whether we are supplying a 3D u,v field
+   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
    cn_dir      = './'      !  root directory for the location of the bulk files are
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_ssr
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_ssr	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_ssr	(revision 6808)
@@ -1,4 +1,4 @@
 !-----------------------------------------------------------------------
-&namsbc_ssr    !   surface boundary condition : sea surface restoring
+&namsbc_ssr    !   surface boundary condition : sea surface restoring   (ln_ssr=T)
 !-----------------------------------------------------------------------
 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_wave
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_wave	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namsbc_wave	(revision 6808)
@@ -1,12 +1,14 @@
 !-----------------------------------------------------------------------
-&namsbc_wave   ! External fields from wave model
+&namsbc_wave   ! External fields from wave model                        (ln_wave=T)
 !-----------------------------------------------------------------------
-!              !  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
+   cn_dir_cdg  = './'      !  root directory for the location of drag coefficient files
+   ln_cdgw = .false.       !  Neutral drag coefficient read from wave model
+   ln_sdw  = .false.       !  Computation of 3D stokes drift               
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtra_adv
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtra_adv	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtra_adv	(revision 6808)
@@ -1,11 +1,17 @@
 !-----------------------------------------------------------------------
-&namtra_adv    !   advection scheme for tracer
+&namtra_adv    !   advection scheme for tracer                          (default: NO 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
+   ln_traadv_cen =  .false.  !  2nd order centered scheme
+      nn_cen_h   =  4               !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4               !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct =  .false.  !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus =  .false.  !  MUSCL scheme
+      ln_mus_ups =  .false.         !  use upstream scheme near river mouths
+   ln_traadv_ubs =  .false.  !  UBS scheme
+      nn_ubs_v   =  2               !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck =  .false.  !  QUICKEST scheme
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtra_dmp
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtra_dmp	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtra_dmp	(revision 6808)
@@ -1,10 +1,9 @@
 !-----------------------------------------------------------------------
-&namtra_dmp    !   tracer: T & S newtonian damping
+&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO)
 !-----------------------------------------------------------------------
-   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 coeff. field (use dmp_tools to create this)
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtra_ldf
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtra_ldf	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtra_ldf	(revision 6808)
@@ -1,28 +1,32 @@
-!----------------------------------------------------------------------------------
-&namtra_ldf    !   lateral diffusion scheme for tracers
-!----------------------------------------------------------------------------------
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers                 (default: NO diffusion)
+!-----------------------------------------------------------------------
    !                       !  Operator type:
-   ln_traldf_lap    =  .true.   !  laplacian operator
-   ln_traldf_bilap  =  .false.  !  bilaplacian operator
+   !                           !  no diffusion: set ln_traldf_lap=..._blp=F 
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
    !                       !  Direction of action:
-   ln_traldf_level  =  .false.  !  iso-level
-   ln_traldf_hor    =  .false.  !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
-   ln_traldf_iso    =  .true.   !  iso-neutral                 (needs "key_ldfslp")
-   !		       	   !  Griffies parameters              (all need "key_ldfslp")
-   ln_traldf_grif   =  .false.  !  use griffies triads
-   ln_traldf_gdia   =  .false.  !  output griffies eddy velocities
-   ln_triad_iso     =  .false.  !  pure lateral mixing in ML
-   ln_botmix_grif   =  .false.  !  lateral mixing on bottom
-   !                       !  Coefficients
-   ! Eddy-induced (GM) advection always used with Griffies; otherwise needs "key_traldf_eiv"
-   ! Value rn_aeiv_0 is ignored unless = 0 with Held-Larichev spatially varying aeiv
-   !                                  (key_traldf_c2d & key_traldf_eiv & key_orca_r2, _r1 or _r05)
-   rn_aeiv_0        =  2000.    !  eddy induced velocity coefficient [m2/s]
-   rn_aht_0         =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
-   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
-   !                                           (normally=0; not used with Griffies)
-   rn_slpmax        =     0.01  !  slope limit
-   rn_chsmag        =     1.    !  multiplicative factor in Smagorinsky diffusivity
-   rn_smsh          =     1.    !  Smagorinsky diffusivity: = 0 - use only sheer
-   rn_aht_m         =  2000.    !  upper limit or stability criteria for lateral eddy diffusivity (m2/s)
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .false.  !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .false.  !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d * ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity and grid-spacing)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtra_qsr
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtra_qsr	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtra_qsr	(revision 6808)
@@ -1,4 +1,4 @@
 !-----------------------------------------------------------------------
-&namtra_qsr    !   penetrative solar radiation
+&namtra_qsr    !   penetrative solar radiation                          (ln_traqsr=T)
 !-----------------------------------------------------------------------
 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
@@ -7,5 +7,4 @@
 
    cn_dir      = './'      !  root directory for the location of the runoff files
-   ln_traqsr   = .true.    !  Light penetration (T) or not (F)
    ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
    ln_qsr_2bd  = .false.   !  2 bands              light penetration
@@ -15,3 +14,4 @@
    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/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtrd
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtrd	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtrd	(revision 6808)
@@ -1,12 +1,14 @@
 !-----------------------------------------------------------------------
-&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")
+&namtrd        !   diagnostics on dynamics and/or tracer trends         (default F)
+!              !   and/or mixed-layer trends and/or barotropic vorticity
 !-----------------------------------------------------------------------
-   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
+   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)
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtsd
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtsd	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namtsd	(revision 6808)
@@ -2,8 +2,8 @@
 &namtsd    !   data : Temperature  & Salinity
 !-----------------------------------------------------------------------
-!          ! 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'   , ''       , ' '      , ''
+!          !  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'   , ''       ,   ''    ,    ''
    !
    cn_dir        = './'     !  root directory for the location of the runoff files
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namzdf_gls
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namzdf_gls	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namzdf_gls	(revision 6808)
@@ -2,17 +2,17 @@
 &namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
 !-----------------------------------------------------------------------
-   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_emin       = 1.e-7   !  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.53    !  galperin limit
-   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   rn_clim_galp  = 0.267   !  galperin limit
    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
-   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)
+   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)
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namzdf_tke
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namzdf_tke	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namzdf_tke	(revision 6808)
@@ -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_coupled")
+                           !        = 3 as = 1 applied on HF part of the stress    ("key_oasis3")
    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/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namzgr
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namzgr	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namzgr	(revision 6808)
@@ -1,8 +1,9 @@
 !-----------------------------------------------------------------------
-&namzgr        !   vertical coordinate
+&namzgr        !   vertical coordinate                                  (default: NO selection)
 !-----------------------------------------------------------------------
-   ln_zco      = .false.   !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
-   ln_zps      = .true.    !  z-coordinate - partial steps   (T/F)
-   ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F)
-   ln_isfcav   = .false.   !  ice shelf cavity               (T/F)
+   ln_zco      = .false.   !  z-coordinate - full    steps
+   ln_zps      = .false.   !  z-coordinate - partial steps
+   ln_sco      = .false.   !  s- or hybrid z-s-coordinate
+   ln_isfcav   = .false.   !  ice shelf cavity
+   ln_linssh   = .false.   !  linear free surface
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namzgr_sco
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namzgr_sco	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/DOC/TexFiles/Namelist/namzgr_sco	(revision 6808)
@@ -2,5 +2,5 @@
 &namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
 !-----------------------------------------------------------------------
-   ln_s_sh94   = .true.    !  Song & Haidvogel 1994 hybrid S-sigma   (T)|
+   ln_s_sh94   = .false.    !  Song & Haidvogel 1994 hybrid S-sigma   (T)|
    ln_s_sf12   = .false.   !  Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied
    ln_sigcrit  = .false.   !  use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
@@ -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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-PW6_calypso.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-PW6_calypso.fcm	(revision 6807)
+++ 	(revision )
@@ -1,30 +1,0 @@
-# vargas IBM POWER6 at french IDRIS, http://www.idris.fr/su/Scalaire/vargas/hw-vargas.html
-# NCDF_INC    netcdf include file
-# NCDF_LIB    netcdf library
-# FC          Fortran compiler command
-# FCFLAGS     Fortran compiler flags
-# FFLAGS      Fortran 77 compiler flags
-# LD          linker
-# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
-# FPPFLAGS    pre-processing flags
-# AR          assembler
-# ARFLAGS     assembler flags
-# MK          make  
-# 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>
-
-
-%NCDF_INC            -I/usr/local/netcdf-3.6.3/include
-%NCDF_LIB            -L/usr/local/netcdf-3.6.3/lib -lnetcdf
-%CPP                 cpp
-%FC                  mpxlf90_r
-%FCFLAGS             -O3 -qsuffix=f=f90  -qstrict -qalias=intptr -qsuppress=1501-245 -qarch=pwr6 -q64 -qrealsize=8 -qtune=pwr6 -qextname -qlargepage -qmaxmem=-1
-%FFLAGS              -O3 -qsuffix=f=f90  -qstrict -qalias=intptr -qsuppress=1501-245 -qarch=pwr6 -q64 -qrealsize=8 -qtune=pwr6 -qextname -qlargepage -qmaxmem=-1
-%LD                  mpxlf90_r
-%LDFLAGS             -bloadmap:LinkerErrorMap 
-%FPPFLAGS            -P -C
-%AR                  ar  
-%ARFLAGS             rs
-%MK                  gmake 
-%USER_INC            %NCDF_INC
-%USER_LIB            %NCDF_LIB 
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_debug.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_debug.fcm	(revision 6807)
+++ 	(revision )
@@ -1,30 +1,0 @@
-# vargas IBM POWER6 at french IDRIS, http://www.idris.fr/su/Scalaire/vargas/hw-vargas.html
-# NCDF_INC    netcdf include file
-# NCDF_LIB    netcdf library
-# FC          Fortran compiler command
-# FCFLAGS     Fortran compiler flags
-# FFLAGS      Fortran 77 compiler flags
-# LD          linker
-# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
-# FPPFLAGS    pre-processing flags
-# AR          assembler
-# ARFLAGS     assembler flags
-# MK          make  
-# 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>
-
-
-%NCDF_INC            -I/usr/local/netcdf-3.6.3/include
-%NCDF_LIB            -L/usr/local/netcdf-3.6.3/lib -lnetcdf
-%CPP                 cpp
-%FC                  mpxlf90_r
-%FCFLAGS             -g -qsuffix=f=f90  -qstrict -qalias=intptr -qsuppress=1501-245 -qarch=pwr6 -q64 -qrealsize=8 -qtune=pwr6 -qextname -qlargepage -qmaxmem=-1
-%FFLAGS              -g -qsuffix=f=f90  -qstrict -qalias=intptr -qsuppress=1501-245 -qarch=pwr6 -q64 -qrealsize=8 -qtune=pwr6 -qextname -qlargepage -qmaxmem=-1
-%LD                  mpxlf90_r
-%LDFLAGS             -bloadmap:LinkerErrorMap 
-%FPPFLAGS            -P -C
-%AR                  ar  
-%ARFLAGS             rs
-%MK                  gmake 
-%USER_INC            %NCDF_INC
-%USER_LIB            %NCDF_LIB 
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_tools.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_tools.fcm	(revision 6807)
+++ 	(revision )
@@ -1,30 +1,0 @@
-# vargas IBM POWER6 at french IDRIS, http://www.idris.fr/su/Scalaire/vargas/hw-vargas.html
-# NCDF_INC    netcdf include file
-# NCDF_LIB    netcdf library
-# FC          Fortran compiler command
-# FCFLAGS     Fortran compiler flags
-# FFLAGS      Fortran 77 compiler flags
-# LD          linker
-# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
-# FPPFLAGS    pre-processing flags
-# AR          assembler
-# ARFLAGS     assembler flags
-# MK          make  
-# 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>
-
-
-%NCDF_INC            -I/usr/local/netcdf-3.6.3/include
-%NCDF_LIB            -L/usr/local/netcdf-3.6.3/lib -lnetcdf
-%CPP                 cpp
-%FC                  xlf90
-%FCFLAGS             -O3 -qsuffix=f=f90  -qstrict -qsuppress=1501-245 -qarch=pwr6 -q64 -qrealsize=8 -qtune=pwr6 -qextname -qlargepage -qmaxmem=-1
-%FFLAGS              -O3 -qsuffix=f=f90  -qstrict -qsuppress=1501-245 -qarch=pwr6 -q64 -qrealsize=8 -qtune=pwr6 -qextname -qlargepage -qmaxmem=-1
-%LD                  xlf90
-%LDFLAGS             -bloadmap:LinkerErrorMap 
-%FPPFLAGS            -P -C
-%AR                  ar  
-%ARFLAGS             rs
-%MK                  gmake 
-%USER_INC            %NCDF_INC
-%USER_LIB            %NCDF_LIB 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm	(revision 6808)
@@ -25,4 +25,6 @@
 # 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,2 +58,5 @@
 %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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm	(revision 6808)
@@ -13,8 +13,10 @@
 # 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$NETCDF/include
-%NCDF_LIB -L$NETCDF/lib -lnetcdf -lnetcdff
+%NCDF_INC -I${NETCDF}/include
+%NCDF_LIB -L${NETCDF}/lib -lnetcdf -lnetcdff
 %CPP                 cpp
 %FC mpiifort
@@ -29,3 +31,5 @@
 %USER_INC %NCDF_INC
 %USER_LIB %NCDF_LIB
+%CC                  icc
+%CFLAGS              -O0
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm	(revision 6808)
@@ -13,4 +13,6 @@
 # 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
 
 
@@ -29,3 +31,5 @@
 %USER_INC %NCDF_INC
 %USER_LIB %NCDF_LIB
+%CC                  icc
+%CFLAGS              -O0
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm	(revision 6808)
@@ -13,4 +13,6 @@
 # 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
 
 
@@ -29,3 +31,5 @@
 %USER_INC %NCDF_INC
 %USER_LIB %NCDF_LIB
+%CC                  icc
+%CFLAGS              -O0
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm	(revision 6808)
@@ -25,4 +25,6 @@
 # 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:
@@ -32,22 +34,24 @@
 
 # required modules
-# module load  INTEL/intel_xe_2013 NETCDF/netcdf-4.3_parallel NETCDF/parallel-netcdf-1.3.1 HDF5/hdf5-1.8.11_parallel
+# 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
 
 # Environment variables set by user. Others should automatically define when loading modules.
-# export XIOS=/users/home/models/nemo/xios
+#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
 
-%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
+%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
 %CPP                 cpp
 %FC                  mpiifort
-%FCFLAGS             -r8 -O3 -xHost -fp-model source -traceback
+%FCFLAGS             -r8 -O3 -xHost -fp-model source -traceback ${CFLAGS} 
 %FFLAGS              %FCFLAGS
 %LD                  mpiifort
 %FPPFLAGS            -P -C -traditional
-%LDFLAGS             -lstdc++ -lz -lgpfs -lcurl
+%LDFLAGS             -lstdc++ -lz -lgpfs -lcurl  ${LDFLAGS}
 %AR                  ar 
 %ARFLAGS             -r
@@ -55,2 +59,4 @@
 %USER_INC            %XIOS_INC %NCDF_INC %HDF5_INC
 %USER_LIB            %XIOS_LIB %NCDF_LIB %HDF5_LIB
+%CC                  icc
+%CFLAGS              -O0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm	(revision 6808)
@@ -15,4 +15,6 @@
 # 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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm	(revision 6808)
@@ -24,4 +24,6 @@
 # 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,2 +60,5 @@
 #FCFLAGS             -g -traceback -r8 -O0 -xT -ip -vec-report0
 #FFLAGS              -g -traceback -r8 -O0 -xT -ip -vec-report0
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm	(revision 6808)
@@ -17,4 +17,6 @@
 # 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:
@@ -48,2 +50,5 @@
 %USER_INC            %XIOS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %NCDF_LIB %XLF90_LIB
+
+%CC                  xlc
+%CFLAGS              -O -qcpluscmt
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-PW7_METO.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-PW7_METO.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-PW7_METO.fcm	(revision 6808)
@@ -15,4 +15,6 @@
 # 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
 
 
@@ -24,5 +26,5 @@
 %FC                  mpxlf90_r
 %FCFLAGS             -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
+%FFLAGS             -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF
 %LD                  mpCC_r
 %LDFLAGS             -lxlf90 -L/projects/um1/lib -lsig -O2 -L MASS
@@ -33,2 +35,4 @@
 %USER_INC            %NCDF_INC %XIOS_INC
 %USER_LIB            %NCDF_LIB %XIOS_LIB
+%CC                  xlc
+%CFLAGS              -O -qcpluscmt
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm	(revision 6808)
@@ -15,4 +15,6 @@
 # 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
@@ -32,2 +34,5 @@
 %USER_INC            %NCDF_INC %XIOS_INC
 %USER_LIB            %NCDF_LIB %XIOS_LIB
+
+%CC                  xlc
+%CFLAGS              -O -qcpluscmt
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_ADA.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_ADA.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_ADA.fcm	(revision 6808)
@@ -24,4 +24,6 @@
 # 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:
@@ -54,2 +56,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  icc
+%CFLAGS              -O0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm	(revision 6808)
@@ -24,4 +24,6 @@
 # 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:
@@ -53,2 +55,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  icc
+%CFLAGS              -O0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_CURIE.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_CURIE.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_CURIE.fcm	(revision 6808)
@@ -24,4 +24,6 @@
 # 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,2 +60,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm	(revision 6808)
@@ -29,4 +29,6 @@
 # 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:
@@ -36,5 +38,5 @@
 %NCDF_HOME           /home/acc/shared
 %HDF5_HOME           /home/acc/shared
-%XIOS_HOME           /home/acc/XIOS_1.0
+%XIOS_HOME           /home/acc/XIOS_1.0_r803
 %OASIS_HOME          
 
@@ -58,2 +60,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  icc
+%CFLAGS              -O0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_VAYU.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_VAYU.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_VAYU.fcm	(revision 6808)
@@ -24,4 +24,6 @@
 # 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:
@@ -53,2 +55,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm	(revision 6808)
@@ -24,4 +24,6 @@
 # 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:
@@ -53,2 +55,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-XC40_METO.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-XC40_METO.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-XC40_METO.fcm	(revision 6808)
@@ -24,4 +24,6 @@
 # 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:
@@ -31,5 +33,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_r618_20150619/XIOS
+%XIOS_HOME           /projects/ocean/nemo/xios/xios_1.0_r629_20150625/XIOS
 
 %NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
@@ -51,2 +53,5 @@
 %USER_INC            %XIOS_INC
 %USER_LIB            %XIOS_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-XC_ARCHER.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-XC_ARCHER.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-XC_ARCHER.fcm	(revision 6808)
@@ -24,4 +24,6 @@
 # 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,2 +59,5 @@
 #USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 #USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm	(revision 6808)
@@ -24,4 +24,6 @@
 # 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:
@@ -31,5 +33,5 @@
 %NCDF_HOME           $NETCDF_DIR
 %HDF5_HOME           $HDF5_DIR
-%XIOS_HOME           /work/n01/n01/acc/XIOS_r484
+%XIOS_HOME           /work/n01/n01/jdha/ST/xios-1.0
 #OASIS_HOME          
 
@@ -43,6 +45,6 @@
 %CPP	             cpp
 %FC                  ftn
-%FCFLAGS             -integer-size 32 -real-size 64 -O3 -fp-model source -zero -fpp -warn all
-%FFLAGS              -integer-size 32 -real-size 64 -O3 -fp-model source -zero -fpp -warn all
+%FCFLAGS             -integer-size 32 -real-size 64 -O0 -g -fp-model source -zero -fpp -warn all
+%FFLAGS              -integer-size 32 -real-size 64 -O0 -g -fp-model source -zero -fpp -warn all
 %LD                  CC -Wl,"--allow-multiple-definition"
 %FPPFLAGS            -P -C -traditional
@@ -51,6 +53,11 @@
 %ARFLAGS             -r
 %MK                  gmake
+#%USER_INC             %NCDF_INC
+#%USER_LIB             %NCDF_LIB
 %USER_INC            %XIOS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %NCDF_LIB
 #USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 #USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-macport_osx.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-macport_osx.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-macport_osx.fcm	(revision 6808)
@@ -33,4 +33,6 @@
 # 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:
@@ -62,2 +64,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm	(revision 6808)
@@ -13,4 +13,6 @@
 # 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
 
@@ -31,2 +33,5 @@
 %USER_INC            -I$XIOS_INC %NCDF_INC
 %USER_LIB            -L$XIOS_LIB -lxios %NCDF_LIB -lstdc++
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml	(revision 6808)
@@ -25,9 +25,66 @@
       <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 -->
+<!--old      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> old --> <!-- 1h files --> 
+   <!-- TMB files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."  >                      
+
+   <file id="file9" name_suffix="_shelftmb_grid_T" description="ocean T grid variables" enabled=".TRUE." >
+     <field field_ref="top_temp"           name="votemper_top"   operation="instant" enabled=".TRUE." />
+     <field field_ref="mid_temp"           name="votemper_mid"   operation="instant" enabled=".TRUE." />
+     <field field_ref="bot_temp"           name="votemper_bot"   operation="instant" enabled=".TRUE." />
+     <field field_ref="sshnmasked"         name="sossheig"       operation="instant" enabled=".TRUE." /> 
+     <field field_ref="top_sal"            name="vosaline_top"   operation="instant" enabled=".TRUE." />
+     <field field_ref="mid_sal"            name="vosaline_mid"   operation="instant" enabled=".TRUE." />
+     <field field_ref="bot_sal"            name="vosaline_bot"   operation="instant" enabled=".TRUE." />
+   </file>
+
+   <file id="file10" name_suffix="_shelftmb_grid_U" description="TMB ocean U grid variables" enabled=".TRUE." >
+     <field field_ref="top_u"         name="vozocrtx_top"   operation="instant" />
+     <field field_ref="mid_u"         name="vozocrtx_mid"   operation="instant" />
+     <field field_ref="bot_u"         name="vozocrtx_bot"   operation="instant" />
+     <field field_ref="baro_u"        name="vobtcrtx"       operation="instant" />
+   </file>
+
+   <file id="file11" name_suffix="_shelftmb_grid_V" description="TMB ocean V grid variables" enabled=".TRUE." >
+     <field field_ref="top_v"         name="vomecrty_top"   operation="instant" />
+     <field field_ref="mid_v"         name="vomecrty_mid"   operation="instant" />
+     <field field_ref="bot_v"         name="vomecrty_bot"   operation="instant" />
+     <field field_ref="baro_v"        name="vobtcrty"       operation="instant" />
+   </file>
+
+      </file_group>
+
       <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="25h_mean" output_freq="1d" output_level="10" enabled=".TRUE.">
+
+
+     <file id="file12" name_suffix="_25hourm_grid_T" description="ocean T grid variables, 25h meaned" enabled=".TRUE." >
+     <field field_ref="temper25h"   name="votemper"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="tempis25h"   name="votempis"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="salin25h"    name="vosaline"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="ssh25h"      name="sossheig"  operation="instant" enabled=".TRUE."/>
+    </file>
+
+     <file id="file13" name_suffix="_25hourm_grid_U" description="ocean U grid variables, 25h meaned" enabled=".TRUE." >
+     <field field_ref="vozocrtx25h" name="vozocrtx"  operation="instant" enabled=".TRUE."/>
+    </file>
+
+     <file id="file14" name_suffix="_25hourm_grid_V" description="ocean V grid variables, 25h meaned" enabled=".TRUE." >
+     <field field_ref="vomecrty25h" name="vomecrty"  operation="instant" enabled=".TRUE."/>
+    </file>
+
+     <file id="file15" name_suffix="_25hourm_grid_W" description="ocean W grid variables, 25h meaned" enabled=".TRUE." >
+     <field field_ref="vomecrtz25h"          name="vomerctz"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="woce"                 name="vovecrtz"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="avt25h"               name="votkeavt"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="avm25h"               name="votkeavm"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="tke25h"               name="votke"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="mxln25h"              name="mxln"   operation="instant" enabled=".TRUE."/>
+    </file>
+      </file_group>
      
       <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."> <!-- 1d files -->
@@ -98,4 +155,5 @@
       <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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg	(revision 6808)
@@ -14,6 +14,7 @@
    cn_ocerst_in   = "amm12_restart_oce"   !  suffix of ocean restart name (input)
    cn_ocerst_out  = "restart_oce_out"   !  suffix of ocean restart name (input)
-   nn_stock    =    1296   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_stock    =    820   !  frequency of creation of a restart file (modulo referenced to 1)
    nn_write    =     144   !  frequency of write in the output file   (modulo referenced to nit000) 
+   ln_clobber  = .true.   !  clobber (overwrite) an existing file
 /
 !-----------------------------------------------------------------------
@@ -34,6 +35,5 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
-   ln_zps      = .false.   !  z-coordinate - partial steps   (T/F)
-   ln_sco      = .true.    !  s- or hybrid z-s-coordinate    (T/F)
+   ln_sco      = .true.    !  s- or hybrid z-s-coordinate
 /
 !-----------------------------------------------------------------------
@@ -50,7 +50,4 @@
 !-----------------------------------------------------------------------
    rn_rdt      =   600.    !  time step for the dynamics (and tracer if nn_acc=0)
-   rn_rdtmin   =   600.          !  minimum time step on tracers (used if nn_acc=1)
-   rn_rdtmax   =   600.          !  maximum time step on tracers (used if nn_acc=1)
-   rn_rdth     =   600.          !  depth variation of tracer time step  (used if nn_acc=1)
    ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
    ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
@@ -72,11 +69,4 @@
 /
 !-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
-   ln_bt_nn_auto =    .FALSE.          !  Set nn_baro automatically to be just below
-                                       !  a user defined maximum courant number (rn_bt_cmax)
-   nn_baro       =    30               !  Number of iterations of barotropic mode
-/
-!-----------------------------------------------------------------------
 &namcrs        !   Grid coarsening for dynamics output and/or
                !   passive tracer coarsened online simulations
@@ -100,4 +90,5 @@
    nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
    ln_apr_dyn  = .false.    !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
 
 /
@@ -137,5 +128,4 @@
 &namtra_qsr    !   penetrative solar radiation
 !-----------------------------------------------------------------------
-   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
    nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
 /
@@ -194,12 +184,4 @@
    rn_shlat    =     0     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
                            !  free slip  !   partial slip  !   no slip   ! strong slip
-/
-!-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
 /
 !-----------------------------------------------------------------------
@@ -231,4 +213,7 @@
     cn_dyn2d       = 'flather'
     nn_dyn2d_dta   =  3
+    cn_dyn3d      =  'neumann'               !
+    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
     cn_tra         =  'frs'
     nn_tra_dta    =   1 
@@ -265,7 +250,6 @@
 /
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
-!-----------------------------------------------------------------------
-   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
 /
 !-----------------------------------------------------------------------
@@ -281,4 +265,9 @@
 &namtra_adv    !   advection scheme for tracer
 !-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !-----------------------------------------------------------------------
@@ -289,8 +278,36 @@
 &namtra_ldf    !   lateral diffusion scheme for tracers
 !----------------------------------------------------------------------------------
-   ln_traldf_hor    =  .true.   !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
-   ln_traldf_iso    =  .false.  !  iso-neutral                 (needs "key_ldfslp")
-   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]
-   rn_aht_0         =    50.    !  horizontal eddy diffusivity for tracers [m2/s]
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .true.   !  horizontal (geopotential)
+   ln_traldf_iso   =  .false.  !  iso-neutral
+   ln_traldf_triad =  .false.  !  iso-neutral using Griffies triads
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML     (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom         (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        =   50.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
 /
 !-----------------------------------------------------------------------
@@ -306,4 +323,9 @@
 &namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
 !-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 1             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
 /
 !-----------------------------------------------------------------------
@@ -314,22 +336,35 @@
 /
 !-----------------------------------------------------------------------
-!namdyn_spg    !   surface pressure gradient   (CPP key only)
-!-----------------------------------------------------------------------
-!                          !  explicit free surface                     ("key_dynspg_exp")
-!                          !  filtered free surface                     ("key_dynspg_flt")
-!                          !  split-explicit free surface               ("key_dynspg_ts")
-
+&namdyn_spg    !   surface pressure gradient 
+!-----------------------------------------------------------------------
+   ln_dynspg_ts = .true.    ! split-explicit free surface
+      ln_bt_auto    = .false.  ! Number of sub-step defined from:
+         nn_baro       = 30       ! =F : the number of sub-step in rn_rdt seconds
+/
 !-----------------------------------------------------------------------
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
    !                       !  Type of the operator :
-   ln_dynldf_bilap  =  .true.   !  bilaplacian operator
-   ln_dynldf_lap    =  .false.  !  bilaplacian operator
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .true.     !  bilaplacian operator
    !                       !  Direction of action  :
-   ln_dynldf_level  =  .true.   !  iso-level
-   ln_dynldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
-                           !  Coefficient
-   rn_ahm_0_lap     = 60.0      !  horizontal laplacian eddy viscosity   [m2/s]
-   rn_ahm_0_blp     = -1.0e+10  !  horizontal bilaplacian eddy viscosity [m4/s]
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     60.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.0e+10     !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
 /
 !-----------------------------------------------------------------------
@@ -349,8 +384,4 @@
 !-----------------------------------------------------------------------
 /
-!------------------------------------------------------------------------
-&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
-!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
-/
 !-----------------------------------------------------------------------
 &namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
@@ -369,8 +400,4 @@
 /
 !-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------
@@ -421,5 +448,12 @@
 /
 !-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-/
+&nam_diatmb  !  Top Middle Bottom Output
+!-----------------------------------------------------------------------
+   ln_diatmb  = .true.    !  Choose Top Middle and Bottom output or not
+/
+!-----------------------------------------------------------------------
+&nam_dia25h  !  25h Mean Output
+!-----------------------------------------------------------------------
+   ln_dia25h  = .true.    ! Choose 25h mean output or not
+/
+
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/AMM12/cpp_AMM12.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/AMM12/cpp_AMM12.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/AMM12/cpp_AMM12.fcm	(revision 6808)
@@ -1,1 +1,1 @@
- bld::tool::fppkeys  key_bdy key_tide key_dynspg_ts key_ldfslp  key_zdfgls  key_vvl key_diainstant key_mpp_mpi key_iomput
+ bld::tool::fppkeys  key_bdy key_tide key_zdfgls key_diainstant key_mpp_mpi key_iomput
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg	(revision 6808)
@@ -30,4 +30,5 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
 /
 !-----------------------------------------------------------------------
@@ -41,7 +42,5 @@
    rn_bathy    = 4198.     !  value of the bathymetry. if (=0) bottom flat at jpkm1
    nn_msh      =    0      !  create (=1) a mesh file or not (=0)
-   rn_rdt      =  360.     !  time step for the dynamics (and tracer if nn_acc=0)
-   rn_rdtmin   =  360.     !  minimum time step on tracers (used if nn_acc=1)
-   rn_rdtmax   =  360.     !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdt      =  360.     !  time step for the dynamics 
    jphgr_msh   =       1                 !  type of horizontal mesh
    ppglam0     =    -150.0               !  longitude of first raw and column T-point (jphgr_msh = 1)
@@ -64,8 +63,4 @@
 /
 !-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namcrs        !   Grid coarsening for dynamics output and/or
                !   passive tracer coarsened online simulations
@@ -141,4 +136,7 @@
 &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'  , ''       , ''       , ''
 /
 !-----------------------------------------------------------------------
@@ -172,12 +170,4 @@
 /
 !-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
@@ -205,8 +195,6 @@
 /
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
-!-----------------------------------------------------------------------
-   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
-   nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
 /
 !-----------------------------------------------------------------------
@@ -226,4 +214,5 @@
 &namtra_adv    !   advection scheme for tracer
 !-----------------------------------------------------------------------
+! C1D : no advection scheme 
 /
 !-----------------------------------------------------------------------
@@ -231,12 +220,13 @@
 !-----------------------------------------------------------------------
 /
-!----------------------------------------------------------------------------------
+!-----------------------------------------------------------------------
 &namtra_ldf    !   lateral diffusion scheme for tracers
-!----------------------------------------------------------------------------------
-!----------------------------------------------------------------------------------
-   ln_traldf_hor    =  .true.   !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
-   ln_traldf_iso    =  .false.  !  iso-neutral                 (needs "key_ldfslp")
-   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]
-   rn_aht_0         =     0.    !  horizontal eddy diffusivity for tracers [m2/s]
+!-----------------------------------------------------------------------
+! C1D : no lateral diffusion  
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!-----------------------------------------------------------------------
+! C1D : no eiv  
 /
 !-----------------------------------------------------------------------
@@ -248,4 +238,5 @@
 &namdyn_adv    !   formulation of the momentum advection
 !-----------------------------------------------------------------------
+! C1D : no advection scheme 
 /
 !-----------------------------------------------------------------------
@@ -266,6 +257,7 @@
 /
 !-----------------------------------------------------------------------
-!namdyn_spg    !   surface pressure gradient   (CPP key only)
-!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient                            (default: NO spg)
+!-----------------------------------------------------------------------
+/
 !-----------------------------------------------------------------------
 &namdyn_ldf    !   lateral diffusion on momentum
@@ -286,8 +278,4 @@
 !-----------------------------------------------------------------------
 /
-!------------------------------------------------------------------------
-&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
-!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
-/
 !-----------------------------------------------------------------------
 &namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
@@ -302,11 +290,4 @@
 !-----------------------------------------------------------------------
    ln_tmx_itf  = .false.   !  ITF specific parameterisation
-/
-!-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface
-!-----------------------------------------------------------------------
-   nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
-   nn_nmin     =    210    !  minimum of iterations for the SOR solver
-   rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain)
 /
 !-----------------------------------------------------------------------
@@ -358,7 +339,2 @@
 !-----------------------------------------------------------------------
 /
-!-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-   ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water
-/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg	(revision 6808)
@@ -32,6 +32,6 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
-   ln_zco      = .true.    !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
-   ln_zps      = .false.   !  z-coordinate - partial steps   (T/F)
+   ln_zco      = .true.    !  z-coordinate - full    steps
+   ln_linssh   = .true.    !  linear free surface
 /
 !-----------------------------------------------------------------------
@@ -43,7 +43,5 @@
 !-----------------------------------------------------------------------
    nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file
-   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0)
-   rn_rdtmin   = 7200.           !  minimum time step on tracers (used if nn_acc=1)
-   rn_rdtmax   = 7200.           !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdt      = 7200.     !  time step for the dynamics 
    jphgr_msh   =       5                 !  type of horizontal mesh
    ppglam0     =       0.0               !  longitude of first raw and column T-point (jphgr_msh = 1)
@@ -66,8 +64,4 @@
 /
 !-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namcrs        !   Grid coarsening for dynamics output and/or
                !   passive tracer coarsened online simulations
@@ -154,12 +148,4 @@
 !-----------------------------------------------------------------------
    rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
-/
-!-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
 /
 !-----------------------------------------------------------------------
@@ -223,11 +209,9 @@
 &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_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !-----------------------------------------------------------------------
@@ -238,6 +222,36 @@
 &namtra_ldf    !   lateral diffusion scheme for tracers
 !----------------------------------------------------------------------------------
-   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]
-   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral
+   ln_traldf_triad =  .false.  !  iso-neutral using Griffies triads
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .false.  !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML     (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom         (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 1000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
 /
 !-----------------------------------------------------------------------
@@ -253,7 +267,9 @@
 &namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
 !-----------------------------------------------------------------------
-   ln_dynvor_ene = .true.  !  energy    conserving scheme  
-   ln_dynvor_ens = .false. !  enstrophy conserving scheme    
+   ln_dynvor_ene = .true.  !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
    ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 1             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
 /
 !-----------------------------------------------------------------------
@@ -264,11 +280,31 @@
 /
 !-----------------------------------------------------------------------
-!namdyn_spg    !   surface pressure gradient   (CPP key only)
-!-----------------------------------------------------------------------
-
+&namdyn_spg    !   surface pressure gradient 
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
 !-----------------------------------------------------------------------
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
-   rn_ahm_0_lap     = 100000.   !  horizontal laplacian eddy viscosity   [m2/s]
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      = 100000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =      0.     !  horizontal bilaplacian eddy viscosity [m4/s]
 /
 !-----------------------------------------------------------------------
@@ -286,8 +322,4 @@
    nn_etau     =   0       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
 /
-!------------------------------------------------------------------------
-&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
-!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
-/
 !-----------------------------------------------------------------------
 &namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
@@ -302,11 +334,4 @@
 !-----------------------------------------------------------------------
    ln_tmx_itf  = .false.   !  ITF specific parameterisation
-/
-!-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface
-!-----------------------------------------------------------------------
-   nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
-   nn_nmin     =    210    !  minimum of iterations for the SOR solver
-   rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain)
 /
 !-----------------------------------------------------------------------
@@ -374,7 +399,2 @@
 !-----------------------------------------------------------------------
 /
-!-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-   ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water
-/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm	(revision 6808)
@@ -1,1 +1,1 @@
- bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_nosignedzero
+ bld::tool::fppkeys key_zdftke key_iomput key_mpp_mpi
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg	(revision 6808)
@@ -35,6 +35,6 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
-   ln_zco      = .true.    !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
-   ln_zps      = .false.   !  z-coordinate - partial steps   (T/F)
+   ln_zco      = .true.    !  z-coordinate - full    steps
+   ln_linssh   = .true.   !  linear free surface
 /
 !-----------------------------------------------------------------------
@@ -46,7 +46,5 @@
 !-----------------------------------------------------------------------
    nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file
-   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0)
-   rn_rdtmin   = 7200.           !  minimum time step on tracers (used if nn_acc=1)
-   rn_rdtmax   = 7200.           !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdt      = 7200.     !  time step for the dynamics 
    jphgr_msh   =       5                 !  type of horizontal mesh
    ppglam0     =       0.0               !  longitude of first raw and column T-point (jphgr_msh = 1)
@@ -69,8 +67,4 @@
 /
 !-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namcrs        !   Grid coarsening for dynamics output and/or
                !   passive tracer coarsened online simulations
@@ -161,12 +155,4 @@
 /
 !-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
@@ -194,8 +180,6 @@
 /
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
-!-----------------------------------------------------------------------
-   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
-   nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
 /
 !-----------------------------------------------------------------------
@@ -228,5 +212,9 @@
 &namtra_adv    !   advection scheme for tracer
 !-----------------------------------------------------------------------
-   ln_traadv_msc_ups=  .false.  !  use upstream scheme within muscl 
+   ln_traadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !-----------------------------------------------------------------------
@@ -237,6 +225,36 @@
 &namtra_ldf    !   lateral diffusion scheme for tracers
 !----------------------------------------------------------------------------------
-   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]
-   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 1000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
 /
 !-----------------------------------------------------------------------
@@ -252,7 +270,5 @@
 &namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
 !-----------------------------------------------------------------------
-   ln_dynvor_ene = .true.  !  energy    conserving scheme  
-   ln_dynvor_ens = .false. !  enstrophy conserving scheme    
-   ln_dynvor_een = .false. !  energy & enstrophy scheme
+   ln_dynvor_ene = .true.  !  enstrophy conserving scheme
 /
 !-----------------------------------------------------------------------
@@ -263,9 +279,34 @@
 /
 !-----------------------------------------------------------------------
-!namdyn_spg    !   surface pressure gradient   (CPP key only)
-!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
 !-----------------------------------------------------------------------
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      = 100000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =      0.     !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
    rn_ahm_0_lap     = 100000.   !  horizontal laplacian eddy viscosity   [m2/s]
 /
@@ -284,8 +325,4 @@
    nn_etau     =   0       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
 /
-!------------------------------------------------------------------------
-&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
-!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
-/
 !-----------------------------------------------------------------------
 &namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
@@ -300,11 +337,4 @@
 !-----------------------------------------------------------------------
    ln_tmx_itf  = .false.   !  ITF specific parameterisation
-/
-!-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface
-!-----------------------------------------------------------------------
-   nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
-   nn_nmin     =    210    !  minimum of iterations for the SOR solver
-   rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain)
 /
 !-----------------------------------------------------------------------
@@ -356,7 +386,2 @@
 !-----------------------------------------------------------------------
 /
-!-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-   ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water
-/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_top_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_top_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_top_cfg	(revision 6808)
@@ -23,7 +23,10 @@
 !-----------------------------------------------------------------------
 &namtrc_adv    !   advection scheme for passive tracer 
-!-----------------------------------------------------------------------  
-   ln_trcadv_tvd     =  .true.   !  TVD scheme
-   ln_trcadv_muscl   =  .false.  !  MUSCL scheme
+!-----------------------------------------------------------------------
+   ln_trcadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !-----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm	(revision 6808)
@@ -1,2 +1,2 @@
-bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_vectopt_loop key_top key_my_trc key_mpp_mpi key_iomput
+bld::tool::fppkeys key_zdftke key_top key_my_trc key_mpp_mpi key_iomput
 inc $BFMDIR/src/nemo/bfm.fcm
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg	(revision 6808)
@@ -29,6 +29,6 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
-   ln_zco      = .true.    !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
-   ln_zps      = .false.   !  z-coordinate - partial steps   (T/F)
+   ln_zco      = .true.    !  z-coordinate - full    steps
+   ln_linssh   = .true.    !  linear free surface
 /
 !-----------------------------------------------------------------------
@@ -36,7 +36,5 @@
 !-----------------------------------------------------------------------
    nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file
-   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0)
-   rn_rdtmin   = 7200.           !  minimum time step on tracers (used if nn_acc=1)
-   rn_rdtmax   = 7200.           !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdt      = 7200.     !  time step for the dynamics 
    jphgr_msh   =       5                 !  type of horizontal mesh
    ppglam0     =       0.0               !  longitude of first raw and column T-point (jphgr_msh = 1)
@@ -59,8 +57,4 @@
 /
 !-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namcrs        !   Grid coarsening for dynamics output and/or
                !   passive tracer coarsened online simulations
@@ -104,8 +98,4 @@
 /
 !-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &nambfr        !   bottom friction
 !-----------------------------------------------------------------------
@@ -113,8 +103,6 @@
 /
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
-!-----------------------------------------------------------------------
-   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
-   nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
 /
 !-----------------------------------------------------------------------
@@ -143,11 +131,45 @@
 &namtra_adv    !   advection scheme for tracer
 !-----------------------------------------------------------------------
-   ln_traadv_msc_ups=  .false.  !  use upstream scheme within muscl 
+   ln_traadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !----------------------------------------------------------------------------------
 &namtra_ldf    !   lateral diffusion scheme for tracers
 !----------------------------------------------------------------------------------
-   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]
-   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 1000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
 /
 !-----------------------------------------------------------------------
@@ -163,7 +185,9 @@
 &namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
 !-----------------------------------------------------------------------
-   ln_dynvor_ene = .true.  !  energy    conserving scheme  
-   ln_dynvor_ens = .false. !  enstrophy conserving scheme    
+   ln_dynvor_ene = .true.  !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
    ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 1             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
 /
 !-----------------------------------------------------------------------
@@ -174,6 +198,34 @@
 /
 !-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
+!-----------------------------------------------------------------------
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.    !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.    !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      = 100000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =      0.      !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
    rn_ahm_0_lap     = 100000.   !  horizontal laplacian eddy viscosity   [m2/s]
 /
@@ -189,11 +241,4 @@
 /
 !-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface
-!-----------------------------------------------------------------------
-   nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
-   nn_nmin     =    210    !  minimum of iterations for the SOR solver
-   rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain)
-/
-!-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------
@@ -211,7 +256,2 @@
 !-----------------------------------------------------------------------
 /
-!-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-   ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water
-/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_top_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_top_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_top_cfg	(revision 6808)
@@ -24,6 +24,9 @@
 &namtrc_adv    !   advection scheme for passive tracer 
 !-----------------------------------------------------------------------   
-   ln_trcadv_tvd     =  .true.   !  TVD scheme
-   ln_trcadv_muscl   =  .false.  !  MUSCL scheme
+   ln_trcadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !-----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm	(revision 6808)
@@ -1,1 +1,1 @@
-bld::tool::fppkeys  key_dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi
+bld::tool::fppkeys key_zdftke key_top key_pisces_reduced key_mpp_mpi
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg	(revision 6808)
@@ -29,6 +29,6 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
-   ln_zco      = .true.    !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
-   ln_zps      = .false.   !  z-coordinate - partial steps   (T/F)
+   ln_zco      = .true.    !  z-coordinate - full    steps
+   ln_linssh   = .true.    !  linear free surface
 /
 !-----------------------------------------------------------------------
@@ -40,8 +40,6 @@
 !-----------------------------------------------------------------------
    nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file
-   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_rdt      = 7200.     !  time step for the dynamics 
 !   nn_baro     =   60      !  number of barotropic time step            ("key_dynspg_ts")
-   rn_rdtmin   = 7200.           !  minimum time step on tracers (used if nn_acc=1)
-   rn_rdtmax   = 7200.           !  maximum time step on tracers (used if nn_acc=1)
    jphgr_msh   =       5                 !  type of horizontal mesh
    ppglam0     =       0.0               !  longitude of first raw and column T-point (jphgr_msh = 1)
@@ -150,12 +148,4 @@
 /
 !-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
@@ -183,8 +173,6 @@
 /
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
-!-----------------------------------------------------------------------
-   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
-   nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
 /
 !-----------------------------------------------------------------------
@@ -200,5 +188,9 @@
 &namtra_adv    !   advection scheme for tracer
 !-----------------------------------------------------------------------
-   ln_traadv_msc_ups=  .false.  !  use upstream scheme within muscl 
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !-----------------------------------------------------------------------
@@ -209,6 +201,36 @@
 &namtra_ldf    !   lateral diffusion scheme for tracers
 !----------------------------------------------------------------------------------
-   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]
-   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 1000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
 /
 !-----------------------------------------------------------------------
@@ -235,6 +257,8 @@
 /
 !-----------------------------------------------------------------------
-!namdyn_spg    !   surface pressure gradient   (CPP key only)
-!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
 !-----------------------------------------------------------------------
 &namdyn_ldf    !   lateral diffusion on momentum
@@ -274,11 +298,4 @@
 /
 !-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface
-!-----------------------------------------------------------------------
-   nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
-   nn_nmin     =    210    !  minimum of iterations for the SOR solver
-   rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain)
-/
-!-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------
@@ -328,7 +345,2 @@
 !-----------------------------------------------------------------------
 /
-!-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-   ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water
-/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_XIOS/cpp_GYRE_XIOS.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_XIOS/cpp_GYRE_XIOS.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/GYRE_XIOS/cpp_GYRE_XIOS.fcm	(revision 6808)
@@ -1,1 +1,1 @@
- bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi
+ bld::tool::fppkeys key_zdftke key_iomput key_mpp_mpi
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg	(revision 6808)
@@ -4,10 +4,11 @@
 !-----------------------------------------------------------------------
 &namrun        !   parameters of the run
+ nn_it000=1
 !-----------------------------------------------------------------------
    cn_exp      = "Agulhas" !  experience name 
-   nn_itend    =     480   !  last  time step
+   nn_itend    =   10950
    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)
-   ln_clobber  = .true.    !  clobber (overwrite) an existing file
+   ln_clobber  =  .true.
 /
 !-----------------------------------------------------------------------
@@ -28,4 +29,6 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
+   ln_linssh   = .true.    !  linear free surface
 /
 !-----------------------------------------------------------------------
@@ -51,10 +54,4 @@
    ppacr2      =  999999.              !
    rn_rdt      = 2880.     !  time step for the dynamics (and tracer if nn_acc=0)
-   rn_rdtmin   = 14400.          !  minimum time step on tracers (used if nn_acc=1)
-   rn_rdtmax   = 14400.          !  maximum time step on tracers (used if nn_acc=1)
-/
-!-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
 /
 !-----------------------------------------------------------------------
@@ -116,8 +113,4 @@
 /
 !-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
@@ -128,6 +121,7 @@
 /
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
-!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
 /
 !-----------------------------------------------------------------------
@@ -145,13 +139,47 @@
 /
 !-----------------------------------------------------------------------
-&namtra_adv    !   advection scheme for tracer 
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namtra_ldf    !   lateral diffusion scheme for tracers 
-!-----------------------------------------------------------------------
-
-   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
-   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant
+   !                                !   = 10 F(k)      =ldf_c1d
+   !                                !   = 20 F(i,j)    =ldf_c2d
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 1000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
 /
 !-----------------------------------------------------------------------
@@ -162,4 +190,9 @@
 &namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
 !-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 1             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
 /
 !-----------------------------------------------------------------------
@@ -168,10 +201,31 @@
 /
 !-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts = .true.   !  Split-explicit free surface
+/
+!-----------------------------------------------------------------------
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
-   !                       !  Type of the operator : 
-   ln_dynldf_lap    =  .false.  !  laplacian operator         
-   ln_dynldf_bilap  =  .true.   !  bilaplacian operator    
-   rn_ahm_0_blp     = -8.5e+11  !  horizontal bilaplacian eddy viscosity [m4/s] 
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .true.     !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  =   0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 8.5e+11      !  horizontal bilaplacian eddy viscosity [m4/s]
 /
 !-----------------------------------------------------------------------
@@ -193,8 +247,4 @@
 /
 !-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface 
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------
@@ -217,8 +267,4 @@
 /
 !-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namobs       !  observation usage                                      ('key_diaobs')
 !-----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml	(revision 6808)
@@ -153,4 +153,148 @@
   </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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg	(revision 6808)
@@ -6,4 +6,8 @@
 &namrun        !   parameters of the run
 !-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "ORCA2"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =     300   !  last  time step (std 5475)
 /
 !-----------------------------------------------------------------------
@@ -24,4 +28,6 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
+   ln_linssh   = .true.    !  linear free surface
 /
 !-----------------------------------------------------------------------
@@ -48,8 +54,4 @@
 /
 !-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namcrs        !   Grid coarsening for dynamics output and/or
                !   passive tracer coarsened online simulations
@@ -93,14 +95,11 @@
 /
 !-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &nambfr        !   bottom friction
 !-----------------------------------------------------------------------
 /
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
-!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
 /
 !-----------------------------------------------------------------------
@@ -115,4 +114,9 @@
 &namtra_adv    !   advection scheme for tracer
 !-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  > 1 , 2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !-----------------------------------------------------------------------
@@ -120,11 +124,48 @@
 !-----------------------------------------------------------------------
 /
-!-----------------------------------------------------------------------
-&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
-!-----------------------------------------------------------------------
-/
 !----------------------------------------------------------------------------------
 &namtra_ldf    !   lateral diffusion scheme for tracers
 !----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant
+   !                                !   = 10 F(k)      =ldf_c1d
+   !                                !   = 20 F(i,j)    =ldf_c2d
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.true.   ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant
+   !                                !   = 10 F(k)      =ldf_c1d
+   !                                !   = 20 F(i,j)    =ldf_c2d
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
 /
 !-----------------------------------------------------------------------
@@ -139,4 +180,9 @@
 &namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
 !-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
 /
 !-----------------------------------------------------------------------
@@ -145,6 +191,31 @@
 /
 !-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts = .true.   !  Split-explicit free surface
+/
+!-----------------------------------------------------------------------
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = -30         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
 /
 !-----------------------------------------------------------------------
@@ -165,8 +236,4 @@
 /
 !-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------
@@ -185,9 +252,5 @@
 /
 !-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namobs       !  observation usage                                      ('key_diaobs')
+&namobs       !  observation usage
 !-----------------------------------------------------------------------
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm	(revision 6808)
@@ -1,1 +1,1 @@
-bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc 
+bld::tool::fppkeys key_trabbl key_lim2 key_zdftke key_zdfddm key_zdftmx  key_mpp_mpi key_iomput key_nosignedzero
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg	(revision 6808)
@@ -28,4 +28,5 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
 /
 !-----------------------------------------------------------------------
@@ -51,10 +52,4 @@
    ppacr2      =  999999.              !
    rn_rdt      = 2880.     !  time step for the dynamics (and tracer if nn_acc=0)
-   rn_rdtmin   = 14400.          !  minimum time step on tracers (used if nn_acc=1)
-   rn_rdtmax   = 14400.          !  maximum time step on tracers (used if nn_acc=1)
-/
-!-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
 /
 !-----------------------------------------------------------------------
@@ -116,8 +111,4 @@
 /
 !-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
@@ -130,4 +121,5 @@
 &nambbc        !   bottom temperature boundary condition
 !-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
 /
 !-----------------------------------------------------------------------
@@ -145,13 +137,47 @@
 /
 !-----------------------------------------------------------------------
-&namtra_adv    !   advection scheme for tracer 
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namtra_ldf    !   lateral diffusion scheme for tracers 
-!-----------------------------------------------------------------------
-
-   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
-   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (Standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (Triads   operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 1000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
 /
 !-----------------------------------------------------------------------
@@ -162,4 +188,10 @@
 &namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
 !-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+   ln_dynvor_msk = .false. !  vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes)
 /
 !-----------------------------------------------------------------------
@@ -168,10 +200,31 @@
 /
 !-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
+!-----------------------------------------------------------------------
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
-   !                       !  Type of the operator : 
-   ln_dynldf_lap    =  .false.  !  laplacian operator         
-   ln_dynldf_bilap  =  .true.   !  bilaplacian operator    
-   rn_ahm_0_blp     = -8.5e+11  !  horizontal bilaplacian eddy viscosity [m4/s] 
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .true.     !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 20          !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 8.5e+11     !  horizontal bilaplacian eddy viscosity [m4/s]
 /
 !-----------------------------------------------------------------------
@@ -193,8 +246,4 @@
 /
 !-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface 
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------
@@ -217,8 +266,4 @@
 /
 !-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namobs       !  observation usage                                      ('key_diaobs')
 !-----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_cfg	(revision 6808)
@@ -6,4 +6,8 @@
 &namrun        !   parameters of the run
 !-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "ORCA2"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =     300   !  last  time step (std 5475)
 /
 !-----------------------------------------------------------------------
@@ -24,4 +28,5 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
 /
 !-----------------------------------------------------------------------
@@ -48,8 +53,4 @@
 /
 !-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namcrs        !   Grid coarsening for dynamics output and/or
                !   passive tracer coarsened online simulations
@@ -93,14 +94,11 @@
 /
 !-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &nambfr        !   bottom friction
 !-----------------------------------------------------------------------
 /
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
-!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
 /
 !-----------------------------------------------------------------------
@@ -115,4 +113,9 @@
 &namtra_adv    !   advection scheme for tracer
 !-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  > 1 , 2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !-----------------------------------------------------------------------
@@ -123,4 +126,45 @@
 &namtra_ldf    !   lateral diffusion scheme for tracers
 !----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (Standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (Triads   operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.true.   ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
 /
 !-----------------------------------------------------------------------
@@ -135,19 +179,46 @@
 &namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
 !-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
 /
 !-----------------------------------------------------------------------
 &namdyn_hpg    !   Hydrostatic pressure gradient option
 !-----------------------------------------------------------------------
-   ln_hpg_zco  = .false.   !  z-coordinate - full steps
+   ln_hpg_sco  = .true.    !  s-coordinate (standard jacobian formulation)
    ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
-   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
-   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
-   ln_hpg_prj  = .true.    !  s-coordinate (Pressure Jacobian scheme)
-   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
-                                 !           centered      time scheme  (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
 /
 !-----------------------------------------------------------------------
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = -30         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
 /
 !-----------------------------------------------------------------------
@@ -168,8 +239,4 @@
 /
 !-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------
@@ -184,9 +251,14 @@
 /
 !-----------------------------------------------------------------------
-&namhsb       !  Heat and salt budgets
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-/
+&namhsb       !  Heat and salt budgets                                  (default F)
+!-----------------------------------------------------------------------
+   ln_diahsb  = .true.    !  check the heat and salt budgets (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage                                      ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM3/cpp_ORCA2_LIM3.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM3/cpp_ORCA2_LIM3.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM3/cpp_ORCA2_LIM3.fcm	(revision 6808)
@@ -1,1 +1,1 @@
- bld::tool::fppkeys key_trabbl key_lim3 key_vvl key_dynspg_ts key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc 
+bld::tool::fppkeys key_trabbl key_lim3 key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_asminc key_nosignedzero
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg	(revision 6808)
@@ -5,5 +5,5 @@
 !!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
 !!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
-!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
+!!              4 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide)
 !!              5 - bottom  boundary (nambfr, nambbc, nambbl)
 !!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
@@ -59,7 +59,6 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
-   ln_zco      = .false.   !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
    ln_zps      = .true.    !  z-coordinate - partial steps   (T/F)
-   ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F)
+   ln_linssh   = .true.    !  linear free surface
 /
 !-----------------------------------------------------------------------
@@ -86,11 +85,5 @@
                            !
    rn_rdt      = 2880.     !  time step for the dynamics (and tracer if nn_acc=0)
-   nn_baro     =   64      !  number of barotropic time step            ("key_dynspg_ts")
    rn_atfp     =    0.1    !  asselin time filter parameter
-   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
-                                 !                          =0, not used, rdt = rdttra
-   rn_rdtmin   = 14400.          !  minimum time step on tracers (used if nn_acc=1)
-   rn_rdtmax   = 14400.          !  maximum time step on tracers (used if nn_acc=1)
-   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nn_acc=1)
 /
 !-----------------------------------------------------------------------
@@ -297,4 +290,13 @@
    rn_alphdi   =    0.72   !  (Pyane, 1972)
 /
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.   , .false. , 'daily'  ,''         , ''
+!
+   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
+/
 
 !!======================================================================
@@ -302,6 +304,4 @@
 !!======================================================================
 !!   namlbc        lateral momentum boundary condition
-!!   namcla        cross land advection
-!!   namobc        open boundaries parameters                           ("key_obc")
 !!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
 !!   nambdy        Unstructured open boundaries                         ("key_bdy")
@@ -314,30 +314,4 @@
    rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
                            !  free slip  !   partial slip  !   no slip   ! strong slip
-/
-!-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-   nn_cla      =    0      !  advection between 2 ocean pts separates by land
-/
-!-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
-   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
-   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
-   ln_obc_fla  = .false.   !  Flather open boundary condition 
-   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
-                           !  = 1 the obc data are read in 'obc.dta' files
-   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
-                           !  set to monthly if obc datafile hold 1 month of data
-   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
-   rn_dpwin    =    1.     !     -           -         -       west    -      -
-   rn_dpnin    =    1.     !     -           -         -       north   -      -
-   rn_dpsin    =    1.     !     -           -         -       south   -      -
-   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
-   rn_dpwob    =   15.     !     -           -         -     west    -      -
-   rn_dpnob    = 3000.     !     -           -         -     north   -      -
-   rn_dpsob    =   15.     !     -           -         -     south   -      -
-   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
-                           !  = 1 the total volume remains constant
 /
 !-----------------------------------------------------------------------
@@ -394,5 +368,5 @@
 &nambdy_tide     ! tidal forcing at open boundaries              
 !-----------------------------------------------------------------------
-   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files
+    filtide       = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files
     tide_cpt(1)   ='Q1'  !  names of tidal components used
     tide_cpt(2)   ='O1'  !  names of tidal components used
@@ -485,29 +459,48 @@
 /
 !-----------------------------------------------------------------------
-&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.  !  QUCIKEST scheme                 
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !-----------------------------------------------------------------------
 &namtra_ldf    !   lateral diffusion scheme for tracer 
 !-----------------------------------------------------------------------
-   !                       !  Type of the operator : 
-   ln_traldf_lap    =  .true.   !  laplacian operator       
-   ln_traldf_bilap  =  .false.  !  bilaplacian operator     
-   !                       !  Direction of action  :
-   ln_traldf_level  =  .false.  !  iso-level                
-   ln_traldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" when ln_sco=T)
-   ln_traldf_iso    =  .true.   !  iso-neutral                          (require "key_ldfslp")
-   ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
-   ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
-   !                       !  Coefficient
-   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
-   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
-   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
+   !                       !  Operator type:
+   !                           !  no diffusion: set ln_traldf_lap=..._blp=F 
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d * ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity and grid-spacing)
+   rn_aht_0        = 1000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
 /
 !-----------------------------------------------------------------------
@@ -546,8 +539,10 @@
 &namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
 !-----------------------------------------------------------------------
-   ln_dynvor_ene = .false. !  enstrophy conserving scheme  
-   ln_dynvor_ens = .false. !  energy conserving scheme    
-   ln_dynvor_mix = .false. !  mixed scheme               
-   ln_dynvor_een = .true.  !  energy & enstrophy scheme  
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 1             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+   ln_dynvor_msk = .true.  !  vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes)
 /
 !-----------------------------------------------------------------------
@@ -559,28 +554,33 @@
    ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
    ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
-   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
-                                 !           centered      time scheme  (F)
-/
-!-----------------------------------------------------------------------
-!namdyn_spg    !   surface pressure gradient   (CPP key only)
-!-----------------------------------------------------------------------
-!                          !  explicit free surface                     ("key_dynspg_exp")
-!                          !  filtered free surface                     ("key_dynspg_flt")
-!                          !  split-explicit free surface               ("key_dynspg_ts")
-
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
 !-----------------------------------------------------------------------
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
-   !                       !  Type of the operator : 
-   ln_dynldf_lap    =  .false.  !  laplacian operator         
-   ln_dynldf_bilap  =  .true.   !  bilaplacian operator    
-   !                       !  Direction of action  : 
-   ln_dynldf_level  =  .false.  !  iso-level               
-   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
-   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .true.     !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
    !                       !  Coefficient
-   rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s]
-   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
-   rn_ahm_0_blp     = -8.5e+11  !  horizontal bilaplacian eddy viscosity [m4/s] 
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 8.5e+11     !  horizontal bilaplacian eddy viscosity [m4/s]
 /
 
@@ -700,20 +700,6 @@
 !!   nammpp_dyndist    Massively Parallel domain decomposition          ("key_agrif" && "key_mpp_dyndist")
 !!   namctl            Control prints & Benchmark
-!!   namsol            elliptic solver / island / free surface 
-!!======================================================================
-!
-!-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface 
-!-----------------------------------------------------------------------
-   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
-                           !                   =2 successive-over-relaxation (sor)
-   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
-   rn_eps      =  1.e-6    !  absolute precision of the solver
-   nn_nmin     =    300    !  minimum of iterations for the SOR solver
-   nn_nmax     =    800    !  maximum of iterations for the SOR solver
-   nn_nmod     =     10    !  frequency of test for the SOR solver
-   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
-   rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain)
-/
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
@@ -877,5 +863,4 @@
    ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
                            !     endailyavtypes   ENACT daily average types                    
-   ln_grid_global = .true.
    ln_grid_search_lookup = .false.
 / 
@@ -897,26 +882,2 @@
     salfixmin = -9999      !  Minimum salinity after applying the increments
 /
-!-----------------------------------------------------------------------
-&namsbc_wave   ! External fields from wave model
-!-----------------------------------------------------------------------
-!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
-!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
-   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.   , .false. , 'daily'  ,''         , ''
-!
-   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
-/
-!-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model
-   ln_neptsimp       = .false.  ! yes/no use simplified neptune
-
-   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep
-   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator
-   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole
-   ! Specify whether to ramp down the Neptune velocity in shallow
-   ! water, and if so the depth range controlling such ramping down
-   ln_neptramp       = .true.   ! ramp down Neptune velocity in shallow water
-   rn_htrmin         =  100.0   ! min. depth of transition range
-   rn_htrmax         =  200.0   ! max. depth of transition range
-/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_top_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_top_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_top_cfg	(revision 6808)
@@ -39,10 +39,9 @@
 &namtrc_adv    !   advection scheme for passive tracer 
 !-----------------------------------------------------------------------
-   ln_trcadv_cen2   =  .false.  !  2nd order centered scheme   
-   ln_trcadv_tvd    =  .true.  !  TVD scheme
-   ln_trcadv_muscl  =  .false.   !  MUSCL scheme
-   ln_trcadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries
-   ln_trcadv_ubs    =  .false.  !  UBS scheme
-   ln_trcadv_qck    =  .false.  !  QUICKEST scheme
+   ln_trcadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !-----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg	(revision 6808)
@@ -31,4 +31,6 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
+   ln_linssh   = .true.    !  linear free surface
 /
 !-----------------------------------------------------------------------
@@ -132,12 +134,4 @@
 /
 !-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
@@ -164,6 +158,7 @@
 /
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
+&nambbc        !   bottom temperature boundary condition                (default: NO)
 !----------------------------------------------------------------------- 
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
 /
 !-----------------------------------------------------------------------
@@ -176,10 +171,57 @@
 /
 !-----------------------------------------------------------------------
-&namtra_adv    !   advection scheme for tracer 
-!-----------------------------------------------------------------------     
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !----------------------------------------------------------------------------------
 &namtra_ldf    !   lateral diffusion scheme for tracers
 !----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   !                           !  no diffusion: set ln_traldf_lap=..._blp=F 
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d * ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity and grid-spacing)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.true.    ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.false.   ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.    ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 21       ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
 /
 !-----------------------------------------------------------------------
@@ -188,14 +230,19 @@
 /
 !-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
 &namdyn_adv    !   formulation of the momentum advection
 !-----------------------------------------------------------------------
 /  
 !-----------------------------------------------------------------------
-&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
 !-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 1             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
 /
 !-----------------------------------------------------------------------
@@ -209,4 +256,24 @@
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------      
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = -30         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
 /
 !-----------------------------------------------------------------------
@@ -221,8 +288,4 @@
 &namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
 !-----------------------------------------------------------------------
-/
-!------------------------------------------------------------------------
-&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
-!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
 /
 !-----------------------------------------------------------------------
@@ -291,6 +354,2 @@
 !-----------------------------------------------------------------------
 /
-!-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_top_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_top_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_top_cfg	(revision 6808)
@@ -24,6 +24,9 @@
 &namtrc_adv    !   advection scheme for passive tracer 
 !-----------------------------------------------------------------------   
-   ln_trcadv_tvd     =  .true.   !  TVD scheme
-   ln_trcadv_muscl   =  .false.  !  MUSCL scheme
+   ln_trcadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !-----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/cpp_ORCA2_LIM_CFC_C14b.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/cpp_ORCA2_LIM_CFC_C14b.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/cpp_ORCA2_LIM_CFC_C14b.fcm	(revision 6808)
@@ -1,1 +1,1 @@
-bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi
+bld::tool::fppkeys key_trabbl key_lim2 key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_cfg	(revision 6808)
@@ -24,4 +24,6 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
+   ln_linssh   = .true.    !  linear free surface
 /
 !-----------------------------------------------------------------------
@@ -48,8 +50,4 @@
 /
 !-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &namcrs        !   Grid coarsening for dynamics output and/or
                !   passive tracer coarsened online simulations
@@ -93,14 +91,11 @@
 /
 !-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &nambfr        !   bottom friction
 !-----------------------------------------------------------------------
 /
 !-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
-!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
 /
 !-----------------------------------------------------------------------
@@ -115,4 +110,9 @@
 &namtra_adv    !   advection scheme for tracer
 !-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  > 1 , 2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
 /
 !-----------------------------------------------------------------------
@@ -120,11 +120,48 @@
 !-----------------------------------------------------------------------
 /
-!-----------------------------------------------------------------------
-&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
-!-----------------------------------------------------------------------
-/
 !----------------------------------------------------------------------------------
 &namtra_ldf    !   lateral diffusion scheme for tracers
 !----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant
+   !                                !   = 10 F(k)      =ldf_c1d
+   !                                !   = 20 F(i,j)    =ldf_c2d
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.true.   ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant
+   !                                !   = 10 F(k)      =ldf_c1d
+   !                                !   = 20 F(i,j)    =ldf_c2d
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
 /
 !-----------------------------------------------------------------------
@@ -139,4 +176,9 @@
 &namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
 !-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
 /
 !-----------------------------------------------------------------------
@@ -145,6 +187,31 @@
 /
 !-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
+!-----------------------------------------------------------------------
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = -30         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
 /
 !-----------------------------------------------------------------------
@@ -165,8 +232,4 @@
 /
 !-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------
@@ -184,6 +247,2 @@
 !-----------------------------------------------------------------------
 /
-!-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top_cfg	(revision 6808)
@@ -62,6 +62,6 @@
 &namtrc_adv    !   advection scheme for passive tracer 
 !-----------------------------------------------------------------------
-   ln_trcadv_tvd     =  .false.  !  TVD scheme
-   ln_trcadv_muscl   =  .true.   !  MUSCL scheme
+   ln_trcadv_mus =  .true.  !  MUSCL scheme
+      ln_mus_ups =  .false.         !  use upstream scheme near river mouths
 /
 !-----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/cpp_ORCA2_LIM_PISCES.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/cpp_ORCA2_LIM_PISCES.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/cpp_ORCA2_LIM_PISCES.fcm	(revision 6808)
@@ -1,1 +1,1 @@
-bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_iomput key_mpp_mpi
+bld::tool::fppkeys key_trabbl key_lim2 key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_mpp_mpi key_iomput
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg	(revision 6808)
@@ -27,4 +27,6 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
+   ln_linssh   = .true.    !  linear free surface
 /
 !-----------------------------------------------------------------------
@@ -32,7 +34,5 @@
 !-----------------------------------------------------------------------
    nn_msh      =    1      !  create (=1) a mesh file or not (=0)
-   rn_rdt      = 21600.    !  time step for the dynamics (and tracer if nn_acc=0)
-   rn_rdtmin   = 21600.          !  minimum time step on tracers (used if nn_acc=1)
-   rn_rdtmax   = 21600.          !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdt      = 21600.    !  time step for the dynamics 
    jphgr_msh   =       0               !  type of horizontal mesh
    ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
@@ -68,9 +68,9 @@
    nn_fsbc     = 1         !  frequency of surface boundary condition computation 
    ln_rnf      = .false.   !  runoffs
+   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
 /  
 !-----------------------------------------------------------------------
 &namtra_qsr    !   penetrative solar radiation
 !-----------------------------------------------------------------------
-   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
 /
 !-----------------------------------------------------------------------
@@ -78,9 +78,4 @@
 !-----------------------------------------------------------------------
 /      
-
-!-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
 !-----------------------------------------------------------------------
 &nambbl        !   bottom boundary layer scheme
@@ -91,8 +86,48 @@
 !-----------------------------------------------------------------------
 /
-!-----------------------------------------------------------------------
-&namtra_ldf    !   lateral diffusion scheme for tracer 
-!-----------------------------------------------------------------------
-   ln_triad_iso     =  .true.  !  griffies operator calculates triads twice => pure lateral mixing in ML (require "key_ldfslp")
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral
+   ln_traldf_triad =  .false.  !  iso-neutral using Griffies triads
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML     (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom         (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.false.   ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 0      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant
+   !                                !   = 10 F(k)      =ldf_c1d
+   !                                !   = 20 F(i,j)    =ldf_c2d
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
 /
 !-----------------------------------------------------------------------
@@ -115,13 +150,6 @@
    sn_ubl  = 'dyna_grid_U' ,    120            , 'sobblcox' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
    sn_vbl  = 'dyna_grid_V' ,    120            , 'sobblcoy' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
-   sn_ahu  = 'dyna_grid_U' ,    120            , 'vozoahtu' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
-   sn_ahv  = 'dyna_grid_V' ,    120            , 'vomeahtv' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
-   sn_ahw  = 'dyna_grid_W' ,    120            , 'voveahtz' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
-   sn_eiu  = 'dyna_grid_U' ,    120            , 'vozoaeiu' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
-   sn_eiv  = 'dyna_grid_V' ,    120            , 'vomeaeiv' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
-   sn_eiw  = 'dyna_grid_W' ,    120            , 'soleaeiw' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
 !
    cn_dir      = './'      !  root directory for the location of the dynamical files
-   ln_degrad   =  .false.  !  flag for degradation -                requires ("key_degrad")
    ln_dynwzv   =  .true.   !  computation of vertical velocity instead of using the one read in file
    ln_dynbbl   =  .true.   !  bbl coef are in files, so read them - requires ("key_trabbl")
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg	(revision 6808)
@@ -65,6 +65,6 @@
 &namtrc_adv    !   advection scheme for passive tracer 
 !-----------------------------------------------------------------------
-   ln_trcadv_tvd     =  .false.  !  TVD scheme
-   ln_trcadv_muscl   =  .true.   !  MUSCL scheme
+   ln_trcadv_mus =  .true.  !  MUSCL scheme
+      ln_mus_ups =  .false.         !  use upstream scheme near river mouths
 /
 !-----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm	(revision 6808)
@@ -1,1 +1,1 @@
-bld::tool::fppkeys key_trabbl key_ldfslp key_traldf_c2d key_traldf_eiv key_top key_offline key_pisces key_iomput key_mpp_mpi
+bld::tool::fppkeys key_trabbl key_top key_offline key_pisces key_iomput key_mpp_mpi
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/namelist_cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/namelist_cfg	(revision 6808)
@@ -26,4 +26,6 @@
 &namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
+   ln_zco      = .true.    !  z-coordinate - full    steps
+   ln_linssh   = .true.    !  linear free surface
 /
 !-----------------------------------------------------------------------
@@ -48,8 +50,4 @@
    ppkth2      =  999999.              !
    ppacr2      =  999999.              !
-/
-!-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
 /
 !-----------------------------------------------------------------------
@@ -87,8 +85,4 @@
 /
 !-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_SAS_LIM/cpp_ORCA2_SAS_LIM.fcm
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_SAS_LIM/cpp_ORCA2_SAS_LIM.fcm	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/ORCA2_SAS_LIM/cpp_ORCA2_SAS_LIM.fcm	(revision 6808)
@@ -1,1 +1,1 @@
- bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi
+ bld::tool::fppkeys key_trabbl key_lim2  key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/SHARED/domain_def.xml
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/SHARED/domain_def.xml	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/SHARED/domain_def.xml	(revision 6808)
@@ -163,4 +163,5 @@
 
       <domain id="grid_V" long_name="grid V"/>
+      
       <domain_group id="grid_W">
          <domain id="grid_W" long_name="grid W"/>
@@ -168,4 +169,6 @@
          <domain id="EqW" zoom_ibegin="1" zoom_jbegin="0000" zoom_ni="0000" zoom_nj="1" />
       </domain_group>
+
+      <domain id="grid_F" long_name="grid F"/>
 
       <domain_group id="scalarpoint"> 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/SHARED/field_def.xml
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/SHARED/field_def.xml	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/SHARED/field_def.xml	(revision 6808)
@@ -25,7 +25,11 @@
 
          <field id="toce"         long_name="temperature"         standard_name="sea_water_potential_temperature"   unit="degC"     grid_ref="grid_T_3D"/>
-         <field id="toce_e3t"     long_name="temperature * e3t"                                                     unit="degC*m"   grid_ref="grid_T_3D" > toce * e3t </field >
+         <field id="toce_e3t"     long_name="temperature (thickness weighted)"                                      unit="degC"     grid_ref="grid_T_3D" > toce * e3t </field >
          <field id="soce"         long_name="salinity"            standard_name="sea_water_practical_salinity"      unit="1e-3"     grid_ref="grid_T_3D"/>
-         <field id="soce_e3t"     long_name="salinity * e3t"                                                        unit="1e-3*m"   grid_ref="grid_T_3D" > soce * e3t </field >
+         <field id="soce_e3t"     long_name="salinity    (thickness weighted)"                                      unit="1e-3"     grid_ref="grid_T_3D" > soce * e3t </field >
+
+	      <!-- t-eddy viscosity coefficients (ldfdyn) -->
+	      <field id="ahmt_2d"      long_name=" surface t-eddy viscosity coefficient"   unit="m2/s or m4/s" />
+	      <field id="ahmt_3d"      long_name=" 3D      t-eddy viscosity coefficient"   unit="m2/s or m4/s"                           grid_ref="grid_T_3D"/>
 
          <field id="sst"          long_name="sea surface temperature"             standard_name="sea_surface_temperature"             unit="degC"     />
@@ -36,5 +40,8 @@
          <field id="sstgrad2"     long_name="square of module of sst gradient"                                                        unit="degC2/m2" />
          <field id="sbt"          long_name="sea bottom temperature"                                                                  unit="degC"     />
-	 
+         <field id="sst_wl"       long_name="Delta SST of warm layer"                                                                 unit="degC"     />
+         <field id="sst_cs"       long_name="Delta SST of cool skin"                                                                  unit="degC"     />
+	 <field id="temp_3m"      long_name="temperature at 3m"                                                                       unit="degC"     />
+         
          <field id="sss"          long_name="sea surface salinity"             standard_name="sea_surface_salinity"   unit="1e-3" />
          <field id="sss2"         long_name="square of sea surface salinity"                                          unit="1e-6"  > sss * sss </field >
@@ -193,10 +200,16 @@
 
          <!-- * variable related to ice shelf forcing * -->
-         <field id="fwfisf"       long_name="Ice shelf melting"                             unit="kg/m2/s"  />
-         <field id="qisf"         long_name="Ice Shelf Heat Flux"                           unit="W/m2"     />
-         <field id="isfgammat"    long_name="transfert coefficient for isf (temperature)"   unit="m/s"      />
-         <field id="isfgammas"    long_name="transfert coefficient for isf (salinity)"      unit="m/s"      />
-         <field id="stbl"         long_name="salinity in the Losh tbl"                      unit="1e-3"     />
-         <field id="ttbl"         long_name="temperature in the Losh tbl"                   unit="degC"     />
+         <field id="fwfisf"       long_name="Ice shelf melting"                                            unit="Kg/m2/s"  />
+         <field id="qisf"         long_name="Ice Shelf Heat Flux"                                          unit="W/m2"     />
+         <field id="isfgammat"    long_name="transfert coefficient for isf (temperature) "                 unit="m/s"      />
+         <field id="isfgammas"    long_name="transfert coefficient for isf (salinity)    "                 unit="m/s"      />
+ 	 <field id="stbl"         long_name="salinity in the Losh tbl                    "                 unit="PSU"      />
+	 <field id="ttbl"         long_name="temperature in the Losh tbl                 "                 unit="C"        />
+	 <field id="utbl"         long_name="zonal current in the Losh tbl at T point    "                 unit="m/s"      />
+	 <field id="vtbl"         long_name="merid current in the Losh tbl at T point    "                 unit="m/s"      />
+	 <field id="thermald"     long_name="thermal driving of ice shelf melting        "                 unit="C"        />
+	 <field id="tfrz"         long_name="top freezing point (used to compute melt)   "                 unit="C"        />
+	 <field id="tinsitu"      long_name="top insitu temperature (used to cmpt melt)  "                 unit="C"        />
+	 <field id="ustar"        long_name="ustar at T point used in ice shelf melting  "                 unit="m/s"      />
 
          <!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
@@ -367,5 +380,5 @@
          <field id="utau"         long_name="Wind Stress along i-axis"                               standard_name="surface_downward_x_stress"   unit="N/m2"                            />
          <field id="uoce"         long_name="ocean current along i-axis"                             standard_name="sea_water_x_velocity"        unit="m/s"        grid_ref="grid_U_3D" />
-         <field id="uoce_e3u"     long_name="ocean current along i-axis * e3u"                                                                   unit="m2/s"       grid_ref="grid_U_3D"  > uoce * e3u </field>
+         <field id="uoce_e3u"     long_name="ocean current along i-axis  (thickness weighted)"                                                   unit="m/s"        grid_ref="grid_U_3D"  > uoce * e3u </field>
          <field id="ssu"          long_name="ocean surface current along i-axis"                                                                 unit="m/s"                             />
          <field id="sbu"          long_name="ocean bottom current along i-axis"                                                                  unit="m/s"                             />
@@ -375,8 +388,14 @@
          <field id="uoces"        long_name="ocean transport along i-axis times salinity (CRS)"                                                  unit="1e-3*m/s"   grid_ref="grid_U_3D" />
 
+	      <!-- u-eddy coefficients (ldftra) -->
+	      <field id="ahtu_2d"      long_name=" surface u-eddy diffusivity coefficient"   unit="m2/s or m4/s" />
+	      <field id="ahtu_3d"      long_name=" 3D u-EIV coefficient"                     unit="m2/s or m4/s"      grid_ref="grid_U_3D"/>
+	      <field id="aeiu_2d"      long_name=" surface u-EIV coefficient"                unit="m2/s" />
+	      <field id="aeiu_3d"      long_name=" 3D u-EIV coefficient"                     unit="m2/s"              grid_ref="grid_U_3D"/>
+
          <!-- variables available with MLE -->
          <field id="psiu_mle"     long_name="MLE streamfunction along i-axis"   unit="m3/s"   grid_ref="grid_U_3D" />
 
-         <!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
+         <!-- uoce_eiv: available EIV -->
          <field id="uoce_eiv"     long_name="EIV ocean current along i-axis"   standard_name="bolus_sea_water_x_velocity"   unit="m/s"   grid_ref="grid_U_3D" />
 
@@ -402,5 +421,5 @@
          <field id="vtau"         long_name="Wind Stress along j-axis"                               standard_name="surface_downward_y_stress"   unit="N/m2"                            />
          <field id="voce"         long_name="ocean current along j-axis"                             standard_name="sea_water_y_velocity"        unit="m/s"        grid_ref="grid_V_3D" />
-         <field id="voce_e3v"     long_name="ocean current along j-axis * e3v"                                                                   unit="m2/s"       grid_ref="grid_V_3D"  > voce * e3v </field>
+         <field id="voce_e3v"     long_name="ocean current along j-axis  (thickness weighted)"                                                   unit="m/s"        grid_ref="grid_V_3D"  > voce * e3v </field>
          <field id="ssv"          long_name="ocean surface current along j-axis"                                                                 unit="m/s"                             />
          <field id="sbv"          long_name="ocean bottom current along j-axis"                                                                  unit="m/s"                             />
@@ -410,8 +429,14 @@
          <field id="voces"        long_name="ocean transport along j-axis times salinity (CRS)"                                                  unit="1e-3*m/s"   grid_ref="grid_V_3D" />
 
+	      <!-- v-eddy coefficients (ldftra, ldfdyn) -->
+	      <field id="ahtv_2d"      long_name=" surface v-eddy diffusivity coefficient"     unit="m2/s or (m4/s)^1/2" />
+	      <field id="ahtv_3d"      long_name=" 3D v-eddy diffusivity coefficient"          unit="m2/s or (m4/s)^1/2"           grid_ref="grid_V_3D"/>
+	      <field id="aeiv_2d"      long_name=" surface v-EIV coefficient"                  unit="m2/s" />
+	      <field id="aeiv_3d"      long_name=" 3D v-EIV coefficient"                       unit="m2/s"                         grid_ref="grid_V_3D" />
+
          <!-- variables available with MLE -->
          <field id="psiv_mle"     long_name="MLE streamfunction along j-axis"   unit="m3/s"   grid_ref="grid_V_3D" />
 
-         <!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
+         <!-- voce_eiv: available with EIV -->
          <field id="voce_eiv"     long_name="EIV ocean current along j-axis"   standard_name="bolus_sea_water_y_velocity"   unit="m/s"   grid_ref="grid_V_3D" />
 
@@ -438,5 +463,5 @@
         <field id="wocetr_eff"   long_name="effective ocean vertical transport"                                               unit="m3/s" />
 
-        <!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
+        <!-- woce_eiv: available with EIV -->
         <field id="woce_eiv"     long_name="EIV ocean vertical velocity"   standard_name="bolus_upward_sea_water_velocity"   unit="m/s" />
 
@@ -449,6 +474,6 @@
 
         <!-- avt_evd and avm_evd: available with ln_zdfevd -->
-        <field id="avt_evd"      long_name="convective enhancement to vertical diffusivity"   standard_name="ocean_vertical_tracer_diffusivity_due_to_convection"     unit="m2/s" />
-        <field id="avm_evd"      long_name="convective enhancement to vertical viscosity"     standard_name="ocean_vertical_momentum_diffusivity_due_to_convection"   unit="m2/s" />
+        <field id="avt_evd"      long_name="convective enhancement of vertical diffusivity"   standard_name="ocean_vertical_tracer_diffusivity_due_to_convection"     unit="m2/s" />
+        <field id="avm_evd"      long_name="convective enhancement of vertical viscosity"     standard_name="ocean_vertical_momentum_diffusivity_due_to_convection"   unit="m2/s" />
 
         <!-- avt_tide: available with key_zdftmx -->
@@ -459,9 +484,14 @@
         <field id="w_masstr2"    long_name="square of vertical mass transport"   standard_name="square_of_upward_ocean_mass_transport"   unit="kg2/s2" />
 
-        <!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
+        <!-- aht2d and  aht2d_eiv -->
         <field id="aht2d"        long_name="lateral eddy diffusivity"       standard_name="ocean_tracer_xy_laplacian_diffusivity"      unit="m2/s"   grid_ref="grid_W_2D" />
         <field id="aht2d_eiv"    long_name="EIV lateral eddy diffusivity"   standard_name="ocean_tracer_bolus_laplacian_diffusivity"   unit="m2/s"   grid_ref="grid_W_2D" />
       </field_group>
-          
+        
+      <!-- F grid -->
+	      <!-- f-eddy viscosity coefficients (ldfdyn) -->
+	      <field id="ahmf_2d"      long_name=" surface f-eddy viscosity coefficient"   unit="m2/s or m4/s" />
+	      <field id="ahmf_3d"      long_name=" 3D      f-eddy viscosity coefficient"   unit="m2/s or m4/s"                           grid_ref="grid_T_3D"/>
+
       <!-- scalar variables available with key_diaar5 -->
 
@@ -1018,5 +1048,52 @@
       <field field_ref="woce"         name="wo"       long_name="ocean vertical velocity"  />
     </field_group>
-    
+
+       <!-- TMB diagnostic output -->
+    <field_group  id="1h_grid_T_tmb" grid_ref="grid_T_2D" operation="instant">
+     <field id="top_temp"           name="votemper_top"  unit="degC"  />
+     <field id="mid_temp"           name="votemper_mid"  unit="degC"  />
+     <field id="bot_temp"           name="votemper_bot"  unit="degC"  />
+     <field id="top_sal"            name="vosaline_top"  unit="psu"   />
+     <field id="mid_sal"            name="vosaline_mid"  unit="psu"   />
+     <field id="bot_sal"            name="vosaline_bot"  unit="psu"   />
+     <field id="sshnmasked"         name="sossheig"      unit="m"     /> 
+   </field_group>
+    <field_group  id="1h_grid_U_tmb" grid_ref="grid_U_2D" operation="instant">
+     <field id="top_u"           name="vozocrtx_top"  unit="m/s"  />
+     <field id="mid_u"           name="vozocrtx_mid"  unit="m/s"  />
+     <field id="bot_u"           name="vozocrtx_bot"  unit="m/s"  />
+     <field id="baro_u"          name="vobtcrtx"      unit="m/s"  />
+   </field_group>
+    <field_group  id="1h_grid_V_tmb" grid_ref="grid_V_2D" operation="instant">
+     <field id="top_v"           name="vomecrty_top"  unit="m/s"  />
+     <field id="mid_v"           name="vomecrty_mid"  unit="m/s"  />
+     <field id="bot_v"           name="vomecrty_bot"  unit="m/s"  />
+     <field id="baro_v"          name="vobtcrty"      unit="m/s"  />
+   </field_group>
+       <!-- 25h diagnostic output -->
+      <field_group id="25h_grid_T" grid_ref="grid_T_3D" operation="instant">
+   <field id="temper25h"         name="potential temperature 25h mean"    unit="degC" />
+   <field id="tempis25h"         name="insitu temperature 25h mean"    unit="degC" />
+   <field id="salin25h"          name="salinity 25h mean"                 unit="psu"  />
+   <field id="ssh25h"            name="sea surface height 25h mean"  grid_ref="grid_T_2D"      unit="m"    />
+      </field_group>
+
+      <field_group id="25h_grid_U" grid_ref="grid_U_3D" operation="instant" >
+   <field id="vozocrtx25h"         name="i current 25h mean"    unit="m/s"   />
+      </field_group>
+
+      <field_group id="25h_grid_V" grid_ref="grid_V_3D" operation="instant">
+   <field id="vomecrty25h"         name="j current 25h mean"    unit="m/s"    />
+      </field_group>
+
+      <field_group id="25h_grid_W" grid_ref="grid_W_3D" operation="instant">
+   <field id="vomecrtz25h"         name="k current 25h mean"                 unit="m/s"      />
+   <field id="avt25h"             name="vertical diffusivity25h mean"       unit="m2/s" />
+   <field id="avm25h"              name="vertical viscosity 25h mean"        unit="m2/s" />
+   <field id="tke25h"              name="turbulent kinetic energy 25h mean" />
+   <field id="mxln25h"             name="mixing length 25h mean"             unit="m" />
+      </field_group>
+
+
 
    </field_definition>
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/SHARED/namelist_ref
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/SHARED/namelist_ref	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/SHARED/namelist_ref	(revision 6808)
@@ -1,2 +1,4 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!!                            namelist_ref
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !! NEMO/OPA  :  1 - run manager      (namrun)
@@ -4,12 +6,12 @@
 !!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core, namsbc_sas
 !!                                    namsbc_cpl, namtra_qsr, namsbc_rnf,
-!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
-!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb, namsbc_wave)
+!!              4 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide)
 !!              5 - bottom  boundary (nambfr, nambbc, nambbl)
-!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
+!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_ldfeiv, namtra_dmp)
 !!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
-!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
+!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_ddm, namzdf_tmx)
 !!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namhsb, namsto)
-!!             10 - miscellaneous    (namsol, nammpp, namctl)
+!!             10 - miscellaneous    (nammpp, namctl)
 !!             11 - Obs & Assim      (namobs, nam_asminc)
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -29,15 +31,17 @@
    nn_itend    =    5475   !  last  time step (std 5475)
    nn_date0    =  010101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
+   nn_time0    =       0   !  initial time of day in hhmm
    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
-                           !    = 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_euler    =    1            !  = 0 : start with forward time step 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
+   ln_iscpl    = .false.   !  cavity evolution forcing or coupling to ice sheet model
    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)
@@ -45,8 +49,7 @@
    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
+   ln_clobber  = .true.    !  clobber (overwrite) an existing file
    nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
 /
@@ -59,41 +62,46 @@
 !!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
 !!   namdom       space and time domain (bathymetry, mesh, timestep)
+!!   namcrs       coarsened grid (for outputs and/or TOP)               ("key_crs")
+!!   namc1d       1D configuration options                              ("key_c1d")
+!!   namc1d_uvd   1D data (currents)                                    ("key_c1d")
+!!   namc1d_dyndmp 1D newtonian damping applied on currents             ("key_c1d")
 !!   namtsd       data: temperature & salinity
 !!======================================================================
 !
 !-----------------------------------------------------------------------
-&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
-/
-!-----------------------------------------------------------------------
-&namzgr        !   vertical coordinate
-!-----------------------------------------------------------------------
-   ln_zco      = .false.   !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
-   ln_zps      = .true.    !  z-coordinate - partial steps   (T/F)
-   ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F)
-   ln_isfcav   = .false.   !  ice shelf cavity               (T/F)
+&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
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate                                  (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_zco      = .false.   !  z-coordinate - full    steps
+   ln_zps      = .false.   !  z-coordinate - partial steps
+   ln_sco      = .false.   !  s- or hybrid z-s-coordinate
+   ln_isfcav   = .false.   !  ice shelf cavity
+   ln_linssh   = .false.   !  linear free surface
 /
 !-----------------------------------------------------------------------
 &namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
 !-----------------------------------------------------------------------
-   ln_s_sh94   = .true.    !  Song & Haidvogel 1994 hybrid S-sigma   (T)|
+   ln_s_sh94   = .false.    !  Song & Haidvogel 1994 hybrid S-sigma   (T)|
    ln_s_sf12   = .false.   !  Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied
    ln_sigcrit  = .false.   !  use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
@@ -125,4 +133,5 @@
    nn_msh      =    1      !  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_isfhmin  =    1.00   !  treshold (m) to discriminate grounding ice to floating ice
    rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
    rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
@@ -130,9 +139,4 @@
    rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nn_acc=0)
    rn_atfp     =    0.1    !  asselin time filter parameter
-   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
-                                 !                          =0, not used, rdt = rdttra
-   rn_rdtmin   = 28800.          !  minimum time step on tracers (used if nn_acc=1)
-   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
@@ -161,21 +165,5 @@
 /
 !-----------------------------------------------------------------------
-&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
-!-----------------------------------------------------------------------
-   ln_bt_fw      =    .TRUE.           !  Forward integration of barotropic equations
-   ln_bt_av      =    .TRUE.           !  Time filtering of barotropic variables
-   ln_bt_nn_auto =    .TRUE.           !  Set nn_baro automatically to be just below
-                                       !  a user defined maximum courant number (rn_bt_cmax)
-   nn_baro       =    30               !  Number of iterations of barotropic mode
-                                       !  during rn_rdt seconds. Only used if ln_bt_nn_auto=F
-   rn_bt_cmax    =    0.8              !  Maximum courant number allowed if ln_bt_nn_auto=T
-   nn_bt_flt     =    1                !  Time filter choice
-                                       !  = 0 None
-                                       !  = 1 Boxcar over   nn_baro barotropic steps
-                                       !  = 2 Boxcar over 2*nn_baro     "        "
-/
-!-----------------------------------------------------------------------
-&namcrs        !   Grid coarsening for dynamics output and/or
-               !   passive tracer coarsened online simulations
+&namcrs        !   coarsened grid (for outputs and/or TOP)              ("key_crs")
 !-----------------------------------------------------------------------
    nn_factx    = 3         !  Reduction factor of x-direction
@@ -199,6 +187,22 @@
 /
 !-----------------------------------------------------------------------
+&namc1d_dyndmp !   U & V newtonian damping                              ("key_c1d")
+!-----------------------------------------------------------------------
+   ln_dyndmp   =  .false.  !  add a damping term (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&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)
+/
+!-----------------------------------------------------------------------
 &namtsd    !   data : Temperature  & Salinity
-!-----------------------------------------------------------------------
 !-----------------------------------------------------------------------
 !          !  file name                            ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
@@ -211,21 +215,25 @@
    ln_tsd_tradmp = .true.   !  damping of ocean T & S toward T &S input data (T) or not (F)
 /
+
 !!======================================================================
 !!            ***  Surface Boundary Condition namelists  ***
 !!======================================================================
 !!   namsbc          surface boundary condition
-!!   namsbc_ana      analytical         formulation
-!!   namsbc_flx      flux               formulation
-!!   namsbc_clio     CLIO bulk formulae formulation
-!!   namsbc_core     CORE bulk formulae formulation
-!!   namsbc_mfs      MFS  bulk formulae formulation
-!!   namsbc_cpl      CouPLed            formulation                     ("key_oasis3")
+!!   namsbc_ana      analytical         formulation                     (ln_ana     =T)
+!!   namsbc_flx      flux               formulation                     (ln_flx     =T)
+!!   namsbc_clio     CLIO bulk formulae formulation                     (ln_blk_clio=T)
+!!   namsbc_core     CORE bulk formulae formulation                     (ln_blk_core=T)
+!!   namsbc_mfs      MFS  bulk formulae formulation                     (ln_blk_mfs =T)
+!!   namsbc_cpl      CouPLed            formulation                     ("key_oasis3" )
 !!   namsbc_sas      StAndalone Surface module
-!!   namtra_qsr      penetrative solar radiation
-!!   namsbc_rnf      river runoffs
-!!   namsbc_isf      ice shelf melting/freezing
-!!   namsbc_apr      Atmospheric Pressure
-!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namtra_qsr      penetrative solar radiation                        (ln_traqsr  =T)
+!!   namsbc_rnf      river runoffs                                      (ln_rnf     =T)
+!!   namsbc_isf      ice shelf melting/freezing                         (nn_isf     >0)
+!!   namsbc_iscpl    coupling option between land ice model and ocean
+!!   namsbc_apr      Atmospheric Pressure                               (ln_apr_dyn =T)
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)        (ln_ssr     =T)
 !!   namsbc_alb      albedo parameters
+!!   namsbc_wave     external fields from wave model                    (ln_wave    =T)
+!!   namberg         iceberg floats                                     (ln_icebergs=T)
 !!======================================================================
 !
@@ -234,5 +242,6 @@
 !-----------------------------------------------------------------------
    nn_fsbc     = 5         !  frequency of surface boundary condition computation
-                           !     (also = the frequency of sea-ice model call)
+                           !     (also = the frequency of sea-ice & iceberg model call)
+                     ! Type of air-sea fluxes 
    ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana )
    ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
@@ -240,4 +249,5 @@
    ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core)
    ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs )
+                     ! Type of coupling (Ocean/Ice/Atmosphere) :
    ln_cpl      = .false.   !  atmosphere coupled   formulation          ( requires key_oasis3 )
    ln_mixcpl   = .false.   !  forced-coupled mixed formulation          ( requires key_oasis3 )
@@ -246,27 +256,4 @@
                            !  =1 opa-sas OASIS coupling: multi executable configuration, OPA component
                            !  =2 opa-sas OASIS coupling: multi executable configuration, SAS component 
-   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)
-                           !  =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)
-   nn_isf      = 0         !  ice shelf melting/freezing                (/=0 => fill namsbc_isf)
-                           !  0 =no isf                  1 = presence of ISF
-                           !  2 = bg03 parametrisation   3 = rnf file for isf
-                           !  4 = ISF fwf specified
-                           !  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
-                           !     =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
-   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
@@ -274,4 +261,24 @@
                            !  = 1  Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled
                            !  = 2  Redistribute a single flux over categories (coupled mode only)
+                     ! Sea-ice :
+   nn_ice      = 2         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3", "key_lim2", "key_cice")
+   nn_ice_embd = 1         !  =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)
+                     ! Misc. options of sbc : 
+   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr )
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 2         !  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
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   ln_isf      = .false.   !  ice shelf                                 (T   => fill namsbc_isf)
+   ln_wave = .false.       !  coupling with surface wave                (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)
 /
 !-----------------------------------------------------------------------
@@ -316,20 +323,20 @@
 &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_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'  , ''       , ''
 
    cn_dir      = './'      !  root directory for the location of the bulk files
    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_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.)
@@ -340,13 +347,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' , ''       , ''
+!              !  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
@@ -355,23 +362,23 @@
 &namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
 !-----------------------------------------------------------------------
-!                    !     description       !  multiple  !    vector   !      vector          ! vector !
-!                    !                       ! categories !  reference  !    orientation       ! grids  !
+!                    !     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'    ,     ''      ,         ''          ,   ''
+   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
@@ -397,5 +404,5 @@
 /
 !-----------------------------------------------------------------------
-&namtra_qsr    !   penetrative solar radiation
+&namtra_qsr    !   penetrative solar radiation                          (ln_traqsr=T)
 !-----------------------------------------------------------------------
 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
@@ -404,5 +411,4 @@
 
    cn_dir      = './'      !  root directory for the location of the runoff files
-   ln_traqsr   = .true.    !  Light penetration (T) or not (F)
    ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
    ln_qsr_2bd  = .false.   !  2 bands              light penetration
@@ -415,5 +421,5 @@
 /
 !-----------------------------------------------------------------------
-&namsbc_rnf    !   runoffs namelist surface boundary condition
+&namsbc_rnf    !   runoffs namelist surface boundary condition          (ln_rnf=T)
 !-----------------------------------------------------------------------
 !              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
@@ -439,39 +445,49 @@
 /
 !-----------------------------------------------------------------------
-&namsbc_isf    !  Top boundary layer (ISF)
-!-----------------------------------------------------------------------
-!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+&namsbc_isf    !  Top boundary layer (ISF)                              (nn_isf >0)
+!-----------------------------------------------------------------------
+!              ! 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      !
 ! nn_isf == 4
-   sn_qisf      = 'rnfisf' ,         -12      ,'sohflisf',    .false.      , .true.  , 'yearly'  ,  ''      ,   ''
-   sn_fwfisf    = 'rnfisf' ,         -12      ,'sowflisf',    .false.      , .true.  , 'yearly'  ,  ''      ,   ''
+   sn_fwfisf   = 'rnfisf'  ,         -12       ,'sowflisf',   .false.    , .true.  , 'yearly'  ,  ''      ,   ''     , ''
 ! nn_isf == 3
-   sn_rnfisf    = 'runoffs' ,         -12      ,'sofwfisf',    .false.      , .true.  , 'yearly'  ,  ''      ,   ''
+   sn_rnfisf   = 'rnfisf'  ,         -12       ,'sofwfisf',   .false.    , .true.  , 'yearly'  ,  ''      ,   ''     , ''
 ! nn_isf == 2 and 3
-   sn_depmax_isf = 'runoffs' ,       -12        ,'sozisfmax' ,   .false.  , .true.  , 'yearly'  ,  ''      ,   ''
-   sn_depmin_isf = 'runoffs' ,       -12        ,'sozisfmin' ,   .false.  , .true.  , 'yearly'  ,  ''      ,   ''
+   sn_depmax_isf='rnfisf'  ,         -12       ,'sozisfmax',  .false.    , .true.  , 'yearly'  ,  ''      ,   ''     , ''
+   sn_depmin_isf='rnfisf'  ,         -12       ,'sozisfmin',  .false.    , .true.  , 'yearly'  ,  ''      ,   ''     , ''
 ! nn_isf == 2
-   sn_Leff_isf = 'rnfisf' ,       0          ,'Leff'         ,   .false.  , .true.  , 'yearly'  ,  ''      ,   ''
+   sn_Leff_isf = 'rnfisf'  ,         -12       ,'Leff'    ,   .false.    , .true.  , 'yearly'  ,  ''      ,   ''     , ''
+!
 ! for all case
-   ln_divisf   = .true.  ! apply isf melting as a mass flux or in the salinity trend. (maybe I should remove this option as for runoff?)
+   nn_isf      = 1         !  ice shelf melting/freezing
+                           !  1 = presence of ISF    2 = bg03 parametrisation 
+                           !  3 = rnf file for isf   4 = ISF fwf specified
+                           !  option 1 and 4 need ln_isfcav = .true. (domzgr)
 ! only for nn_isf = 1 or 2
-   rn_gammat0  = 1.0e-4   ! gammat coefficient used in blk formula
-   rn_gammas0  = 1.0e-4   ! gammas coefficient used in blk formula
+   rn_gammat0  = 1.e-4    ! gammat coefficient used in blk formula
+   rn_gammas0  = 1.e-4    ! gammas coefficient used in blk formula
+! only for nn_isf = 1 or 4
+   rn_hisf_tbl =  30.      ! thickness of the top boundary layer    (Losh et al. 2008)
+                          ! 0 => thickness of the tbl = thickness of the first wet cell
 ! only for nn_isf = 1
-   nn_isfblk   =  1       ! 1 ISOMIP ; 2 conservative (3 equation formulation, Jenkins et al. 1991 ??)
-   rn_hisf_tbl =  30.      ! thickness of the top boundary layer           (Losh et al. 2008)
-                          ! 0 => thickness of the tbl = thickness of the first wet cell
-   ln_conserve = .true.   ! conservative case (take into account meltwater advection)
+   nn_isfblk   = 1        ! 1 ISOMIP  like: 2 equations formulation (Hunter et al., 2006)
+                          ! 2 ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015)
    nn_gammablk = 1        ! 0 = cst Gammat (= gammat/s)
                           ! 1 = velocity dependend Gamma (u* * gammat/s)  (Jenkins et al. 2010)
-                          !     if you want to keep the cd as in global config, adjust rn_gammat0 to compensate
-                          ! 2 = velocity and stability dependent Gamma    Holland et al. 1999
+                          ! 2 = velocity and stability dependent Gamma    (Holland et al. 1999)
+/
+!-----------------------------------------------------------------------
+&namsbc_iscpl  !   land ice / ocean coupling option                     
+!-----------------------------------------------------------------------
+   nn_drown  = 10       ! number of iteration of the extrapolation loop (fill the new wet cells)
+   ln_hsb    = .false.  ! activate conservation module (conservation exact after a time of rn_fiscpl)
+   nn_fiscpl = 43800    ! (number of time step) conservation period (maybe should be fix to the coupling frequencey of restart frequency)
 /
 !-----------------------------------------------------------------------
 &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 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'  ,  ''      ,   ''     , ''
 
    cn_dir      = './'       !  root directory for the location of the bulk files
@@ -481,5 +497,5 @@
 /
 !-----------------------------------------------------------------------
-&namsbc_ssr    !   surface boundary condition : sea surface restoring
+&namsbc_ssr    !   surface boundary condition : sea surface restoring   (ln_ssr=T)
 !-----------------------------------------------------------------------
 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
@@ -507,7 +523,21 @@
 /
 !-----------------------------------------------------------------------
-&namberg       !   iceberg parameters
-!-----------------------------------------------------------------------
-      ln_icebergs              = .false.
+&namsbc_wave   ! External fields from wave model                        (ln_wave=T)
+!-----------------------------------------------------------------------
+!              !  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
+   ln_cdgw = .false.       !  Neutral drag coefficient read from wave model
+   ln_sdw  = .false.       !  Computation of 3D stokes drift               
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters                                   (default: No iceberg)
+!-----------------------------------------------------------------------
+      ln_icebergs              = .false.              ! iceberg floats or not
       ln_bergdia               = .true.               ! Calculate budgets
       nn_verbose_level         = 1                    ! Turn on more verbose output if level > 0
@@ -534,7 +564,7 @@
       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'  , ''       , ''       , ''
+!            ! 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 = './'
@@ -545,5 +575,4 @@
 !!======================================================================
 !!   namlbc        lateral momentum boundary condition
-!!   namcla        cross land advection
 !!   namobc        open boundaries parameters                           ("key_obc")
 !!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif")
@@ -555,33 +584,7 @@
 &namlbc        !   lateral momentum boundary condition
 !-----------------------------------------------------------------------
+   !                       !  free slip  !   partial slip  !   no slip   ! strong slip
    rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
-                           !  free slip  !   partial slip  !   no slip   ! strong slip
-   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical eqs.
-/
-!-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-   nn_cla      =    0      !  advection between 2 ocean pts separates by land
-/
-!-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
-   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
-   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
-   ln_obc_fla  = .false.   !  Flather open boundary condition
-   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
-                           !  = 1 the obc data are read in 'obc.dta' files
-   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
-                           !  set to monthly if obc datafile hold 1 month of data
-   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
-   rn_dpwin    =    1.     !     -           -         -       west    -      -
-   rn_dpnin    =    1.     !     -           -         -       north   -      -
-   rn_dpsin    =    1.     !     -           -         -       south   -      -
-   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
-   rn_dpwob    =   15.     !     -           -         -     west    -      -
-   rn_dpnob    = 3000.     !     -           -         -     north   -      -
-   rn_dpsob    =   15.     !     -           -         -     south   -      -
-   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
-                           !  = 1 the total volume remains constant
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical Eqs.
 /
 !-----------------------------------------------------------------------
@@ -592,7 +595,8 @@
    rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
    rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
-/
-!-----------------------------------------------------------------------
-&nam_tide      !   tide parameters (#ifdef key_tide)
+   ln_chk_bathy  = .FALSE. !
+/
+!-----------------------------------------------------------------------
+&nam_tide      !   tide parameters                                      ("key_tide")
 !-----------------------------------------------------------------------
    ln_tide_pot   = .true.   !  use tidal potential forcing
@@ -636,32 +640,33 @@
 /
 !-----------------------------------------------------------------------
-&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'  ,    ''    ,   ''     , ''
+&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'  ,    ''    ,   ''     , ''
+!   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'  ,    ''    ,   ''     , ''
-   cn_dir  =    'bdydta/'
-   ln_full_vel = .false.
+!   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'  ,    ''    ,   ''     , ''
+
+   cn_dir      =    'bdydta/'   !  root directory for the location of the bulk files
+   ln_full_vel = .false.        !  
 /
 !-----------------------------------------------------------------------
 &nambdy_tide     ! tidal forcing at open boundaries
 !-----------------------------------------------------------------------
-   filtide          = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files
-   ln_bdytide_2ddta = .false.
-   ln_bdytide_conj  = .false.
+   filtide          = 'bdydta/amm12_bdytide_'   !  file name root of tidal forcing files
+   ln_bdytide_2ddta = .false.                   !
+   ln_bdytide_conj  = .false.                   ! 
 /
 !!======================================================================
@@ -674,5 +679,5 @@
 !
 !-----------------------------------------------------------------------
-&nambfr        !   bottom friction
+&nambfr        !   bottom friction                                      (default: linear)
 !-----------------------------------------------------------------------
    nn_bfr      =    1      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
@@ -697,21 +702,19 @@
 /
 !-----------------------------------------------------------------------
-&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'  , ''       , ''       , ''
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+!              !  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
+   ln_trabbc   = .false.   !  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]
-
-/
-!-----------------------------------------------------------------------
-&nambbl        !   bottom boundary layer scheme
+   cn_dir      = './'      !  root directory for the location of the runoff files 
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
 !-----------------------------------------------------------------------
    nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
@@ -724,9 +727,10 @@
 !!                        Tracer (T & S ) namelists
 !!======================================================================
-!!   nameos        equation of state
-!!   namtra_adv    advection scheme
+!!   nameos           equation of state
+!!   namtra_adv       advection scheme
 !!   namtra_adv_mle   mixed layer eddy param. (Fox-Kemper param.)
-!!   namtra_ldf    lateral diffusion scheme
-!!   namtra_dmp    T & S newtonian damping
+!!   namtra_ldf       lateral diffusion scheme
+!!   namtra_ldfeiv    eddy induced velocity param.
+!!   namtra_dmp       T & S newtonian damping
 !!======================================================================
 !
@@ -739,7 +743,7 @@
                                  !  = 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
+                                 !  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)
@@ -751,19 +755,24 @@
 /
 !-----------------------------------------------------------------------
-&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
-/
-!-----------------------------------------------------------------------
-&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param)
-!-----------------------------------------------------------------------
-   ln_mle    = .true.      ! (T) use the Mixed Layer Eddy (MLE) parameterisation
+&namtra_adv    !   advection scheme for tracer                          (default: NO advection)
+!-----------------------------------------------------------------------
+   ln_traadv_cen =  .false.  !  2nd order centered scheme
+      nn_cen_h   =  4               !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4               !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct =  .false.  !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus =  .false.  !  MUSCL scheme
+      ln_mus_ups =  .false.         !  use upstream scheme near river mouths
+   ln_traadv_ubs =  .false.  !  UBS scheme
+      nn_ubs_v   =  2               !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck =  .false.  !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+   ln_mle    = .false.      ! (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
@@ -775,34 +784,52 @@
    rn_rho_c_mle  = 0.01    ! delta rho criterion used to calculate MLD for FK
 /
-!----------------------------------------------------------------------------------
-&namtra_ldf    !   lateral diffusion scheme for tracers
-!----------------------------------------------------------------------------------
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers                 (default: NO diffusion)
+!-----------------------------------------------------------------------
    !                       !  Operator type:
-   ln_traldf_lap    =  .true.   !  laplacian operator
-   ln_traldf_bilap  =  .false.  !  bilaplacian operator
+   !                           !  no diffusion: set ln_traldf_lap=..._blp=F 
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
    !                       !  Direction of action:
-   ln_traldf_level  =  .false.  !  iso-level
-   ln_traldf_hor    =  .false.  !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
-   ln_traldf_iso    =  .true.   !  iso-neutral                 (needs "key_ldfslp")
-   !		       	   !  Griffies parameters              (all need "key_ldfslp")
-   ln_traldf_grif   =  .false.  !  use griffies triads
-   ln_traldf_gdia   =  .false.  !  output griffies eddy velocities
-   ln_triad_iso     =  .false.  !  pure lateral mixing in ML
-   ln_botmix_grif   =  .false.  !  lateral mixing on bottom
-   !                       !  Coefficients
-   ! Eddy-induced (GM) advection always used with Griffies; otherwise needs "key_traldf_eiv"
-   ! Value rn_aeiv_0 is ignored unless = 0 with Held-Larichev spatially varying aeiv
-   !                                  (key_traldf_c2d & key_traldf_eiv & key_orca_r2, _r1 or _r05)
-   rn_aeiv_0        =  2000.    !  eddy induced velocity coefficient [m2/s]
-   rn_aht_0         =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
-   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
-   !                                           (normally=0; not used with Griffies)
-   rn_slpmax        =     0.01  !  slope limit
-   rn_chsmag        =     1.    !  multiplicative factor in Smagorinsky diffusivity
-   rn_smsh          =     1.    !  Smagorinsky diffusivity: = 0 - use only sheer
-   rn_aht_m         =  2000.    !  upper limit or stability criteria for lateral eddy diffusivity (m2/s)
-/
-!-----------------------------------------------------------------------
-&namtra_dmp    !   tracer: T & S newtonian damping
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .false.  !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .false.  !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d * ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity and grid-spacing)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+   ln_ldfeiv     =.false.  ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.false.  ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO)
 !-----------------------------------------------------------------------
    ln_tradmp   =  .true.   !  add a damping termn (T) or not (F)
@@ -810,5 +837,5 @@
                            !                   =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)
+   cn_resto    ='resto.nc' !  Name of file containing restoration coeff. field (use dmp_tools to create this)
 /
 
@@ -819,10 +846,10 @@
 !!   namdyn_vor    advection scheme
 !!   namdyn_hpg    hydrostatic pressure gradient
-!!   namdyn_spg    surface pressure gradient                            (CPP key only)
+!!   namdyn_spg    surface pressure gradient
 !!   namdyn_ldf    lateral diffusion scheme
 !!======================================================================
 !
 !-----------------------------------------------------------------------
-&namdyn_adv    !   formulation of the momentum advection
+&namdyn_adv    !   formulation of the momentum advection                (default: vector form)
 !-----------------------------------------------------------------------
    ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
@@ -833,5 +860,5 @@
 /
 !-----------------------------------------------------------------------
-&nam_vvl    !   vertical coordinate options
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
 !-----------------------------------------------------------------------
    ln_vvl_zstar  = .true.           !  zstar vertical coordinate
@@ -847,14 +874,15 @@
 /
 !-----------------------------------------------------------------------
-&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+&namdyn_vor    !   option of physics/algorithm                          (default: NO)
 !-----------------------------------------------------------------------
    ln_dynvor_ene = .false. !  enstrophy conserving scheme
    ln_dynvor_ens = .false. !  energy conserving scheme
    ln_dynvor_mix = .false. !  mixed scheme
-   ln_dynvor_een = .true.  !  energy & enstrophy scheme
-   ln_dynvor_een_old = .false.  !  energy & enstrophy scheme - original formulation
-/
-!-----------------------------------------------------------------------
-&namdyn_hpg    !   Hydrostatic pressure gradient option
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 1          ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+   ln_dynvor_msk = .false. !  vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes)  ! PLEASE DO NOT ACTIVATE
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option                 (default: zps)
 !-----------------------------------------------------------------------
    ln_hpg_zco  = .false.   !  z-coordinate - full steps
@@ -864,33 +892,44 @@
    ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
    ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
-   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
-                                 !           centered      time scheme  (F)
-/
-!-----------------------------------------------------------------------
-!namdyn_spg    !   surface pressure gradient   (CPP key only)
-!-----------------------------------------------------------------------
-!                          !  explicit free surface                     ("key_dynspg_exp")
-!                          !  filtered free surface                     ("key_dynspg_flt")
-!                          !  split-explicit free surface               ("key_dynspg_ts")
-
-!-----------------------------------------------------------------------
-&namdyn_ldf    !   lateral diffusion on momentum
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient                            (default: NO)
+!-----------------------------------------------------------------------
+   ln_dynspg_exp  = .false.   ! explicit free surface
+   ln_dynspg_ts   = .false.   ! split-explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         rn_bt_cmax   =  0.8        ! =T : the Maximum Courant Number allowed
+         nn_baro      = 30          ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum                        (default: NO)
 !-----------------------------------------------------------------------
    !                       !  Type of the operator :
-   ln_dynldf_lap    =  .true.   !  laplacian operator
-   ln_dynldf_bilap  =  .false.  !  bilaplacian operator
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
    !                       !  Direction of action  :
-   ln_dynldf_level  =  .false.  !  iso-level
-   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
-   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
+   ln_dynldf_lev =  .false.    !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
    !                       !  Coefficient
-   rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s]
-   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
-   rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s]
-   rn_cmsmag_1      =     3.    !  constant in laplacian Smagorinsky viscosity
-   rn_cmsmag_2      =     3     !  constant in bilaplacian Smagorinsky viscosity
-   rn_cmsh          =     1.    !  1 or 0 , if 0 -use only shear for Smagorinsky viscosity
-   rn_ahm_m_blp     =    -1.e12 !  upper limit for bilap  abs(ahm) < min( dx^4/128rdt, rn_ahm_m_blp)
-   rn_ahm_m_lap     = 40000.    !  upper limit for lap  ahm < min(dx^2/16rdt, rn_ahm_m_lap)
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
 /
 
@@ -901,5 +940,5 @@
 !!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
 !!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
-!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_gls    GLS vertical mixing                                 ("key_zdfgls")
 !!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
 !!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
@@ -933,5 +972,5 @@
    rn_wtmix    =  10.0     !  vertical eddy viscosity coeff [m2/s] in the mixed-layer
    rn_wvmix    =  10.0     !  vertical eddy diffusion coeff [m2/s] in the mixed-layer
-   ln_mldw     = .true.    !  Flag to use or not the mized layer depth param.
+   ln_mldw     = .true.    !  Flag to use or not the mixed layer depth param.
 /
 !-----------------------------------------------------------------------
@@ -963,17 +1002,4 @@
                            !        = 1  0.5m at the equator to 30m poleward of 40 degrees
 /
-!------------------------------------------------------------------------
-&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
-!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
-   ln_kpprimix = .true.    !  shear instability mixing
-   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s]
-   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s]
-   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability
-   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s]
-   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2]
-   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s]
-   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv
-   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt
-/
 !-----------------------------------------------------------------------
 &namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
@@ -1014,26 +1040,9 @@
 !!                  ***  Miscellaneous namelists  ***
 !!======================================================================
-!!   namsol            elliptic solver / island / free surface
 !!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
 !!   namctl            Control prints & Benchmark
-!!   namc1d            1D configuration options                         ("key_c1d")
-!!   namc1d_uvd        data: U & V currents                             ("key_c1d")
-!!   namc1d_dyndmp     U & V newtonian damping                          ("key_c1d")
 !!   namsto            Stochastic parametrization of EOS
 !!======================================================================
 !
-!-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface
-!-----------------------------------------------------------------------
-   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
-                           !                   =2 successive-over-relaxation (sor)
-   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
-   rn_eps      =  1.e-6    !  absolute precision of the solver
-   nn_nmin     =    300    !  minimum of iterations for the SOR solver
-   nn_nmax     =    800    !  maximum of iterations for the SOR solver
-   nn_nmod     =     10    !  frequency of test for the SOR solver
-   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
-   rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain)
-/
 !-----------------------------------------------------------------------
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
@@ -1061,38 +1070,21 @@
                            !     (no physical validity of the results)
    nn_timing   =    0      !  timing by routine activated (=1) creates timing.output file, or not (=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)
-/
-!-----------------------------------------------------------------------
-&namc1d_dyndmp !   U & V newtonian damping                              ("key_c1d")
-!-----------------------------------------------------------------------
-   ln_dyndmp   =  .false.  !  add a damping term (T) or not (F)
-/
-!-----------------------------------------------------------------------
-&namsto       ! Stochastic parametrization of EOS
-!-----------------------------------------------------------------------
-   ln_rststo = .false.           ! start from mean parameter (F) or from restart file (T)
+   nn_diacfl   =    0      !  Write out CFL diagnostics (=1) in cfl_diagnostics.ascii, or not (=0)
+/
+!-----------------------------------------------------------------------
+&namsto       ! Stochastic parametrization of EOS                       (default: NO)
+!-----------------------------------------------------------------------
+   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.    ! 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)
+   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)
 /
 
@@ -1100,33 +1092,24 @@
 !!                  ***  Diagnostics namelists  ***
 !!======================================================================
-!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
 !!   namtrd       dynamics and/or tracer trends
 !!   namptr       Poleward Transport Diagnostics
+!!   namhsb       Heat and salt budgets
 !!   namflo       float parameters                                      ("key_float")
-!!   namhsb       Heat and salt budgets
-!!======================================================================
-!
-!-----------------------------------------------------------------------
-&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
-!-----------------------------------------------------------------------
-   nn_nchunks_i=   4       !  number of chunks in i-dimension
-   nn_nchunks_j=   4       !  number of chunks in j-dimension
-   nn_nchunks_k=   31      !  number of chunks in k-dimension
-                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
-                           !  is optimal for postprocessing which works exclusively with horizontal slabs
-   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
-                           !  (F) ignore chunking information and produce netcdf3-compatible files
-/
-!-----------------------------------------------------------------------
-&namtrd        !   diagnostics on dynamics and/or tracer trends
-!              !       and/or mixed-layer trends and/or barotropic vorticity
+!!   nam_diaharm  Harmonic analysis of tidal constituents               ('key_diaharm')
+!!   namdct       transports through some sections
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         (default F)
+!              !   and/or mixed-layer trends and/or barotropic vorticity
 !-----------------------------------------------------------------------
    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_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_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)
@@ -1139,4 +1122,15 @@
 !!gm   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
 !!gm
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic                         (default F)
+!-----------------------------------------------------------------------
+   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
+   ln_subbas  = .false.     !  Atlantic/Pacific/Indian basins computation (T) or not
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets                                  (default F)
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
 !-----------------------------------------------------------------------
 &namflo       !   float parameters                                      ("key_float")
@@ -1154,16 +1148,5 @@
 /
 !-----------------------------------------------------------------------
-&namptr       !   Poleward Transport Diagnostic
-!-----------------------------------------------------------------------
-   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
-   ln_subbas  = .false.     !  Atlantic/Pacific/Indian basins computation (T) or not
-/
-!-----------------------------------------------------------------------
-&namhsb       !  Heat and salt budgets
-!-----------------------------------------------------------------------
-   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
-/
-!-----------------------------------------------------------------------
-&nam_diaharm   !   Harmonic analysis of tidal constituents ('key_diaharm')
+&nam_diaharm   !   Harmonic analysis of tidal constituents              ('key_diaharm')
 !-----------------------------------------------------------------------
     nit000_han = 1         ! First time step used for harmonic analysis
@@ -1174,5 +1157,5 @@
 /
 !-----------------------------------------------------------------------
-&namdct        ! transports through sections
+&namdct        ! transports through some sections
 !-----------------------------------------------------------------------
     nn_dct      = 15       !  time step frequency for transports computing
@@ -1182,75 +1165,59 @@
                            !  0 < n : debug section number n
 /
-
-!!======================================================================
-!!            ***  Observation & Assimilation namelists ***
-!!======================================================================
-!!   namobs       observation and model comparison                      ('key_diaobs')
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
+
+!!======================================================================
+!!               ***  Observation & Assimilation  ***
+!!======================================================================
+!!   namobs       observation and model comparison
 !!   nam_asminc   assimilation increments                               ('key_asminc')
 !!======================================================================
 !
 !-----------------------------------------------------------------------
-&namobs       !  observation usage switch                               ('key_diaobs')
-!-----------------------------------------------------------------------
-   ln_t3d     = .false.    ! Logical switch for T profile observations
-   ln_s3d     = .false.    ! Logical switch for S profile observations
-   ln_ena     = .false.    ! Logical switch for ENACT 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                  Logical switch for SSH observations
-
-   ln_sst     = .false.     ! Logical switch for SST observations
-   ln_reysst  = .false.     !     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                  Logical switch for SSS observations
-   ln_seaice  = .false.    ! 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'
-                           !     seaicefiles             Sea Ice input observation file names
-   seaicefiles = 'seaice_01.nc'
-                           !     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   ENACT daily average types
-   ln_grid_global = .true.
-   ln_grid_search_lookup = .false.
+&namobs       !  observation usage switch
+!-----------------------------------------------------------------------
+   ln_diaobs  = .false.             ! Logical switch for the observation operator
+   ln_t3d     = .false.             ! Logical switch for T profile observations
+   ln_s3d     = .false.             ! Logical switch for S profile observations
+   ln_sla     = .false.             ! Logical switch for SLA observations
+   ln_sst     = .false.             ! Logical switch for SST observations
+   ln_sic     = .false.             ! Logical switch for Sea Ice observations
+   ln_vel3d   = .false.             ! Logical switch for velocity observations
+   ln_altbias = .false.             ! Logical switch for altimeter bias correction
+   ln_nea     = .false.             ! Logical switch for rejection of observations near land
+   ln_grid_global = .true.          ! Logical switch for global distribution of observations
+   ln_grid_search_lookup = .false.  ! Logical switch for obs grid search w/lookup table
+   ln_ignmis  = .true.              ! Logical switch for ignoring missing files
+   ln_s_at_t  = .false.             ! Logical switch for computing model S at T obs if not there
+   ln_sstnight = .false.            ! Logical switch for calculating night-time average for SST obs
+! All of the *files* variables below are arrays. Use namelist_cfg to add more files
+   cn_profbfiles = 'profiles_01.nc'    ! Profile feedback input observation file names
+   cn_slafbfiles = 'sla_01.nc'         ! SLA feedback input observation file names
+   cn_sstfbfiles = 'sst_01.nc'         ! SST feedback input observation file names
+   cn_sicfbfiles = 'sic_01.nc'         ! SIC feedback input observation file names
+   cn_velfbfiles = 'vel_01.nc'         ! Velocity feedback input observation file names
+   cn_altbiasfile = 'altbias.nc'       ! Altimeter bias input file name
+   cn_gridsearchfile = 'gridsearch.nc' ! Grid search file name
+   rn_gridsearchres = 0.5              ! Grid search resolution
+   rn_dobsini = 00010101.000000        ! Initial date in window YYYYMMDD.HHMMSS
+   rn_dobsend = 00010102.000000        ! Final date in window YYYYMMDD.HHMMSS
+   nn_1dint = 0                        ! Type of vertical interpolation method
+   nn_2dint = 0                        ! Type of horizontal interpolation method
+   nn_msshc = 0                        ! MSSH correction scheme
+   rn_mdtcorr = 1.61                   ! MDT  correction
+   rn_mdtcutoff = 65.0                 ! MDT cutoff for computed correction
+   nn_profdavtypes = -1                ! Profile daily average types - array
+   ln_sstbias = .false. 
+   cn_sstbias_files = 'sstbias.nc'
 /
 !-----------------------------------------------------------------------
@@ -1273,28 +1240,26 @@
 /
 !-----------------------------------------------------------------------
-&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'   ,  ''      , ''       , ''
-!
-   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
-/
-!-----------------------------------------------------------------------
-&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
-!-----------------------------------------------------------------------
-   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model
-   ln_neptsimp       = .false.  ! yes/no use simplified neptune
-
-   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep
-   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator
-   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole
-   ! Specify whether to ramp down the Neptune velocity in shallow
-   ! water, and if so the depth range controlling such ramping down
-   ln_neptramp       = .true.   ! ramp down Neptune velocity in shallow water
-   rn_htrmin         =  100.0   ! min. depth of transition range
-   rn_htrmax         =  200.0   ! max. depth of transition range
-/
+&namdiu !   Cool skin and warm layer models
+!-----------------------------------------------------------------------
+   ln_diurnal      = .false.   ! 
+   ln_diurnal_only = .false.   !
+/
+!-----------------------------------------------------------------------
+&nam_diatmb  !  Top Middle Bottom Output
+!-----------------------------------------------------------------------
+   ln_diatmb  = .false.    !  Choose Top Middle and Bottom output or not
+/
+!-----------------------------------------------------------------------
+&namwad  !   Wetting and drying
+!-----------------------------------------------------------------------
+   ln_wd             = .false.  ! T/F activation of wetting and drying
+   rn_wdmin1         =  0.1     ! Minimum wet depth on dried cells
+   rn_wdmin2         =  0.01    ! Tolerance of min wet depth on dried cells
+   rn_wdld           =  20.0    ! Land elevation below which wetting/drying is allowed
+   nn_wdit           =  10      ! Max iterations for W/D limiter
+/
+!-----------------------------------------------------------------------
+&nam_dia25h  !  25h Mean Output
+!-----------------------------------------------------------------------
+   ln_dia25h  = .false.    ! Choose 25h mean output or not
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/SHARED/namelist_top_ref
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/SHARED/namelist_top_ref	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/SHARED/namelist_top_ref	(revision 6808)
@@ -11,13 +11,13 @@
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !-----------------------------------------------------------------------
-&namtrc_run     !   run information
+&namtrc_run      !   run information
 !-----------------------------------------------------------------------
    nn_dttrc      =  1        !  time step frequency for passive sn_tracers
    nn_writetrc   =  5475     !  time step frequency for sn_tracer outputs
-   ln_top_euler  = .false.    !  use Euler time-stepping for TOP
+   ln_top_euler  = .false.   !  use Euler time-stepping for TOP
    ln_rsttr      = .false.   !  start from a restart file (T) or not (F)
    nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value
-                           !                  = 1 do not use the value in the restart file
-                           !                  = 2 calendar parameters read in the restart file
+                             !                  = 1 do not use the value in the restart file
+                             !                  = 2 calendar parameters read in the restart file
    cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input)
    cn_trcrst_indir = "."           !  directory from which to read input passive tracer restarts
@@ -26,5 +26,5 @@
 /
 !-----------------------------------------------------------------------
-&namtrc     !   tracers definition
+&namtrc          !   tracers definition
 !-----------------------------------------------------------------------
    ln_trcdta     =   .true.  !  Initialisation from data input file (T) or not (F)
@@ -35,85 +35,102 @@
 &namtrc_dta      !    Initialisation from data input file
 !-----------------------------------------------------------------------
-!
-   cn_dir        =  './'      !  root directory for the location of the data files
+   cn_dir        =  './'     !  root directory for the location of the data files
 /
 !-----------------------------------------------------------------------
-&namtrc_adv    !   advection scheme for passive tracer 
+&namtrc_adv      !   advection scheme for passive tracer 
 !-----------------------------------------------------------------------
-   ln_trcadv_cen2    =  .false.  !  2nd order centered scheme   
-   ln_trcadv_tvd     =  .true.  !  TVD scheme
-   ln_trcadv_muscl   =  .false.   !  MUSCL scheme
-   ln_trcadv_muscl2  =  .false.  !  MUSCL2 scheme + cen2 at boundaries
-   ln_trcadv_ubs     =  .false.  !  UBS scheme
-   ln_trcadv_qck     =  .false.  !  QUICKEST scheme
-   ln_trcadv_msc_ups =  .false.  !  use upstream scheme within muscl
+   ln_trcadv_cen =  .false.  !  2nd order centered scheme
+      nn_cen_h   =  4               !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4               !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_trcadv_fct =  .false.  !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+   ln_trcadv_mus =  .false.  !  MUSCL scheme
+      ln_mus_ups =  .false.         !  use upstream scheme near river mouths
+   ln_trcadv_ubs =  .false.  !  UBS scheme
+      nn_ubs_v   =  2               !  =2  , vertical 2nd order FCT
+   ln_trcadv_qck =  .false.  !  QUICKEST scheme
 /
 !-----------------------------------------------------------------------
-&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
+&namtrc_ldf      !   lateral diffusion scheme for passive tracer 
 !-----------------------------------------------------------------------
-!                               !  Type of the operator : 
-   ln_trcldf_lap    =  .true.   !     laplacian operator       
-   ln_trcldf_bilap  =  .false.  !     bilaplacian operator     
-                                !  Direction of action  :
-   ln_trcldf_level  =  .false.  !     iso-level                
-   ln_trcldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
-   ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
-!                               !  Coefficient
-   rn_ahtrc_0       =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
-   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
+!                            !  Type of the operator:  
+   ln_trcldf_lap   =  .true.     !    laplacian operator
+   ln_trcldf_blp   =  .false.    !  bilaplacian operator
+   !                         !  Direction of action:
+   ln_trcldf_lev   =  .false.    !  iso-level
+   ln_trcldf_hor   =  .false.    !  horizontal (geopotential)
+   ln_trcldf_iso   =  .true.     !  iso-neutral (standard operator)
+   ln_trcldf_triad =  .false.    !  iso-neutral (triad    operator)
+   !                         !  Coefficient 
+   rn_ahtrc_0      = 2000.       !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bhtrc_0      = 1.e+12      !  lateral eddy diffusivity (bilap. operator) [m4/s]
 /
 !-----------------------------------------------------------------------
-&namtrc_zdf        !   vertical physics
+&namtrc_zdf      !   vertical physics
 !-----------------------------------------------------------------------
-   ln_trczdf_exp   =  .false.  !  split explicit (T) or implicit (F) time stepping
-   nn_trczdf_exp   =   3       !  number of sub-timestep for ln_trczdfexp=T
+   ln_trczdf_exp =  .false.  !  split explicit (T) or implicit (F) time stepping
+   nn_trczdf_exp =   3       !  number of sub-timestep for ln_trczdfexp=T
 /
 !-----------------------------------------------------------------------
-&namtrc_rad        !  treatment of negative concentrations 
+&namtrc_rad      !  treatment of negative concentrations 
 !-----------------------------------------------------------------------
-   ln_trcrad   =  .true.  !  artificially correct negative concentrations (T) or not (F)
+   ln_trcrad     =  .true.   !  artificially correct negative concentrations (T) or not (F)
 /
 !-----------------------------------------------------------------------
-&namtrc_dmp    !   passive tracer newtonian damping   
+&namtrc_dmp      !   passive tracer newtonian damping   
 !-----------------------------------------------------------------------
-   nn_zdmp_tr  =    1      !  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_tr  = 'resto_tr.nc'    !  create a damping.coeff NetCDF file (=1) or not (=0)
+   nn_zdmp_tr    =    1      !  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_tr   = 'resto_tr.nc'    !  create a damping.coeff NetCDF file (=1) or not (=0)
 /
 !-----------------------------------------------------------------------
-&namtrc_ice       !    Representation of sea ice growth & melt effects
+&namtrc_ice      !    Representation of sea ice growth & melt effects
 !-----------------------------------------------------------------------
-   nn_ice_tr   =  -1        !  tracer concentration in sea ice 
-                           !    =-1 (no vvl: identical cc in ice and ocean / vvl: cc_ice = 0)
-                           !    = 0 (no vvl: cc_ice = zero / vvl: cc_ice = )
-                           !    = 1 prescribed to a namelist value (implemented in pisces only)
+   nn_ice_tr     =  -1       !  tracer concentration in sea ice 
+                             !    =-1 (no vvl: identical cc in ice and ocean / vvl: cc_ice = 0)
+                             !    = 0 (no vvl: cc_ice = zero / vvl: cc_ice = )
+                             !    = 1 prescribed to a namelist value (implemented in pisces only)
 /
 !-----------------------------------------------------------------------
-&namtrc_trd       !   diagnostics on tracer trends        ('key_trdtrc')
-!                          or mixed-layer trends          ('key_trdmld_trc')
+&namtrc_trd      !   diagnostics on tracer trends                       ('key_trdtrc')
+!                          or mixed-layer trends                        ('key_trdmld_trc')
 !----------------------------------------------------------------------
-   nn_trd_trc  =  5475      !  time step frequency and tracers trends
-   nn_ctls_trc =   0        !  control surface type in mixed-layer trends (0,1 or n<jpk)
-   rn_ucf_trc  =   1        !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
-   ln_trdmld_trc_restart = .false.  !  restart for ML diagnostics
+   nn_trd_trc    =  5475     !  time step frequency and tracers trends
+   nn_ctls_trc   =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf_trc    =   1       !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   ln_trdmld_trc_restart = .false. !  restart for ML diagnostics
    ln_trdmld_trc_instant = .true.  !  flag to diagnose trends of instantantaneous or mean ML T/S
-   ln_trdtrc(1)  =   .true.
-   ln_trdtrc(2)  =   .true.
-   ln_trdtrc(23) =   .true.
+   ln_trdtrc( 1) = .true.
+   ln_trdtrc( 2) = .true.
+   ln_trdtrc(23) = .true.
 /
 !-----------------------------------------------------------------------
-&namtrc_dia       !   parameters for passive tracer additional diagnostics
+&namtrc_dia      !   parameters for passive tracer additional diagnostics
 !----------------------------------------------------------------------
    ln_diatrc     =  .true.   !  save additional diag. (T) or not (F)
    ln_diabio     =  .true.   !  output biological trends
    nn_writedia   =  5475     !  time step frequency for diagnostics
-   nn_writebio   =    10     !: frequency of biological outputs
+   nn_writebio   =    10     !  frequency of biological outputs
 /
 !----------------------------------------------------------------------
-! namtrc_bc       !   data for boundary conditions
+&namtrc_bc       !   data for boundary conditions
 !-----------------------------------------------------------------------
-&namtrc_bc
-!
-   cn_dir        =  './'      !  root directory for the location of the data files
+   cn_dir_sbc    =  './'     !  root directory for the location of SURFACE data files
+   cn_dir_cbc    =  './'     !  root directory for the location of COASTAL data files
+   cn_dir_obc    =  './'     !  root directory for the location of OPEN data files
 /
+!----------------------------------------------------------------------
+&namtrc_bdy      !   Setup of tracer boundary conditions
+!-----------------------------------------------------------------------
+   cn_trc_dflt   = 'neumann' !  OBC applied by default to all tracers
+   cn_trc        = 'none'    !  Boundary conditions used for tracers with data files (selected in namtrc)
+
+   nn_trcdmp_bdy = 0         !  Use damping timescales defined in nambdy of namelist
+                             !  = 0 NO damping of tracers at open boudaries
+                             !  = 1 Only for tracers forced with external data
+                             !  = 2 Damping applied to all tracers
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/cfg.txt
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/cfg.txt	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/cfg.txt	(revision 6808)
@@ -5,8 +5,7 @@
 C1D_PAPA OPA_SRC
 GYRE_BFM OPA_SRC TOP_SRC
-AMM12 OPA_SRC
 ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC
-GYRE OPA_SRC
 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC
 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC
 ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC
+AMM12 OPA_SRC
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/uspcfg.txt
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/uspcfg.txt	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/CONFIG/uspcfg.txt	(revision 6808)
@@ -1,2 +1,3 @@
 ORCA1_CICE # ORCA2_LIM # OPA_SRC TOP_SRC  # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/ORCA1_CICE/v3.6.0/ORCA1_CICE_ctl.txt
-ISOMIP     # GYRE      # OPA_SRC          # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/ISOMIP/v3.6.0/ISOMIP_ctl.txt
+ISOMIP     # GYRE      # OPA_SRC          # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/ISOMIP/trunk/ISOMIP_ctl.txt
+IRISHSEA   # GYRE      # OPA_SRC          # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/IRISHSEA/v3.7.0/IRISHSEA_ctl.txt
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F	(revision 6807)
+++ 	(revision )
@@ -1,1175 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90	(revision 6808)
@@ -0,0 +1,826 @@
+!
+! $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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F	(revision 6807)
+++ 	(revision )
@@ -1,1337 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90	(revision 6808)
@@ -0,0 +1,649 @@
+!
+! $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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F	(revision 6807)
+++ 	(revision )
@@ -1,2448 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90	(revision 6808)
@@ -0,0 +1,680 @@
+!
+! $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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F	(revision 6807)
+++ 	(revision )
@@ -1,1452 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90	(revision 6808)
@@ -0,0 +1,1277 @@
+!
+! $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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F	(revision 6807)
+++ 	(revision )
@@ -1,990 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90	(revision 6808)
@@ -0,0 +1,765 @@
+!
+! $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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F	(revision 6807)
+++ 	(revision )
@@ -1,339 +1,0 @@
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90	(revision 6808)
@@ -0,0 +1,478 @@
+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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F	(revision 6807)
+++ 	(revision )
@@ -1,252 +1,0 @@
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90	(revision 6808)
@@ -0,0 +1,209 @@
+!     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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F	(revision 6807)
+++ 	(revision )
@@ -1,125 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90	(revision 6808)
@@ -0,0 +1,86 @@
+!
+! $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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F	(revision 6807)
+++ 	(revision )
@@ -1,2270 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90	(revision 6808)
@@ -0,0 +1,1507 @@
+!
+! $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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F	(revision 6807)
+++ 	(revision )
@@ -1,1706 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90	(revision 6808)
@@ -0,0 +1,1464 @@
+!
+! $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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F	(revision 6807)
+++ 	(revision )
@@ -1,186 +1,0 @@
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90	(revision 6808)
@@ -0,0 +1,181 @@
+!     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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F	(revision 6807)
+++ 	(revision )
@@ -1,688 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90	(revision 6808)
@@ -0,0 +1,586 @@
+!
+! $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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F	(revision 6807)
+++ 	(revision )
@@ -1,1119 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90	(revision 6808)
@@ -0,0 +1,634 @@
+!
+! $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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90	(revision 6808)
@@ -0,0 +1,208 @@
+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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F	(revision 6807)
+++ 	(revision )
@@ -1,937 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90	(revision 6808)
@@ -0,0 +1,663 @@
+!
+! $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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90	(revision 6808)
@@ -0,0 +1,640 @@
+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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F	(revision 6807)
+++ 	(revision )
@@ -1,460 +1,0 @@
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90	(revision 6808)
@@ -0,0 +1,425 @@
+!     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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F	(revision 6807)
+++ 	(revision )
@@ -1,2677 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90	(revision 6808)
@@ -0,0 +1,2130 @@
+!
+! $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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F	(revision 6807)
+++ 	(revision )
@@ -1,659 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90	(revision 6808)
@@ -0,0 +1,434 @@
+!
+! $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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F	(revision 6807)
+++ 	(revision )
@@ -1,864 +1,0 @@
-!
-! $Id$
-!
-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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90	(revision 6808)
@@ -0,0 +1,1108 @@
+!
+! $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: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F	(revision 6807)
+++ 	(revision )
@@ -1,152 +1,0 @@
-      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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90	(revision 6808)
@@ -0,0 +1,146 @@
+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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/Makefile.lex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/Makefile.lex	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/Makefile.lex	(revision 6808)
@@ -0,0 +1,31 @@
+LEX		= flex -i
+YACC	= bison -t -v -g
+
+all: main.c fortran.c
+
+main.c : convert.tab.c convert.yy.c
+	cat   convert.tab.c convert.yy.c > ../LIB/main.c
+	$(RM) convert.tab.c convert.yy.c
+
+fortran.c : fortran.tab.c fortran.yy.c
+	cat   fortran.tab.c fortran.yy.c > ../LIB/fortran.c
+	$(RM) fortran.tab.c fortran.yy.c
+
+convert.tab.c : convert.y decl.h
+	$(YACC) -p convert_ convert.y
+
+fortran.tab.c : fortran.y decl.h
+	$(YACC) -p fortran_ fortran.y
+
+convert.yy.c : convert.lex
+	$(LEX) -P convert_ -o convert.yy.c convert.lex
+
+fortran.yy.c : fortran.lex
+	$(LEX) -P fortran_ -o fortran.yy.c fortran.lex
+
+clean:
+	$(RM) convert.yy.c convert.tab.c convert.output convert.vcg convert.dot	\
+		  fortran.yy.c fortran.tab.c fortran.output fortran.vcg fortran.dot
+
+clean-all: clean
+	$(RM) ../LIB/main.c ../LIB/fortran.c
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.lex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.lex	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.lex	(revision 6808)
@@ -0,0 +1,69 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%option warn
+%option noyywrap
+
+%s character
+%{
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define YY_NO_INPUT
+%}
+
+SEPARATEUR      "::"
+COMMENTS        "%".*"%"
+PROBTYPE        "1D"|"2D"|"3D"
+USEITEM         "FIXED_GRIDS"|"ONLY_FIXED_GRIDS"|"F77"
+NAME            [a-zA-Z\_][a-zA-Z0-9\_]*
+INTEGER         [0-9]+
+NEXTLINE        \n+[ \t]+"$"|\n+[ \t]+"&"
+%%
+parammodule         { return TOK_MODULEMAIN; } /* name of the module                      */
+notgriddep          { return TOK_NOTGRIDDEP; } /* variable which are not grid dependent   */
+use                 { return TOK_USE; }
+{COMMENTS}          { }
+{SEPARATEUR}        { return TOK_SEP; }
+KIND                { return TOK_KIND; }
+\=                  { return TOK_EQUAL; }
+{USEITEM}           { strcpy(yylval.na,yytext); return TOK_USEITEM;  }
+{PROBTYPE}          { strcpy(yylval.na,yytext); return TOK_PROBTYPE; }  /* dimension of the problem */
+{NAME}              { strcpy(yylval.na,yytext); return TOK_NAME; }
+{INTEGER}           { strcpy(yylval.na,yytext); return TOK_CSTINT; }
+;|\,|\(|\)|:|\[|\]  { return (int) *yytext; }
+\n                  { line_num++; return (int) *yytext; }
+[ \t]+ ;
+%%
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.y
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.y	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.y	(revision 6808)
@@ -0,0 +1,463 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%{
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+int line_num=1;
+extern FILE * convert_in;
+
+int convert_error(const char *s)
+{
+    printf("##\n## ERROR in conv: '%s' (line %d, file: %s)\n##\n", s, line_num, config_file);
+    exit(0);
+}
+
+%}
+
+%union {
+    char na[LONG_M];
+}
+
+%token TOK_SEP
+%token TOK_KIND
+%token TOK_EQUAL
+%token TOK_USE
+%token TOK_MODULEMAIN      /* name of the module                              */
+%token TOK_NOTGRIDDEP      /* Variable which are not grid dependent           */
+%token <na> TOK_USEITEM
+%token <na> TOK_NAME
+%token <na> TOK_CSTINT
+%token <na> TOK_PROBTYPE   /* dimension of the problem                        */
+%token ','
+%token ';'
+
+%%
+
+input :
+    | input line ;
+
+line :
+      '\n'
+    | TOK_PROBTYPE TOK_NAME ';'                             { initdimprob(1,$2,"0","0"); }
+    | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ';'                { initdimprob(2,$2, $4,"0"); }
+    | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ',' TOK_NAME ';'   { initdimprob(3,$2, $4, $6); }
+    | TOK_MODULEMAIN TOK_NAME ';'
+        {
+            listofmodules = Addtolistnom($2,listofmodules,0);
+            Addmoduletothelist($2);
+        }
+    | TOK_KIND TOK_NAME TOK_EQUAL TOK_CSTINT ';'
+        {
+            if (!strcasecmp($4,"4"))
+            {
+                listofkind = Addtolistnom($2,listofkind,4);
+            }
+            else if (!strcasecmp($4,"8"))
+            {
+                listofkind = Addtolistnom($2,listofkind,8);
+            }
+            else
+            {
+                printf("##\n## Unknown kind type : %s (must be 4 or 8)\n##",$4);
+                exit(0);
+            }
+        }
+    | TOK_NOTGRIDDEP TOK_SEP TOK_NAME ';'
+        {
+            Add_NotGridDepend_Var_1($3);
+        }
+    | TOK_USE TOK_USEITEM ';'
+        {
+            if (!strcasecmp($2,"FIXED_GRIDS"))      fixedgrids = 1;
+            if (!strcasecmp($2,"ONLY_FIXED_GRIDS")) onlyfixedgrids = 1;
+        }
+    ;
+%%
+
+void print_usage()
+{
+    printf("usage : conv <config_file> -convfile  <FILENAME>\n");
+    printf(" [-workdir <directory>] [-incdir <directory>]\n");
+    printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
+    printf(" [-convfile  <FILENAME>] [-SubloopScalar] [-SubloopScalar1] \n");
+    printf(" [-free|-fixed]\n");
+    exit(0);
+}
+
+int main(int argc,char *argv[])
+{
+    extern FILE * convert_in ;
+    FILE *dependglobaloutput;
+    int i;
+    listnom *parcours;
+    listvar *newvar;
+    int stylegiven = 0;
+    int infreegiven ;
+    int infixedgiven ;
+    int lengthmainfile;
+
+    char filetoparse[LONG_FNAME];
+
+/******************************************************************************/
+/*  1-  Variables initialization                                              */
+/******************************************************************************/
+    List_Global_Var = (listvar *) NULL;
+    List_GlobalParameter_Var = (listvar *) NULL;
+    List_Common_Var = (listvar *) NULL;
+    List_Allocate_Var = (listallocate *) NULL;
+    List_SubroutineWhereAgrifUsed = (listnom *) NULL;
+    List_Subroutine_For_Alloc = (listnom *) NULL;
+    List_Include = (listusemodule *) NULL;
+    List_NameOfModuleUsed = (listusemodule *) NULL;
+    listofmoduletmp = (listusemodule *) NULL;
+    List_SubroutineDeclaration_Var = (listvar *) NULL;
+    List_UsedInSubroutine_Var = (listvar *) NULL;
+    List_NotGridDepend_Var = (listvar *) NULL;
+    Listofavailableindices = (listindice *) NULL;
+    Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+    List_CouplePointed_Var = (listvarpointtovar *) NULL;
+    List_ModuleUsed_Var = (listvar *) NULL;
+    List_ModuleUsedInModuleUsed_Var = (listvar *) NULL;
+    List_GlobParamModuleUsed_Var = (listparameter *) NULL;
+    List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *) NULL;
+    List_SubroutineArgument_Var = (listvar *) NULL;
+    List_FunctionType_Var = (listvar *) NULL;
+    tmpuselocallist = (listusemodule *) NULL;
+    List_ContainsSubroutine = (listnom *) NULL;
+    oldfortran_out = (FILE *) NULL;
+
+    if (argc < 2) print_usage();
+    
+    strcpy(config_file, argv[1]);
+    strcpy(work_dir, ".");
+    strcpy(input_dir, ".");
+    strcpy(output_dir, "AGRIF_MODELFILES");
+    strcpy(include_dir, "AGRIF_INC");
+    strcpy(filetoparse, "");
+    strcpy(subofagrifinitgrids, "");
+    strcpy(meetagrifinitgrids, "");
+    strcpy(mpiinitvar, "");
+
+    length_last = 0 ;
+    length_first = 0 ;
+    length_v_vallengspec = 0 ;
+    length_v_commoninfile = 0 ;
+    length_v_precision = 0 ;
+    length_v_IntentSpec = 0 ;
+    length_v_initialvalue = 0 ;
+    length_v_readedlistdimension = 0 ;
+    length_a_nomvar = 0 ;
+    length_toprintglob = 0 ;
+    length_tmpvargridname = 0 ;
+    length_ligne_Subloop = 0 ;
+    length_toprint_utilagrif = 0 ;
+    length_toprinttmp_utilchar = 0 ;
+    length_ligne_writedecl = 0 ;
+    length_newname_toamr = 0 ;
+    length_newname_writedecl = 0 ;
+    length_ligne_toamr = 0 ;
+    length_tmpligne_writedecl = 0 ;
+    value_char_size = 0 ;
+    value_char_size1 = 0 ;
+    value_char_size2 = 0 ;
+    value_char_size3 = 0 ;
+    inallocate = 0;
+    infixed = 1;
+    infree  = 0;
+
+    onlyfixedgrids=0;
+    fixedgrids=0;
+    InAgrifParentDef = 0;
+    IndicenbmaillesX=0;
+    IndicenbmaillesY=0;
+    IndicenbmaillesZ=0;
+    created_dimensionlist = 1;
+    /* current indice in the table tabvars             */
+    for ( i=0 ; i<NB_CAT_VARIABLES ; i++)
+    {
+        indicemaxtabvars[i] = 0;
+    }
+    SubloopScalar = 0;
+    todebug = 0;
+    retour77 = 1 ;
+    shouldincludempif = 0 ;
+
+    Read_val_max();
+
+/******************************************************************************/
+/*  2-  Program arguments                                                     */
+/******************************************************************************/
+
+    if ( (convert_in=fopen(config_file,"r")) == NULL )
+    {
+        printf("##\n## ERROR: the configuration file '%s' doesn't exist.\n##\n", config_file);
+        print_usage();
+    }
+
+    i=2;
+    while ( i < argc )
+    {
+        if (!strcasecmp(argv[i], "-workdir"))
+        {
+            strcpy(work_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-incdir"))
+        {
+            strcpy(include_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirin")) /* input directory           */
+        {
+            strcpy(input_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirout")) /* output directory         */
+        {
+            strcpy(output_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-convfile")) /* file to parse             */
+        {
+            strcpy(filetoparse, argv[i+1]);
+            i++;
+            lengthmainfile = strlen(filetoparse);
+            if (!strcasecmp(&filetoparse[lengthmainfile-4], ".f90"))
+            {
+                infixed = 0;
+                infree = 1;
+            }
+            else
+            {
+                infixed = 1;
+                infree = 0;
+            }
+        }
+        else if (!strcasecmp(argv[i], "-free"))
+        {
+            stylegiven = 1;
+            infreegiven  = 1 ;
+            infixedgiven = 0;
+        }
+        else if (!strcasecmp(argv[i], "-fixed"))
+        {
+            stylegiven = 1;
+            infreegiven  = 0;
+            infixedgiven = 1;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar"))
+        {
+            SubloopScalar = 1 ;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar1"))
+        {
+            SubloopScalar = 2 ;
+        }
+        else if (!strcasecmp(argv[i], "-todebug"))
+        {
+            todebug = 1 ;
+        }
+        else if (!strcasecmp(argv[i],"-rm")) { }
+        else
+        {
+            printf("##\n## Unkwon option : %s\n##\n", argv[i]);
+            exit(0);
+        }
+        i++;
+    }
+    // Check input file
+    if ( strlen(filetoparse) == 0 )         // -convfile has not been specified
+    {
+        printf("##\n## ERROR: please provide a file to parse with -convfile.\n##\n");
+        print_usage();
+    }
+    // Setup input & output directories
+    if ( strcasecmp(work_dir, ".") != 0 )   // -workdir has been changed...
+    {
+        if ( strcasecmp(input_dir,  ".") == 0 )                 // ...and -comdirin  has NOT been changed
+        {
+            strcpy(input_dir, work_dir);
+        }
+        if ( strcasecmp(output_dir, "AGRIF_MODELFILES") == 0 )  // ...and -comdirout has NOT been changed
+        {
+            sprintf(output_dir, "%s/%s", work_dir, "AGRIF_MODELFILES");
+        }
+        if ( strcasecmp(include_dir, "AGRIF_INC") == 0 )        // ...and -incdir    has NOT been changed
+        {
+            sprintf(include_dir, "%s/%s", work_dir, "AGRIF_INC");
+        }
+    }
+    if (stylegiven == 1)
+    {
+        infree  = infreegiven;
+        infixed = infixedgiven;
+    }
+
+/******************************************************************************/
+/*  3-  Parsing of the conv file <name>.in                                    */
+/******************************************************************************/
+
+    if ( strstr(filetoparse, ".f90") || strstr(filetoparse, ".F90") ) retour77 = 0;
+
+    convert_parse();
+
+/******************************************************************************/
+/*  4-  Preparation of the file parsing                                       */
+/******************************************************************************/
+
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    /*                                                                         */
+    if ( (dependglobaloutput=fopen(dependfilename, "r")) != NULL )
+    {
+        for (i=0;i<NB_CAT_VARIABLES;i++)
+        {
+            fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars[i]);
+        }
+        fclose(dependglobaloutput);
+    }
+    Readthedependavailablefile();
+    /* Read the .dependnbxnby file which contains indices of nbmaillsX, nbmailleY and nbmailleZ */
+    Readthedependnbxnbyfile();
+    Read_Subroutine_For_Alloc();
+
+/******************************************************************************/
+/*  5-  Parsing of the input file (2 times)                                   */
+/******************************************************************************/
+
+    /* Record all variables in list                                            */
+    firstpass = 1;
+    process_fortran(filetoparse);
+
+    CompleteThelistvarindoloop();
+    /* Read list of module used                                                */
+    RecordUseModulesVariables();
+    /* Read list of module used in module used                                 */
+    RecordUseModulesUseModulesVariables();
+    /* Save variables are considered as globals ones                           */
+    Update_List_Global_Var_From_List_Save_Var();
+    /* Update all lists                                                        */
+    ListUpdate();
+
+    Clean_List_Global_Var();
+    /* Indice tabvars identification                                           */
+    IndiceTabvarsIdentification();
+    /* Update all lists                                                        */
+    ListUpdate();
+    /* The allocation subroutine is necessary ????                             */
+    New_Allocate_Subroutine_Is_Necessary();
+    /* The allocation subroutine is necessary for common list                  */
+    New_Allocate_Subroutine_For_Common_Is_Necessary();
+    /* Sort List_SubroutineArgument_Var                                        */
+    Sort_List_SubroutineArgument_Var();
+    /* Clean all lists                                                         */
+    ListClean();
+    /* Update Indice of List_UsedInSubroutine_Var from module used             */
+    List_UsedInSubroutine_Var_Update_From_Module_Used();
+    /* Update List_SubroutineWhereAgrifUsed                                    */
+    UpdateList_SubroutineWhereAgrifUsed();
+    /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
+    UpdateList_UsedInSubroutine_With_dimension();
+
+    ModifyThelistvarindoloop();
+    UpdateListDeclarationWithDimensionList();
+    GiveTypeOfVariables();
+
+    /* Build new subroutines                                                   */
+    firstpass = 0;
+    process_fortran(filetoparse);
+
+    newvar = (listvar *) NULL;
+
+    while ( newvar )
+    {
+        printf("++++ %s %d %s %s %s\n",
+            newvar->var->v_nomvar,
+            newvar->var->v_nbdim,
+            newvar->var->v_subroutinename,
+            newvar->var->v_modulename,
+            newvar->var->v_typevar);
+        newvar = newvar->suiv;
+    }
+
+/******************************************************************************/
+/*  6-  Write informations in output files                                    */
+/******************************************************************************/
+
+    /* Write the .dependglobal_agrif file which contain the max indice         */
+    /*    of the tabvars table                                                 */
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    dependglobaloutput = fopen(dependfilename, "w");
+    for (i=0;i<NB_CAT_VARIABLES;i++)
+    {
+        fprintf(dependglobaloutput,"%d\n",indicemaxtabvars[i]);
+    }
+    fclose(dependglobaloutput);
+    /* Write the list of available indice                                      */
+    Writethedependavailablefile();
+    /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
+    /*    nbmailleY and nbmailleZ                                              */
+    Writethedependnbxnbyfile();
+    /* Write the .depend<namefile> file which contain general informations     */
+    /*    about variable of this file                                          */
+    parcours = List_NameOfModule;
+    while( parcours )
+    {
+        Writethedependlistofmoduleused(parcours->o_nom);
+        WritedependParameterList(parcours->o_nom);
+        Writethedependfile(parcours->o_nom,List_Global_Var);
+        parcours=parcours->suiv;
+    }
+    parcours = List_NameOfCommon;
+    while( parcours )
+    {
+        Writethedependfile(parcours->o_nom,List_Common_Var);
+        parcours=parcours->suiv;
+    }
+    Write_Subroutine_For_Alloc();
+
+/******************************************************************************/
+/*  7-  Create files in AGRIF_INC directory                                   */
+/******************************************************************************/
+
+    creefichieramr();
+
+    Write_val_max();
+
+    if ( todebug == 1 ) printf("Out of CONV \n");
+    return 0;
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/decl.h
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/decl.h	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/decl.h	(revision 6808)
@@ -0,0 +1,1 @@
+link ../LIB/decl.h
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.lex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.lex	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.lex	(revision 6808)
@@ -0,0 +1,294 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%option warn
+%option noyywrap
+
+%x parameter
+%s character
+%x donottreat
+%s fortran77style
+%s fortran90style
+%{
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+extern FILE * yyin;
+#define MAX_INCLUDE_DEPTH 30
+YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
+int line_num_input = 1;
+int newlinef90 = 0;
+char tmpc;
+#define PRINT_LINE_NUM()     // { fprintf(stderr,"== Parsing l.%4d...\n", line_num_input); }
+#define INCREMENT_LINE_NUM() { line_num_input++; PRINT_LINE_NUM(); }
+
+/******************************************************************************/
+/**************PETITS PB NON PREVUS *******************************************/
+/******************************************************************************/
+/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
+/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
+/*            de la 7eme et le debut de la ligne de commande                  */
+/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
+/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
+/******************************************************************************/
+#define YY_USER_ACTION  if (firstpass == 0) ECHO;
+
+void out_of_donottreat(void);
+
+%}
+
+REAL8 "real*8"[ \t]*"(a-h,o-z)"
+
+SLASH       "/"
+DSLASH      "/"[ \t]*"/"
+HEXA        Z\'[0-9a-fA-F]+\'
+NAME        [a-zA-Z\_][a-zA-Z0-9\_]*
+INTEGER     [0-9]+
+
+EXPONENT    [edq][-+]?{INTEGER}
+
+BEG_DNT         ^[C!]"$AGRIF_DO_NOT_TREAT"[ \t]*\n
+END_DNT         ^[C!]"$AGRIF_END_DO_NOT_TREAT"[ \t]*\n
+
+BEG_INTERFACE   ^[ \t]*interface
+END_INTERFACE   ^[ \t]*end[ \t]*interface.*\n
+
+ASSIGNTYPE      "assignment"[ \t]*"("[ \t]*[-+=]+[ \t]*")"
+
+COMM_F77        ^([Cc*](([ \t]*\n)|([^AaHhOo\n].*\n)))
+COMM_F90        ^[ \t]*!.*\n
+COMM_F90_2      !.*
+NEXTLINEF90     "&".*\n+
+NEXTLINEF77     [\n \t]*\n[ \t]{5}("&"|"+"|"$"|"*"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"|"."|"#")
+
+LABEL           ^(((" "|[0-9]){1,5})|([ \t]{1,5}))[ &]+
+
+%%
+  if (infixed) BEGIN(fortran77style) ;
+  if (infree)  BEGIN(fortran90style) ;
+
+{REAL8}                     { return TOK_REAL8; }
+subroutine                  { return TOK_SUBROUTINE; }
+program                     { return TOK_PROGRAM; }
+allocate                    { inallocate = 1; return TOK_ALLOCATE; }
+nullify			            { return TOK_NULLIFY; }
+null[ ]*\([ ]*\)            { return TOK_NULL_PTR; }
+deallocate                  { inallocate = 1; return TOK_DEALLOCATE; }
+result                      { return TOK_RESULT; }
+function                    { return TOK_FUNCTION; }
+end[ \t]*program            { strcpy(yylval.na,fortran_text); return TOK_ENDPROGRAM;}
+end[ \t]*module             { strcpy(yylval.na,fortran_text); return TOK_ENDMODULE; }
+end[ \t]*subroutine         { strcpy(yylval.na,fortran_text); return TOK_ENDSUBROUTINE;}
+end[ \t]*function           { strcpy(yylval.na,fortran_text); return TOK_ENDFUNCTION;}
+end                         { strcpy(yylval.na,fortran_text); return TOK_ENDUNIT;}
+include                     { pos_curinclude = setposcur()-9; return TOK_INCLUDE;}
+^[ \t]*use[ ]+              { strcpy(yylval.na,fortran_text);
+                              tmpc = (char) input(); unput(tmpc);
+                              if ( ( tmpc >= 'a' && tmpc <= 'z' ) ||
+                                   ( tmpc >= 'A' && tmpc <= 'Z' )  )  return TOK_USE;
+                              else                                    return TOK_NAME;
+                            }
+rewind                      { return TOK_REWIND; }
+implicit                    { return TOK_IMPLICIT; }
+none                        { return TOK_NONE; }
+call                        { return TOK_CALL; }
+.true.                      { return TOK_TRUE; }
+.false.                     { return TOK_FALSE; }
+\=\>                        { return TOK_POINT_TO; }
+{ASSIGNTYPE}                { strcpy(yylval.na,fortran_text); return TOK_ASSIGNTYPE;}
+\*\*                        { strcpy(yylval.na,fortran_text); return TOK_DASTER; }
+\.[ \t]*eqv\.               { strcpy(yylval.na,fortran_text); return TOK_EQV; }
+\.[ \t]*eq\.                { strcpy(yylval.na,fortran_text); return TOK_EQ;  }
+\.[ \t]*gt\.                { strcpy(yylval.na,fortran_text); return TOK_GT;  }
+\.[ \t]*ge\.                { strcpy(yylval.na,fortran_text); return TOK_GE;  }
+\.[ \t]*lt\.                { strcpy(yylval.na,fortran_text); return TOK_LT;  }
+\.[ \t]*le\.                { strcpy(yylval.na,fortran_text); return TOK_LE;  }
+\.[ \t]*neqv\.              { strcpy(yylval.na,fortran_text); return TOK_NEQV;}
+\.[ \t]*ne\.                { strcpy(yylval.na,fortran_text); return TOK_NE;  }
+\.[ \t]*not\.               { strcpy(yylval.na,fortran_text); return TOK_NOT; }
+\.[ \t]*or\.                { strcpy(yylval.na,fortran_text); return TOK_OR;  }
+\.[ \t]*xor\.               { strcpy(yylval.na,fortran_text); return TOK_XOR; }
+\.[ \t]*and\.               { strcpy(yylval.na,fortran_text); return TOK_AND; }
+module                      { return TOK_MODULE; }
+while                       { return TOK_WHILE; }
+concurrent                  { return TOK_CONCURRENT; }
+end[ \t]*do                 { return TOK_ENDDO; }
+do                          { return TOK_PLAINDO;}
+real                        { strcpy(yylval.na,fortran_text); return TOK_REAL; }
+integer                     { strcpy(yylval.na,fortran_text); return TOK_INTEGER; }
+logical                     { strcpy(yylval.na,fortran_text); return TOK_LOGICAL; }
+character                   { strcpy(yylval.na,fortran_text); return TOK_CHARACTER; }
+{HEXA}                      { strcpy(yylval.na,fortran_text); return TOK_HEXA;}
+double[ \t]*precision       { strcpy(yylval.na,fortran_text); return TOK_DOUBLEPRECISION; }
+double[ \t]*complex         { strcpy(yylval.na,fortran_text); return TOK_DOUBLECOMPLEX; }
+complex                     { return TOK_COMPLEX; }
+allocatable                 { return TOK_ALLOCATABLE; }
+close                       { return TOK_CLOSE; }
+inquire                     { return TOK_INQUIRE; }
+dimension                   { return TOK_DIMENSION; }
+pause                       { return TOK_PAUSE; }
+equivalence                 { return TOK_EQUIVALENCE; }
+stop                        { return TOK_STOP; }
+where                       { return TOK_WHERE; }
+end[ \t]*where              { return TOK_ENDWHERE; }
+else[ \t]*where[ \t]*\(     { return TOK_ELSEWHEREPAR; }
+else[ \t]*where             { return TOK_ELSEWHERE; }
+^[ \t]*contains             { return TOK_CONTAINS; }
+only                        { return TOK_ONLY; }
+parameter                   { return TOK_PARAMETER; }
+recursive                   { return TOK_RECURSIVE; }
+common                      { return TOK_COMMON; }
+^[ \t]*global[ \t]+         { return TOK_GLOBAL; }
+external                    { return TOK_EXTERNAL; }
+intent                      { return TOK_INTENT; }
+pointer                     { return TOK_POINTER; }
+optional                    { return TOK_OPTIONAL; }
+save                        { return TOK_SAVE; }
+^[ \t]*type[ \t]*\(         { pos_cur_decl = setposcur()-5; return TOK_TYPEPAR; }
+^[ \t]*type[ \t\,]+         { return TOK_TYPE; }
+end[ \t]*type               { return TOK_ENDTYPE; }
+stat                        { if (inallocate == 1) return TOK_STAT; else { strcpy(yylval.na,fortran_text); return TOK_NAME; } }
+open                        { return TOK_OPEN; }
+return                      { return TOK_RETURN; }
+exit[^(]                    { return TOK_EXIT; }
+print                       { return TOK_PRINT; }
+module[ \t]*procedure       { return TOK_PROCEDURE; }
+read                        { return TOK_READ; }
+namelist                    { return TOK_NAMELIST; }
+write                       { return TOK_WRITE; }
+flush                       { return TOK_FLUSH; }
+target                      { return TOK_TARGET; }
+public                      { return TOK_PUBLIC; }
+private                     { return TOK_PRIVATE; }
+in                          { strcpy(yylval.na,fortran_text); return TOK_IN; }
+^[ \t]*data[ \t]+           { pos_curdata = setposcur()-strlen(fortran_text); Init_List_Data_Var(); return TOK_DATA; }
+continue                    { return TOK_CONTINUE; }
+go[ \t]*to                  { return TOK_PLAINGOTO; }
+out                         { strcpy(yylval.na,fortran_text); return TOK_OUT; }
+inout                       { strcpy(yylval.na,fortran_text); return TOK_INOUT; }
+intrinsic                   { return TOK_INTRINSIC; }
+then                        { return TOK_THEN; }
+else[ \t]*if                { return TOK_ELSEIF; }
+else                        { return TOK_ELSE; }
+end[ \t]*if                 { return TOK_ENDIF; }
+if                          { return TOK_LOGICALIF; }
+sum[ \t]*\(                 { return TOK_SUM; }
+max[ \t]*\(                 { return TOK_MAX; }
+tanh                        { return TOK_TANH; }
+maxval                      { return TOK_MAXVAL; }
+trim                        { return TOK_TRIM; }
+sqrt\(                      { return TOK_SQRT; }
+select[ \t]*case            { return TOK_SELECTCASE; }
+^[ \t]*case[ \t]*           { return TOK_CASE; }
+default                     { return TOK_DEFAULT; }
+end[ \t]*select             { return TOK_ENDSELECT; }
+file[ \t]*\=                { return TOK_FILE; }
+unit[ \t]*\=                { return TOK_UNIT; }
+fmt[ \t]*\=                 { return TOK_FMT; }
+nml[ \t]*\=                 { return TOK_NML; }
+end[ \t]*\=                 { return TOK_END; }
+eor[ \t]*\=                 { return TOK_EOR; }
+err[ \t]*\=                 { return TOK_ERR; }
+exist[ \t]*\=               { return TOK_EXIST; }
+min[ \t]*\(                 { return TOK_MIN; }
+nint                        { return TOK_NINT; }
+float                       { return TOK_FLOAT; }
+exp                         { return TOK_EXP; }
+cos                         { return TOK_COS; }
+cosh                        { return TOK_COSH; }
+acos                        { return TOK_ACOS; }
+sin                         { return TOK_SIN; }
+sinh                        { return TOK_SINH; }
+asin                        { return TOK_ASIN; }
+log                         { return TOK_LOG; }
+tan                         { return TOK_TAN; }
+atan                        { return TOK_ATAN; }
+cycle                       { return TOK_CYCLE; }
+abs[ \t]*\(                 { return TOK_ABS; }
+mod                         { return TOK_MOD; }
+sign[ \t]*\(                { return TOK_SIGN; }
+minloc                      { return TOK_MINLOC; }
+maxloc                      { return TOK_MAXLOC; }
+minval                      { return TOK_MINVAL; }
+backspace                   { return TOK_BACKSPACE; }
+::                          { return TOK_FOURDOTS;  }
+\({SLASH}                   { return TOK_LEFTAB; }
+{SLASH}\)                   { return TOK_RIGHTAB; }
+format[ \t]*\((.|{NEXTLINEF90}|{NEXTLINEF77})*\)  {
+                              return TOK_FORMAT; }
+{SLASH}                     { strcpy(yylval.na,fortran_text); return TOK_SLASH; }
+DSLASH                      { strcpy(yylval.na,fortran_text); return TOK_DSLASH; }
+(\')[^']*&{0,1}\n[ \t]*&{0,1}[^']*(\') {
+                              strcpy(yylval.na,fortran_text); return TOK_CHAR_CUT; }
+(\')[^']*(\')             { strcpy(yylval.na,fortran_text);return TOK_CHAR_CONSTANT; }
+(\")[^"]*(\")             { strcpy(yylval.na,fortran_text);return TOK_CHAR_MESSAGE; }
+{BEG_INTERFACE}             { BEGIN(donottreat); }
+<donottreat>{END_INTERFACE} { out_of_donottreat(); return '\n'; }
+{NAME}                      { strcpy(yylval.na,fortran_text); return TOK_NAME; }
+({INTEGER}\.[0-9]*)/[^"and."|"false."|"true."|"eq."|"or."|"gt."|"ge."|"lt."|"le."|"not."|"ne."] {  // REAL1
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+(({INTEGER}\.[0-9]+|[0-9]*\.{INTEGER}){EXPONENT}?)|{INTEGER}(\.)?{EXPONENT}                     {  // REAL2
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+{INTEGER}                   { strcpy(yylval.na,fortran_text); return TOK_CSTINT; }
+\$                          {}
+\.                          {}
+\(|\)|:|\[|\]|\+|\-|\*      { strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+\%                          { strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+\;                          { return TOK_SEMICOLON; }
+\,                          { return (int) *fortran_text; }
+\=                          { return (int) *fortran_text; }
+\<                          { return (int) *fortran_text; }
+\>                          { return (int) *fortran_text; }
+\n                          { INCREMENT_LINE_NUM() ; return '\n'; }
+^[ ]*$                      {}
+[ \t]+                      {}
+{LABEL}                     { if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0; }
+{NEXTLINEF90}               { INCREMENT_LINE_NUM() ; newlinef90=1; }
+{NEXTLINEF77}               { INCREMENT_LINE_NUM() ; }
+
+{BEG_DNT}                   { INCREMENT_LINE_NUM() ; BEGIN(donottreat); }
+<donottreat>{END_DNT}       { out_of_donottreat(); return '\n'; }
+<donottreat>.*\n            { INCREMENT_LINE_NUM() ; }
+<fortran77style>{COMM_F77}  { INCREMENT_LINE_NUM() ; }
+{COMM_F90}                  { INCREMENT_LINE_NUM() ; }
+{COMM_F90_2}                {}
+%%
+
+void out_of_donottreat ( void )
+{
+    BEGIN(INITIAL);
+    if (infixed) BEGIN(fortran77style) ;
+    if (infree)  BEGIN(fortran90style) ;
+    INCREMENT_LINE_NUM() ;
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.y
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.y	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.y	(revision 6808)
@@ -0,0 +1,2225 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http ://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+
+%{
+#define YYMAXDEPTH 1000
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+extern int line_num_input;
+extern char *fortran_text;
+
+char c_selectorname[LONG_M];
+char ligne[LONG_M];
+char truename[LONG_VNAME];
+char identcopy[LONG_VNAME];
+int c_selectorgiven=0;
+listvar *curlistvar;
+typedim c_selectordim;
+listcouple *coupletmp;
+int removeline=0;
+listvar *test;
+
+int fortran_error(const char *s)
+{
+    printf("%s line %d, file %s motclef = |%s|\n", s, line_num_input, cur_filename, fortran_text);
+    exit(1);
+}
+
+%}
+
+%union {
+    char        na[LONG_M];
+    listdim     *d;
+    listvar     *l;
+    listcouple  *lc;
+    listname    *lnn;
+    typedim     dim1;
+    variable    *v;
+}
+
+%left ','
+%nonassoc ':'
+%right '='
+%left TOK_EQV TOK_NEQV
+%left TOK_OR TOK_XOR
+%left TOK_AND
+%left TOK_NOT
+%nonassoc TOK_LT TOK_GT TOK_LE TOK_GE TOK_EQ TOK_NE
+%left TOK_DSLASH
+%left '+' '-'
+%left '*' TOK_SLASH
+%right TOK_DASTER
+
+%token TOK_SEMICOLON
+%token TOK_PARAMETER
+%token TOK_RESULT
+%token TOK_ONLY
+%token TOK_INCLUDE
+%token TOK_SUBROUTINE
+%token TOK_PROGRAM
+%token TOK_FUNCTION
+%token TOK_FORMAT
+%token TOK_MAX
+%token TOK_TANH
+%token TOK_WHERE
+%token TOK_ELSEWHEREPAR
+%token TOK_ELSEWHERE
+%token TOK_ENDWHERE
+%token TOK_MAXVAL
+%token TOK_TRIM
+%token TOK_NULL_PTR
+%token TOK_SUM
+%token TOK_SQRT
+%token TOK_CASE
+%token TOK_SELECTCASE
+%token TOK_FILE
+%token TOK_UNIT
+%token TOK_FMT
+%token TOK_NML
+%token TOK_END
+%token TOK_EOR
+%token TOK_ERR
+%token TOK_EXIST
+%token TOK_MIN
+%token TOK_FLOAT
+%token TOK_EXP
+%token TOK_COS
+%token TOK_COSH
+%token TOK_ACOS
+%token TOK_NINT
+%token TOK_CYCLE
+%token TOK_SIN
+%token TOK_SINH
+%token TOK_ASIN
+%token TOK_EQUIVALENCE
+%token TOK_BACKSPACE
+%token TOK_LOG
+%token TOK_TAN
+%token TOK_ATAN
+%token TOK_RECURSIVE
+%token TOK_ABS
+%token TOK_MOD
+%token TOK_SIGN
+%token TOK_MINLOC
+%token TOK_MAXLOC
+%token TOK_EXIT
+%token TOK_MINVAL
+%token TOK_PUBLIC
+%token TOK_PRIVATE
+%token TOK_ALLOCATABLE
+%token TOK_RETURN
+%token TOK_THEN
+%token TOK_ELSEIF
+%token TOK_ELSE
+%token TOK_ENDIF
+%token TOK_PRINT
+%token TOK_PLAINGOTO
+%token TOK_LOGICALIF
+%token TOK_PLAINDO
+%token TOK_CONTAINS
+%token TOK_ENDDO
+%token TOK_MODULE
+%token TOK_ENDMODULE
+%token TOK_WHILE
+%token TOK_CONCURRENT
+%token TOK_ALLOCATE
+%token TOK_OPEN
+%token TOK_CLOSE
+%token TOK_INQUIRE
+%token TOK_WRITE
+%token TOK_FLUSH
+%token TOK_READ
+%token TOK_REWIND
+%token TOK_DEALLOCATE
+%token TOK_NULLIFY
+%token TOK_DIMENSION
+%token TOK_ENDSELECT
+%token TOK_EXTERNAL
+%token TOK_INTENT
+%token TOK_INTRINSIC
+%token TOK_NAMELIST
+%token TOK_DEFAULT
+%token TOK_OPTIONAL
+%token TOK_POINTER
+%token TOK_CONTINUE
+%token TOK_SAVE
+%token TOK_TARGET
+%token TOK_IMPLICIT
+%token TOK_NONE
+%token TOK_CALL
+%token TOK_STAT
+%token TOK_POINT_TO
+%token TOK_COMMON
+%token TOK_GLOBAL
+%token TOK_LEFTAB
+%token TOK_RIGHTAB
+%token TOK_PAUSE
+%token TOK_PROCEDURE
+%token TOK_STOP
+%token TOK_REAL8
+%token TOK_FOURDOTS
+%token <na> TOK_HEXA
+%token <na> TOK_ASSIGNTYPE
+%token <na> TOK_OUT
+%token <na> TOK_INOUT
+%token <na> TOK_IN
+%token <na> TOK_USE
+%token <na> TOK_DSLASH
+%token <na> TOK_DASTER
+%token <na> TOK_EQ
+%token <na> TOK_EQV
+%token <na> TOK_GT
+%token <na> TOK_LT
+%token <na> TOK_GE
+%token <na> TOK_NE
+%token <na> TOK_NEQV
+%token <na> TOK_LE
+%token <na> TOK_OR
+%token <na> TOK_XOR
+%token <na> TOK_NOT
+%token <na> TOK_AND
+%token <na> TOK_TRUE
+%token <na> TOK_FALSE
+%token <na> TOK_LABEL
+%token <na> TOK_TYPE
+%token <na> TOK_TYPEPAR
+%token <na> TOK_ENDTYPE
+%token <na> TOK_REAL
+%token <na> TOK_INTEGER
+%token <na> TOK_LOGICAL
+%token <na> TOK_DOUBLEPRECISION
+%token <na> TOK_ENDSUBROUTINE
+%token <na> TOK_ENDFUNCTION
+%token <na> TOK_ENDPROGRAM
+%token <na> TOK_ENDUNIT
+%token <na> TOK_CHARACTER
+%token <na> TOK_CHAR_CONSTANT
+%token <na> TOK_CHAR_CUT
+%token <na> TOK_DATA
+%token <na> TOK_CHAR_MESSAGE
+%token <na> TOK_CSTREAL
+%token <na> TOK_COMPLEX
+%token <na> TOK_DOUBLECOMPLEX
+%token <na> TOK_NAME
+%token <na> TOK_SLASH
+%token <na> TOK_CSTINT
+%token ','
+%token ':'
+%token '('
+%token ')'
+%token '<'
+%token '>'
+%type <l> dcl
+%type <l> after_type
+%type <l> dimension
+%type <l> paramlist
+%type <l> args
+%type <l> arglist
+%type <lc> only_list
+%type <lc> only_name
+%type <lc> rename_list
+%type <lc> rename_name
+%type <d> dims
+%type <d> dimlist
+%type <dim1> dim
+%type <v> paramitem
+%type <na> comblock
+%type <na> name_routine
+%type <na> opt_name
+%type <na> type
+%type <na> word_endsubroutine
+%type <na> word_endfunction
+%type <na> word_endprogram
+%type <na> word_endunit
+%type <na> typespec
+%type <na> string_constant
+%type <na> simple_const
+%type <na> ident
+%type <na> intent_spec
+%type <na> signe
+%type <na> opt_signe
+%type <na> filename
+%type <na> attribute
+%type <na> complex_const
+%type <na> begin_array
+%type <na> clause
+%type <na> arg
+%type <na> uexpr
+%type <na> minmaxlist
+%type <na> lhs
+%type <na> vec
+%type <na> outlist
+%type <na> other
+%type <na> dospec
+%type <na> expr_data
+%type <na> structure_component
+%type <na> array_ele_substring_func_ref
+%type <na> funarglist
+%type <na> funarg
+%type <na> funargs
+%type <na> triplet
+%type <na> substring
+%type <na> opt_substring
+%type <na> opt_expr
+%type <na> optexpr
+%type <lnn> data_stmt_value_list
+%type <lnn> datanamelist
+%type <na> after_slash
+%type <na> after_equal
+%type <na> predefinedfunction
+%type <na> expr
+%type <na> ubound
+%type <na> operation
+%type <na> proper_lengspec
+%type <lnn> use_name_list
+%type <lnn> public
+
+%%
+input :
+      | input line
+      ;
+line :  line-break
+      | suite_line_list
+      | TOK_LABEL suite_line_list
+      | error {yyerrok;yyclearin;}
+      ;
+line-break:
+        '\n' fin_line
+      | TOK_SEMICOLON
+      | line-break '\n' fin_line
+      | line-break TOK_SEMICOLON
+      | line-break TOK_LABEL
+      ;
+suite_line_list :
+        suite_line
+      | suite_line_list TOK_SEMICOLON '\n'
+      | suite_line_list TOK_SEMICOLON suite_line
+      ;
+suite_line :
+        entry fin_line     /* subroutine, function, module                    */
+      | spec fin_line      /* declaration                                     */
+      | TOK_INCLUDE filename fin_line
+        {
+            if (inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
+            }
+        }
+      | execution-part-construct
+      ;
+
+fin_line : { pos_cur = setposcur(); }
+      ;
+
+opt_recursive :         { isrecursive = 0; }
+      | TOK_RECURSIVE   { isrecursive = 1; }
+      ;
+
+opt_result :                                { is_result_present = 0; }
+      | TOK_RESULT arglist_after_result     { is_result_present = 1; }
+      ;
+
+entry : opt_recursive TOK_SUBROUTINE name_routine arglist
+        {
+            insubroutinedeclare = 1;
+            if ( firstpass )
+                Add_SubroutineArgument_Var_1($4);
+            else
+                WriteBeginof_SubLoop();
+        }
+      | TOK_PROGRAM name_routine
+        {
+            insubroutinedeclare = 1;
+            inprogramdeclare = 1;
+            /* in the second step we should write the head of       */
+            /*    the subroutine sub_loop_<subroutinename>          */
+            if ( ! firstpass )
+                WriteBeginof_SubLoop();
+        }
+      | opt_recursive TOK_FUNCTION name_routine arglist opt_result
+        {
+            insubroutinedeclare = 1;
+            strcpy(DeclType, "");
+            /* we should to list of the subroutine argument the  */
+            /*    name of the function which has to be defined   */
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1($4);
+                if ( ! is_result_present )
+                    Add_FunctionType_Var_1($3);
+            }
+            else
+            /* in the second step we should write the head of    */
+            /*    the subroutine sub_loop_<subroutinename>       */
+                WriteBeginof_SubLoop();
+        }
+      | TOK_MODULE TOK_NAME
+        {
+            GlobalDeclaration = 0;
+            strcpy(curmodulename,$2);
+            strcpy(subroutinename,"");
+            Add_NameOfModule_1($2);
+            if ( inmoduledeclare == 0 )
+            {
+                /* To know if there are in the module declaration    */
+                inmoduledeclare = 1;
+                /* to know if a module has been met                  */
+                inmodulemeet = 1;
+                /* to know if we are after the keyword contains      */
+                aftercontainsdeclare = 0 ;
+            }
+        }
+      ;
+
+/* R312 : label */
+label: TOK_CSTINT
+     | label TOK_CSTINT
+     ;
+
+name_routine :  TOK_NAME    { strcpy($$, $1); strcpy(subroutinename, $1); }
+      ;
+filename :      TOK_CHAR_CONSTANT { Add_Include_1($1); }
+      ;
+arglist :               { if ( firstpass ) $$=NULL; }
+      | '(' ')'         { if ( firstpass ) $$=NULL; }
+      | '(' args ')'    { if ( firstpass ) $$=$2; }
+      ;
+arglist_after_result:
+      | '(' ')'
+      | '(' args ')'    { if ( firstpass ) Add_SubroutineArgument_Var_1($2); }
+      ;
+args :  arg
+        {
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar($1,NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                curlistvar = insertvar(NULL,curvar);
+                $$ = settype("",curlistvar);
+            }
+        }
+      | args ',' arg
+        {
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar($3,NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                $$ = insertvar($1,curvar);
+            }
+        }
+      ;
+arg : TOK_NAME  { strcpy($$,$1);  }
+      | '*'     { strcpy($$,"*"); }
+      ;
+spec :  type after_type
+      | TOK_TYPE opt_spec opt_sep opt_name  { inside_type_declare = 1; }
+      | TOK_ENDTYPE opt_name                { inside_type_declare = 0; }
+      | TOK_POINTER list_couple
+      | before_parameter '(' paramlist ')'
+        {
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1($3);
+                    else                        Add_GlobalParameter_Var_1($3);
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out, pos_cur_decl, pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+      | before_parameter paramlist
+        {
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1($2);
+                    else                        Add_GlobalParameter_Var_1($2);
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+      | common
+      | save
+        {
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave);
+        }
+      | implicit
+      | dimension
+        {
+            /* if the variable is a parameter we can suppose that is   */
+            /*    value is the same on each grid. It is not useless to */
+            /*    create a copy of it on each grid                     */
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    Add_Globliste_1($1);
+                    /* if variableparamlists has been declared in a subroutine   */
+                    if ( insubroutinedeclare )     Add_Dimension_Var_1($1);
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension);
+                }
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+        }
+      | public
+        {
+            if (firstpass == 0)
+            {
+                if ($1)
+                {
+                    removeglobfromlist(&($1));
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur);
+                    writelistpublic($1);
+                }
+            }
+        }
+      | private
+      | use_stat
+      | module_proc_stmt
+      | namelist
+      | TOK_BACKSPACE '(' expr ')'
+      | TOK_EXTERNAL opt_sep use_name_list
+      | TOK_INTRINSIC opt_sep use_intrinsic_list
+      | TOK_EQUIVALENCE list_expr_equi
+      | data_stmt '\n'
+        {
+            /* we should remove the data declaration                */
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata);
+
+            if ( aftercontainsdeclare == 1  && firstpass == 0 )
+            {
+                ReWriteDataStatement_0(fortran_out);
+                pos_end = setposcur();
+            }
+        }
+      ;
+opt_spec :
+      | access_spec
+        {
+            PublicDeclare = 0 ;
+            PrivateDeclare = 0 ;
+        }
+      ;
+name_intrinsic :
+        TOK_SUM
+      | TOK_TANH
+      | TOK_MAXVAL
+      | TOK_MIN
+      | TOK_MINVAL
+      | TOK_TRIM
+      | TOK_SQRT
+      | TOK_NINT
+      | TOK_FLOAT
+      | TOK_EXP
+      | TOK_COS
+      | TOK_COSH
+      | TOK_ACOS
+      | TOK_SIN
+      | TOK_SINH
+      | TOK_ASIN
+      | TOK_LOG
+      | TOK_TAN
+      | TOK_ATAN
+      | TOK_MOD
+      | TOK_SIGN
+      | TOK_MINLOC
+      | TOK_MAXLOC
+      | TOK_NAME
+      ;
+use_intrinsic_list :
+                               name_intrinsic
+      | use_intrinsic_list ',' name_intrinsic
+      ;
+list_couple :
+                        '(' list_expr ')'
+      | list_couple ',' '(' list_expr ')'
+      ;
+list_expr_equi :
+                           expr_equi
+      | list_expr_equi ',' expr_equi
+      ;
+expr_equi : '(' list_expr_equi1 ')'
+      ;
+list_expr_equi1 :
+                            ident dims
+      | list_expr_equi1 ',' ident dims
+      ;
+list_expr :
+                      expr
+      | list_expr ',' expr
+      ;
+opt_sep :
+      | TOK_FOURDOTS
+      ;
+after_type :
+        dcl nodimsgiven
+        {
+            /* if the variable is a parameter we can suppose that is*/
+            /*    value is the same on each grid. It is not useless */
+            /*    to create a copy of it on each grid               */
+            if ( ! inside_type_declare )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                ReWriteDeclarationAndAddTosubroutine_01($1);
+                pos_cur_decl = setposcur();
+                if ( firstpass == 0 && GlobalDeclaration == 0
+                                    && insubroutinedeclare == 0 )
+                {
+                    fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename);
+                    sprintf(ligne, "Module_Declar_%s.h", curmodulename);
+                    module_declar = open_for_write(ligne);
+                    GlobalDeclaration = 1 ;
+                    pos_cur_decl = setposcur();
+                }
+                $$ = $1;
+
+                if ( firstpass )
+                {
+                    Add_Globliste_1($1);
+                    if ( insubroutinedeclare )
+                    {
+                        if ( pointerdeclare ) Add_Pointer_Var_From_List_1($1);
+                        Add_Parameter_Var_1($1);
+                    }
+                    else
+                        Add_GlobalParameter_Var_1($1);
+
+                    /* If there's a SAVE declaration in module's subroutines we should    */
+                    /*    remove it from the subroutines declaration and add it in the    */
+                    /*    global declarations                                             */
+                    if ( aftercontainsdeclare && SaveDeclare )
+                    {
+                        if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1($1);
+                        else                Add_Save_Var_dcl_1($1);
+                    }
+                }
+            }
+            else
+            {
+                $$ = (listvar *) NULL;
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+            GlobalDeclarationType = 0;
+        }
+      | before_function name_routine arglist
+        {
+            insubroutinedeclare = 1;
+
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1($3);
+                Add_FunctionType_Var_1($2);
+            }
+            else
+                WriteBeginof_SubLoop();
+
+            strcpy(nameinttypename,"");
+        }
+      ;
+before_function :   TOK_FUNCTION    { functiondeclarationisdone = 1; }
+      ;
+before_parameter :  TOK_PARAMETER   { VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
+      ;
+
+data_stmt :             /* R534 */
+        TOK_DATA data_stmt_set_list
+
+data_stmt_set_list :
+        data_stmt_set
+      | data_stmt_set_list opt_comma data_stmt_set
+
+data_stmt_set :         /* R535 */
+        TOK_NAME TOK_SLASH data_stmt_value_list TOK_SLASH
+        {
+            createstringfromlistname(ligne,$3);
+            if (firstpass == 1) Add_Data_Var_1(&List_Data_Var,$1,ligne);
+            else                Add_Data_Var_1(&List_Data_Var_Cur,$1,ligne);
+        }
+      | datanamelist TOK_SLASH data_stmt_value_list TOK_SLASH
+        {
+            if (firstpass == 1)  Add_Data_Var_Names_01(&List_Data_Var,$1,$3);
+            else                 Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3);
+        }
+      | '(' lhs ',' dospec ')' TOK_SLASH data_stmt_value_list TOK_SLASH
+        {
+            createstringfromlistname(ligne,$7);
+            printf("###################################################################################################################\n");
+            printf("## CONV Error : data_implied_do statements (R537) are not yet supported. Please complain to the proper authorities.\n");
+            printf("l.%4d -- data_stmt_set : ( lhs , dospec ) /data_stmt_value_list/ -- lhs=|%s| dospec=|%s| data_stmt_value_list=|%s|\n",
+                line_num_input,$2,$4,ligne);
+            printf("## But, are you SURE you NEED a DATA construct ?\n");
+            printf("###################################################################################################################\n");
+            exit(1);
+        }
+      ;
+
+data_stmt_value_list :
+        expr_data                           { $$ = Insertname(NULL,$1,0); }
+      | expr_data ',' data_stmt_value_list  { $$ = Insertname($3,$1,1);   }
+      ;
+
+save :  before_save varsave
+      | before_save comblock varsave
+      | save opt_comma comblock opt_comma varsave
+      | save ',' varsave
+      ;
+before_save :
+        TOK_SAVE        { pos_cursave = setposcur()-4; }
+      ;
+varsave :
+      | TOK_NAME dims   { if ( ! inside_type_declare ) Add_Save_Var_1($1,$2); }
+      ;
+datanamelist :
+        TOK_NAME                        { $$ = Insertname(NULL,$1,0); }
+      | TOK_NAME '(' expr ')'           { printf("l.%4d -- INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n",line_num_input); exit(0); }
+      | datanamelist ',' datanamelist   { $$ = concat_listname($1,$3); }
+      ;
+expr_data :
+        opt_signe simple_const      { sprintf($$,"%s%s",$1,$2);  }
+      | expr_data '+' expr_data     { sprintf($$,"%s+%s",$1,$3); }
+      | expr_data '-' expr_data     { sprintf($$,"%s-%s",$1,$3); }
+      | expr_data '*' expr_data     { sprintf($$,"%s*%s",$1,$3); }
+      | expr_data '/' expr_data     { sprintf($$,"%s/%s",$1,$3); }
+      ;
+opt_signe :     { strcpy($$,""); }
+      | signe   { strcpy($$,$1); }
+      ;
+namelist :
+        TOK_NAMELIST ident
+      | TOK_NAMELIST comblock ident
+      | namelist opt_comma comblock opt_comma ident
+      | namelist ',' ident
+      ;
+before_dimension :
+        TOK_DIMENSION
+        {
+            positioninblock = 0;
+            pos_curdimension = setposcur()-9;
+        }
+
+dimension :
+        before_dimension opt_comma TOK_NAME dims lengspec
+        {
+            printf("l.%4d -- dimension : before_dimension opt_comma TOK_NAME = |%s| -- MHCHECK\n",line_num_input,$3);
+            if ( inside_type_declare ) break;
+            curvar = createvar($3,$4);
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar=insertvar(NULL, curvar);
+            $$ = settype("",curlistvar);
+            strcpy(vallengspec,"");
+        }
+      | dimension ',' TOK_NAME dims lengspec
+        {
+            printf("l.%4d -- dimension : dimension ',' TOK_NAME dims lengspec = |%s| -- MHCHECK\n",line_num_input,$3);
+            if ( inside_type_declare ) break;
+            curvar = createvar($3,$4);
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar = insertvar($1, curvar);
+            $$ = curlistvar;
+            strcpy(vallengspec,"");
+        }
+      ;
+private :
+        TOK_PRIVATE '\n'
+      | TOK_PRIVATE opt_sep use_name_list
+      ;
+public :
+        TOK_PUBLIC '\n'                     { $$ = (listname *) NULL; }
+      | TOK_PUBLIC opt_sep use_name_list    { $$ = $3; }
+      ;
+use_name_list :
+        TOK_NAME                            { $$ = Insertname(NULL,$1,0); }
+      | TOK_ASSIGNTYPE                      { $$ = Insertname(NULL,$1,0); }
+      | use_name_list ',' TOK_NAME          { $$ = Insertname($1,$3,0);   }
+      | use_name_list ',' TOK_ASSIGNTYPE    { $$ = Insertname($1,$3,0);   }
+      ;
+common :
+        before_common var_common_list
+        {
+            if ( inside_type_declare ) break;
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+      | before_common comblock var_common_list
+        {
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",$2);
+            Add_NameOfCommon_1($2,subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+      | common opt_comma comblock opt_comma var_common_list
+        {
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",$3);
+            Add_NameOfCommon_1($3,subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+      ;
+before_common :
+        TOK_COMMON              { positioninblock = 0; pos_curcommon = setposcur()-6;   }
+      | TOK_GLOBAL TOK_COMMON   { positioninblock = 0; pos_curcommon = setposcur()-6-7; }
+      ;
+var_common_list :
+        var_common                      { if ( ! inside_type_declare ) Add_Common_var_1(); }
+      | var_common_list ',' var_common  { if ( ! inside_type_declare ) Add_Common_var_1(); }
+      ;
+var_common :
+        TOK_NAME dims
+        {
+            positioninblock = positioninblock + 1 ;
+            strcpy(commonvar,$1);
+            commondim = $2;
+        }
+      ;
+comblock :
+        TOK_DSLASH
+        {
+            strcpy($$,"");
+            positioninblock=0;
+            strcpy(commonblockname,"");
+        }
+      | TOK_SLASH TOK_NAME TOK_SLASH
+        {
+            strcpy($$,$2);
+            positioninblock=0;
+            strcpy(commonblockname,$2);
+        }
+      ;
+opt_comma :
+      | ','
+      ;
+paramlist :
+        paramitem                   { $$=insertvar(NULL,$1); }
+      | paramlist ',' paramitem     { $$=insertvar($1,$3);   }
+      ;
+paramitem :
+        TOK_NAME '=' expr
+        {
+            if ( inside_type_declare ) break;
+            curvar=(variable *) calloc(1,sizeof(variable));
+            Init_Variable(curvar);
+            curvar->v_VariableIsParameter = 1;
+            strcpy(curvar->v_nomvar,$1);
+            strcpy(curvar->v_subroutinename,subroutinename);
+            strcpy(curvar->v_modulename,curmodulename);
+            strcpy(curvar->v_initialvalue,$3);
+            strcpy(curvar->v_commoninfile,cur_filename);
+            Save_Length($3,14);
+            $$ = curvar;
+        }
+      ;
+module_proc_stmt :
+        TOK_PROCEDURE proc_name_list
+      ;
+proc_name_list :
+        TOK_NAME
+      | proc_name_list ',' TOK_NAME
+      ;
+implicit :
+        TOK_IMPLICIT TOK_NONE
+        {
+            if ( insubroutinedeclare == 1 )
+            {
+                Add_ImplicitNoneSubroutine_1();
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_end-13,13);
+            }
+        }
+      | TOK_IMPLICIT TOK_REAL8
+      ;
+dcl :   options TOK_NAME dims lengspec initial_value
+        {
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar($2,curdim);
+                else                curvar = createvar($2,$3);
+                CreateAndFillin_Curvar(DeclType, curvar);
+                curlistvar = insertvar(NULL, curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                $$=settype(DeclType,curlistvar);
+            }
+            strcpy(vallengspec,"");
+        }
+      | dcl ',' TOK_NAME dims lengspec initial_value
+        {
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar($3, curdim);
+                else                curvar = createvar($3, $4);
+                CreateAndFillin_Curvar($1->var->v_typevar,curvar);
+                strcpy(curvar->v_typevar, $1->var->v_typevar);
+                curvar->v_catvar = get_cat_var(curvar);
+                curlistvar = insertvar($1, curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                $$=curlistvar;
+            }
+            strcpy(vallengspec,"");
+        }
+      ;
+nodimsgiven : { dimsgiven = 0; }
+      ;
+type :  typespec selector               { strcpy(DeclType,$1);  }
+      | before_character c_selector     { strcpy(DeclType,"character");  }
+      | typespec '*' TOK_CSTINT         { strcpy(DeclType,$1); strcpy(nameinttypename,$3);  }
+      | TOK_TYPEPAR attribute ')'       { strcpy(DeclType,"type"); GlobalDeclarationType = 1;  }
+      ;
+c_selector :
+      | '*' TOK_CSTINT              { c_selectorgiven = 1; strcpy(c_selectorname,$2); }
+      | '*' '(' c_attribute ')'     { c_star = 1;}
+      | '(' c_attribute ')'
+      ;
+c_attribute :
+        TOK_NAME clause opt_clause
+      | TOK_NAME '=' clause opt_clause
+      | clause opt_clause
+      ;
+before_character : TOK_CHARACTER    { pos_cur_decl = setposcur()-9; }
+      ;
+typespec :
+        TOK_INTEGER         { strcpy($$,"integer"); pos_cur_decl = setposcur()-7; }
+      | TOK_LOGICAL         { strcpy($$,"logical"); pos_cur_decl = setposcur()-7; }
+      | TOK_REAL            { strcpy($$,"real");    pos_cur_decl = setposcur()-4; }
+      | TOK_COMPLEX         { strcpy($$,"complex"); pos_cur_decl = setposcur()-7; }
+      | TOK_DOUBLECOMPLEX   { strcpy($$,"double complex"); pos_cur_decl = setposcur()-14; }
+      | TOK_DOUBLEPRECISION { pos_cur_decl = setposcur()-16; strcpy($$,"real"); strcpy(nameinttypename,"8"); }
+      ;
+lengspec :
+      | '*' proper_lengspec {strcpy(vallengspec,$2);}
+      ;
+proper_lengspec :
+        expr        { sprintf($$,"*%s",$1); }
+      | '(' '*' ')' { strcpy($$,"*(*)"); }
+      ;
+selector :
+      | '*' proper_selector
+      | '(' attribute ')'
+      ;
+proper_selector : expr
+      | '(' '*' ')'
+      ;
+attribute :
+        TOK_NAME clause
+      | TOK_NAME '=' clause
+        {
+            if ( strstr($3,"0.d0") )
+            {
+                strcpy(nameinttypename,"8");
+                strcpy(NamePrecision,"");
+            }
+            else
+                sprintf(NamePrecision,"%s = %s",$1,$3);
+        }
+      | TOK_NAME        { strcpy(NamePrecision,$1); }
+      | TOK_CSTINT      { strcpy(NamePrecision,$1); }
+      | TOK_ASSIGNTYPE  { strcpy(NamePrecision,$1); }
+      ;
+clause :
+        expr   { strcpy(CharacterSize,$1);  strcpy($$,$1);  }
+      | '*'    { strcpy(CharacterSize,"*"); strcpy($$,"*"); }
+      ;
+opt_clause :
+      | ',' TOK_NAME clause
+      ;
+options :
+      | TOK_FOURDOTS
+      | ',' attr_spec_list TOK_FOURDOTS
+      ;
+attr_spec_list : attr_spec
+      | attr_spec_list ',' attr_spec
+      ;
+attr_spec :
+        TOK_PARAMETER       { VariableIsParameter = 1; }
+      | access_spec
+      | TOK_ALLOCATABLE     { Allocatabledeclare = 1; }
+      | TOK_DIMENSION dims  { dimsgiven = 1; curdim = $2; }
+      | TOK_EXTERNAL        { ExternalDeclare = 1; }
+      | TOK_INTENT '(' intent_spec ')'
+                            { strcpy(IntentSpec,$3); }
+      | TOK_INTRINSIC
+      | TOK_OPTIONAL        { optionaldeclare = 1 ; }
+      | TOK_POINTER         { pointerdeclare = 1 ; }
+      | TOK_SAVE            { SaveDeclare = 1 ; }
+      | TOK_TARGET          { Targetdeclare = 1; }
+      ;
+intent_spec :
+        TOK_IN          { strcpy($$,$1); }
+      | TOK_OUT         { strcpy($$,$1); }
+      | TOK_INOUT       { strcpy($$,$1); }
+      ;
+access_spec :
+        TOK_PUBLIC      { PublicDeclare = 1;  }
+      | TOK_PRIVATE     { PrivateDeclare = 1; }
+      ;
+dims :  { $$ = (listdim*) NULL; }
+      | '(' dimlist ')'
+        {
+            $$ = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=$2;
+        }
+      ;
+dimlist :
+        dim
+        {
+            $$ = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1);
+        }
+      | dimlist ',' dim
+        {
+            $$ = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3);
+        }
+      ;
+dim :   ubound              { strcpy($$.first,"1"); strcpy($$.last,$1); Save_Length($1,1); }
+      | ':'                 { strcpy($$.first,"");  strcpy($$.last,"");                    }
+      | expr ':'            { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,""); }
+      | ':' expr            { strcpy($$.first,"");  strcpy($$.last,$2); Save_Length($2,1); }
+      | expr ':' ubound     { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,$3); Save_Length($3,1); }
+      ;
+ubound :
+        '*'                 { strcpy($$,"*"); }
+      | expr                { strcpy($$,$1);  }
+      ;
+expr :  uexpr               { strcpy($$,$1); }
+      | complex_const       { strcpy($$,$1); }
+      | predefinedfunction  { strcpy($$,$1); }
+      | '(' expr ')'        { sprintf($$,"(%s)",$2); }
+      ;
+
+predefinedfunction :
+        TOK_SUM minmaxlist ')'          { sprintf($$,"SUM(%s)",$2);}
+      | TOK_MAX minmaxlist ')'          { sprintf($$,"MAX(%s)",$2);}
+      | TOK_TANH '(' minmaxlist ')'     { sprintf($$,"TANH(%s)",$3);}
+      | TOK_MAXVAL '(' minmaxlist ')'   { sprintf($$,"MAXVAL(%s)",$3);}
+      | TOK_MIN minmaxlist ')'          { sprintf($$,"MIN(%s)",$2);}
+      | TOK_MINVAL '(' minmaxlist ')'   { sprintf($$,"MINVAL(%s)",$3);}
+      | TOK_TRIM '(' expr ')'           { sprintf($$,"TRIM(%s)",$3);}
+      | TOK_SQRT expr ')'               { sprintf($$,"SQRT(%s)",$2);}
+      | TOK_REAL '(' minmaxlist ')'     { sprintf($$,"REAL(%s)",$3);}
+      | TOK_NINT '(' expr ')'           { sprintf($$,"NINT(%s)",$3);}
+      | TOK_FLOAT '(' expr ')'          { sprintf($$,"FLOAT(%s)",$3);}
+      | TOK_EXP '(' expr ')'            { sprintf($$,"EXP(%s)",$3);}
+      | TOK_COS '(' expr ')'            { sprintf($$,"COS(%s)",$3);}
+      | TOK_COSH '(' expr ')'           { sprintf($$,"COSH(%s)",$3);}
+      | TOK_ACOS '(' expr ')'           { sprintf($$,"ACOS(%s)",$3);}
+      | TOK_SIN '(' expr ')'            { sprintf($$,"SIN(%s)",$3);}
+      | TOK_SINH '(' expr ')'           { sprintf($$,"SINH(%s)",$3);}
+      | TOK_ASIN '(' expr ')'           { sprintf($$,"ASIN(%s)",$3);}
+      | TOK_LOG '(' expr ')'            { sprintf($$,"LOG(%s)",$3);}
+      | TOK_TAN '(' expr ')'            { sprintf($$,"TAN(%s)",$3);}
+      | TOK_ATAN '(' expr ')'           { sprintf($$,"ATAN(%s)",$3);}
+      | TOK_ABS expr ')'                { sprintf($$,"ABS(%s)",$2);}
+      | TOK_MOD '(' minmaxlist ')'      { sprintf($$,"MOD(%s)",$3);}
+      | TOK_SIGN minmaxlist ')'         { sprintf($$,"SIGN(%s)",$2);}
+      | TOK_MINLOC '(' minmaxlist ')'   { sprintf($$,"MINLOC(%s)",$3);}
+      | TOK_MAXLOC '(' minmaxlist ')'   { sprintf($$,"MAXLOC(%s)",$3);}
+      ;
+minmaxlist : expr {strcpy($$,$1);}
+      | minmaxlist ',' expr     { sprintf($$,"%s,%s",$1,$3); }
+      ;
+uexpr : lhs                     { strcpy($$,$1); }
+      | simple_const            { strcpy($$,$1); }
+      | vec                     { strcpy($$,$1); }
+      | expr operation          { sprintf($$,"%s%s",$1,$2); }
+      | signe expr %prec '*'    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_NOT expr            { sprintf($$,"%s%s",$1,$2); }
+      ;
+signe : '+'        { strcpy($$,"+"); }
+      | '-'        { strcpy($$,"-"); }
+      ;
+
+operation :
+        '+' expr %prec '+'          { sprintf($$,"+%s",$2); }
+      | '-' expr %prec '+'          { sprintf($$,"-%s",$2); }
+      | '*' expr                    { sprintf($$,"*%s",$2); }
+      | TOK_DASTER expr             { sprintf($$,"%s%s",$1,$2); }
+      | TOK_EQ expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_EQV expr %prec TOK_EQV  { sprintf($$,"%s%s",$1,$2); }
+      | TOK_GT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | '>' expr %prec TOK_EQ       { sprintf($$," > %s",$2); }
+      | '<' expr %prec TOK_EQ       { sprintf($$," < %s",$2); }
+      | '>''=' expr %prec TOK_EQ    { sprintf($$," >= %s",$3); }
+      | '<''=' expr %prec TOK_EQ    { sprintf($$," <= %s",$3); }
+      | TOK_LT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_GE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_LE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_NE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_NEQV expr %prec TOK_EQV { sprintf($$,"%s%s",$1,$2); }
+      | TOK_XOR expr                { sprintf($$,"%s%s",$1,$2); }
+      | TOK_OR expr                 { sprintf($$,"%s%s",$1,$2); }
+      | TOK_AND expr                { sprintf($$,"%s%s",$1,$2); }
+      | TOK_SLASH after_slash       { sprintf($$,"%s",$2); }
+      | '=' after_equal             { sprintf($$,"%s",$2); }
+
+after_slash :                   { strcpy($$,""); }
+      | expr                    { sprintf($$,"/%s",$1); }
+      | '=' expr %prec TOK_EQ   { sprintf($$,"/= %s",$2);}
+      | TOK_SLASH expr          { sprintf($$,"//%s",$2); }
+      ;
+after_equal :
+        '=' expr %prec TOK_EQ   { sprintf($$,"==%s",$2); }
+      | expr                    { sprintf($$,"= %s",$1); }
+      ;
+
+lhs :   ident                           { strcpy($$,$1); }
+      | structure_component             { strcpy($$,$1); }
+      | array_ele_substring_func_ref    { strcpy($$,$1); }
+      ;
+
+beforefunctionuse :
+        {
+            agrif_parentcall = 0;
+            if ( !strcasecmp(identcopy, "Agrif_Parent") )   agrif_parentcall = 1;
+            if ( Agrif_in_Tok_NAME(identcopy) )
+            {
+                inagrifcallargument = 1;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+      ;
+array_ele_substring_func_ref :
+        begin_array                                         { strcpy($$,$1); if ( incalldeclare == 0 ) inagrifcallargument = 0;   }
+      | begin_array substring                               { sprintf($$," %s %s ",$1,$2); }
+      | structure_component '(' funarglist ')'              { sprintf($$," %s ( %s )",$1,$3); }
+      | structure_component '(' funarglist ')' substring    { sprintf($$," %s ( %s ) %s ",$1,$3,$5); }
+      ;
+begin_array :
+        ident '(' funarglist ')'
+        {
+            if ( inside_type_declare ) break;
+            sprintf($$," %s ( %s )",$1,$3);
+            ModifyTheAgrifFunction_0($3);
+            agrif_parentcall = 0;
+        }
+      ;
+structure_component :
+        lhs '%' declare_after_percent lhs
+        {
+            sprintf($$," %s %% %s ",$1,$4);
+            if ( incalldeclare == 0 ) inagrifcallargument = 0;
+        }
+      ;
+vec :
+        TOK_LEFTAB outlist TOK_RIGHTAB   { sprintf($$,"(/%s/)",$2); }
+      ;
+funarglist :
+        beforefunctionuse           { strcpy($$," "); }
+      | beforefunctionuse funargs   { strcpy($$,$2); }
+      ;
+funargs :
+        funarg              {  strcpy($$,$1); }
+      | funargs ',' funarg  {  sprintf($$,"%s,%s",$1,$3); }
+      ;
+funarg :
+        expr       {strcpy($$,$1);}
+      | triplet    {strcpy($$,$1);}
+      ;
+triplet :
+        expr ':' expr           {  sprintf($$,"%s :%s",$1,$3);}
+      | expr ':' expr ':' expr  {  sprintf($$,"%s :%s :%s",$1,$3,$5);}
+      | ':' expr ':' expr       {  sprintf($$,":%s :%s",$2,$4);}
+      | ':' ':' expr            {  sprintf($$,": : %s",$3);}
+      | ':' expr                {  sprintf($$,":%s",$2);}
+      | expr ':'                {  sprintf($$,"%s :",$1);}
+      | ':'                     {  sprintf($$,":");}
+      ;
+ident : TOK_NAME
+        {
+            if ( afterpercent == 0 )
+            {
+                if ( Agrif_in_Tok_NAME($1) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+                if ( !strcasecmp($1,"Agrif_Parent") )   agrif_parentcall = 1;
+                if ( VariableIsFunction($1) )
+                {
+                    if ( inagrifcallargument == 1 )
+                    {
+                        if ( !strcasecmp($1,identcopy) )
+                        {
+                            strcpy(sameagrifname,identcopy);
+                            sameagrifargument = 1;
+                        }
+                    }
+                    strcpy(identcopy,$1);
+                    pointedvar = 0;
+
+                    if (variscoupled_0($1)) strcpy(truename, getcoupledname_0($1));
+                    else                    strcpy(truename, $1);
+
+                    if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) )
+                    {
+                        if ( inagrifcallargument == 1 || varispointer_0(truename) == 1 )
+                        {
+                            if ( (IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1) )
+                            {
+                                if (varistyped_0(truename) == 0)    ModifyTheVariableName_0(truename,strlen($1));
+                            }
+                        }
+                        if ( inagrifcallargument != 1 || sameagrifargument ==1 )
+                        {
+                            Add_UsedInSubroutine_Var_1(truename);
+                        }
+                    }
+                    NotifyAgrifFunction_0(truename);
+                }
+            }
+            else
+            {
+                afterpercent = 0;
+            }
+        }
+      ;
+simple_const :
+        TOK_TRUE     { strcpy($$,".TRUE.");}
+      | TOK_FALSE    { strcpy($$,".FALSE.");}
+      | TOK_NULL_PTR { strcpy($$,"NULL()"); }
+      | TOK_CSTINT   { strcpy($$,$1); }
+      | TOK_CSTREAL  { strcpy($$,$1); }
+      | TOK_HEXA     { strcpy($$,$1); }
+      | simple_const TOK_NAME
+                     { sprintf($$,"%s%s",$1,$2); }
+      | string_constant opt_substring
+      ;
+string_constant :
+        TOK_CHAR_CONSTANT                   { strcpy($$,$1);}
+      | string_constant TOK_CHAR_CONSTANT
+      | TOK_CHAR_MESSAGE                    { strcpy($$,$1);}
+      | TOK_CHAR_CUT                        { strcpy($$,$1);}
+      ;
+opt_substring :     { strcpy($$," ");}
+      | substring   { strcpy($$,$1);}
+      ;
+substring :
+        '(' optexpr ':' optexpr ')' { sprintf($$,"(%s :%s)",$2,$4);}
+      ;
+optexpr :           { strcpy($$," ");}
+      | expr        { strcpy($$,$1);}
+      ;
+opt_expr :
+        '\n'        { strcpy($$," ");}
+      | expr        { strcpy($$,$1);}
+      ;
+initial_value :     { InitialValueGiven = 0; }
+      | '=' expr
+        {
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,$2);
+            InitialValueGiven = 1;
+        }
+      | TOK_POINT_TO expr
+        {
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,$2);
+            InitialValueGiven = 2;
+        }
+      ;
+complex_const :
+        '(' uexpr ',' uexpr ')' {sprintf($$,"(%s,%s)",$2,$4); }
+      ;
+use_stat :
+        word_use TOK_NAME
+        {
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule, "%s", $2);
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1($2);
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuse_0($2);
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+      | word_use TOK_NAME ',' rename_list
+        {
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1($2,$4);
+                    coupletmp = $4;
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne, coupletmp->c_namevar);
+                        strcat(ligne, " => ");
+                        strcat(ligne, coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",$2);
+                }
+                Add_NameOfModuleUsed_1($2);
+            }
+            if ( inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+            }
+        }
+      | word_use TOK_NAME ',' TOK_ONLY ':' '\n'
+        {
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule,"%s",$2);
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1($2);
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuseonly_0($2);
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+      | word_use  TOK_NAME ',' TOK_ONLY ':' only_list
+        {
+            /* if variables has been declared in a subroutine      */
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1($2,$6);
+                    coupletmp = $6;
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne,coupletmp->c_namevar);
+                        if ( strcasecmp(coupletmp->c_namepointedvar,"") )   strcat(ligne," => ");
+                        strcat(ligne,coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",$2);
+                }
+                Add_NameOfModuleUsed_1($2);
+            }
+            else /* if ( firstpass == 0 ) */
+            {
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                    if (oldfortran_out)  variableisglobalinmodule($6,$2,oldfortran_out,pos_curuseold);
+                }
+                else
+                {
+                    /* if we are in the module declare and if the    */
+                    /* onlylist is a list of global variable         */
+                    variableisglobalinmodule($6, $2, fortran_out,pos_curuse);
+                }
+            }
+        }
+      ;
+word_use :
+        TOK_USE
+        {
+            pos_curuse = setposcur()-strlen($1);
+            if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);
+        }
+      ;
+rename_list :
+        rename_name
+        {
+            $$ = $1;
+        }
+      | rename_list ',' rename_name
+        {
+            /* insert the variable in the list $1                 */
+            $3->suiv = $1;
+            $$ = $3;
+        }
+      ;
+rename_name : TOK_NAME TOK_POINT_TO TOK_NAME
+        {
+            coupletmp = (listcouple *) calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,$3);
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+        }
+      ;
+only_list :
+        only_name   {  $$ = $1; }
+      | only_list ',' only_name
+        {
+            /* insert the variable in the list $1                 */
+            $3->suiv = $1;
+            $$ = $3;
+        }
+      ;
+only_name :
+        TOK_NAME TOK_POINT_TO TOK_NAME
+        {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,$3);
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+            pointedvar = 1;
+            Add_UsedInSubroutine_Var_1($1);
+        }
+      | TOK_NAME
+        {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,"");
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+        }
+      ;
+
+/* R209 : execution-part-construct */
+execution-part-construct:
+        executable-construct
+      | format-stmt
+      ;
+
+/* R213 : executable-construct */
+executable-construct:
+        action-stmt
+      | do-construct
+      | case-construct
+      | if-construct
+      | where-construct
+      ;
+
+/* R214 : action-stmt */
+action-stmt :
+        TOK_CONTINUE
+      | ident_dims after_ident_dims
+      | goto
+      | call
+      | iofctl ioctl
+      | read option_read
+      | TOK_WRITE ioctl
+      | TOK_WRITE ioctl outlist
+      | TOK_REWIND after_rewind
+      | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'          { inallocate = 0; }
+      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'   { inallocate = 0; }
+      | TOK_EXIT optexpr
+      | TOK_RETURN opt_expr
+      | TOK_CYCLE opt_expr
+      | stop opt_expr
+      | int_list
+      | TOK_NULLIFY '(' pointer_name_list ')'
+      | word_endunit
+        {
+            GlobalDeclaration = 0 ;
+            if ( firstpass == 0 && strcasecmp(subroutinename,"") )
+            {
+                if ( module_declar && insubroutinedeclare == 0 )    fclose(module_declar);
+            }
+            if ( strcasecmp(subroutinename,"") )
+            {
+                if ( inmodulemeet == 1 )
+                {
+                    /* we are in a module                                */
+                    if ( insubroutinedeclare == 1 )
+                    {
+                        /* it is like an end subroutine <name>            */
+                        insubroutinedeclare = 0 ;
+                        pos_cur = setposcur();
+                        closeandcallsubloopandincludeit_0(1);
+                        functiondeclarationisdone = 0;
+                    }
+                    else
+                    {
+                        /* it is like an end module <name>                */
+                        inmoduledeclare = 0 ;
+                        inmodulemeet = 0 ;
+                    }
+                }
+                else
+                {
+                    insubroutinedeclare = 0;
+                    pos_cur = setposcur();
+                    closeandcallsubloopandincludeit_0(2);
+                    functiondeclarationisdone = 0;
+                }
+            }
+            strcpy(subroutinename,"");
+        }
+      | word_endprogram opt_name
+        {
+            insubroutinedeclare = 0;
+            inprogramdeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(3);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+      | word_endsubroutine opt_name
+        {
+            if ( strcasecmp(subroutinename,"") )
+            {
+                insubroutinedeclare = 0;
+                pos_cur = setposcur();
+                closeandcallsubloopandincludeit_0(1);
+                functiondeclarationisdone = 0;
+                strcpy(subroutinename,"");
+            }
+        }
+      | word_endfunction opt_name
+        {
+            insubroutinedeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(0);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+      | TOK_ENDMODULE opt_name
+        {
+            /* if we never meet the contains keyword               */
+            if ( firstpass == 0 )
+            {
+                RemoveWordCUR_0(fortran_out, strlen($2)+11);    // Remove word "end module"
+                if ( inmoduledeclare && ! aftercontainsdeclare )
+                {
+                    Write_Closing_Module(1);
+                }
+                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
+                if ( module_declar && insubroutinedeclare == 0 )
+                {
+                    fclose(module_declar);
+                }
+            }
+            inmoduledeclare = 0 ;
+            inmodulemeet = 0 ;
+            aftercontainsdeclare = 1;
+            strcpy(curmodulename, "");
+            GlobalDeclaration = 0 ;
+        }
+      | if-stmt
+      | where-stmt
+      | TOK_CONTAINS
+        {
+            if ( inside_type_declare ) break;
+            if ( inmoduledeclare )
+            {
+                if ( firstpass == 0 )
+                {
+                    RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
+                    Write_Closing_Module(0);
+                }
+                inmoduledeclare = 0 ;
+                aftercontainsdeclare = 1;
+            }
+            else if ( insubroutinedeclare )
+            {
+                incontainssubroutine = 1;
+                insubroutinedeclare  = 0;
+                incontainssubroutine = 0;
+                functiondeclarationisdone = 0;
+
+                if ( firstpass )
+                    List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0);
+                else
+                    closeandcallsubloop_contains_0();
+
+                strcpy(subroutinename, "");
+            }
+            else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input);
+        }
+      ;
+
+/* R601 : variable */
+//variable : expr
+//       ;
+
+/* R734 : assignment-stmt */
+// assignment-stmt: variable '=' expr
+//       ;
+assignment-stmt: expr
+      ;
+
+/* R741 : where-stmt */
+where-stmt: TOK_WHERE '(' mask-expr ')' where-assignment-stmt
+      ;
+
+/* R742 : where-construct */
+where-construct: where-construct-stmt line-break opt-where-body-construct opt-masked-elsewhere-construct opt-elsewhere-construct end-where-stmt
+      ;
+
+opt-where-body-construct:
+      | opt-where-body-construct where-body-construct line-break
+      ;
+
+opt-masked-elsewhere-construct :
+      | opt-masked-elsewhere-construct masked-elsewhere-stmt line-break opt-where-body-construct
+      ;
+
+opt-elsewhere-construct:
+      | opt-elsewhere-construct elsewhere-stmt line-break opt-where-body-construct
+      ;
+
+/* R743 : where-construct-stmt */
+where-construct-stmt:
+        TOK_WHERE '(' mask-expr ')'
+      ;
+
+/* R744 : where-body-construct */
+where-body-construct: where-assignment-stmt
+      | where-stmt
+      | where-construct
+      ;
+
+/* R745 : where-assignment-stmt */
+where-assignment-stmt: assignment-stmt
+      ;
+
+/* R746 : mask-expr */
+mask-expr: expr
+      ;
+
+/* R747 : masked-elsewhere-stmt */
+masked-elsewhere-stmt:
+        TOK_ELSEWHEREPAR mask-expr ')'
+      | TOK_ELSEWHEREPAR mask-expr ')' TOK_NAME
+      ;
+
+/* R748: elsewhere-stmt */
+elsewhere-stmt:
+        TOK_ELSEWHERE
+      | TOK_ELSEWHERE TOK_NAME
+      ;
+
+/* R749: end-where-stmt */
+end-where-stmt:
+        TOK_ENDWHERE
+      | TOK_ENDWHERE TOK_NAME
+      ;
+
+/* R752 : forall-header */
+forall-header :
+     ;
+
+/* R801 : block */
+block:
+      |block execution-part-construct
+      |block execution-part-construct line-break
+      ;
+
+/* R813 : do-construct */
+do-construct:
+        block-do-construct
+      ;
+
+/* R814 : block-do-construct */
+block-do-construct:
+        do-stmt line-break do-block end-do
+      ;
+
+/* R815 : do-stmt */
+do-stmt:
+        label-do-stmt
+      | nonlabel-do-stmt
+      ;
+
+/* R816 : label-do-stmt */
+label-do-stmt:
+        TOK_NAME ':' TOK_PLAINDO label
+      |              TOK_PLAINDO label
+      | TOK_NAME ':' TOK_PLAINDO label loop-control
+      |              TOK_PLAINDO label loop-control
+      ;
+
+/* R817 : nonlabel-do-stmt */
+nonlabel-do-stmt:
+        TOK_NAME ':' TOK_PLAINDO
+      |              TOK_PLAINDO
+      | TOK_NAME ':' TOK_PLAINDO loop-control
+      |              TOK_PLAINDO loop-control
+      ;
+
+/* R818 : loop-control */
+loop-control:
+        opt_comma do-variable '=' expr ',' expr
+      | opt_comma do-variable '=' expr ',' expr ',' expr
+      | opt_comma TOK_WHILE '(' expr ')'
+      | opt_comma TOK_CONCURRENT forall-header
+      ;
+
+/* R819 : do-variable */
+do-variable : ident
+     ;
+
+/* R820 : do-block */
+do-block: block
+     ;
+
+/* R821 : end-do */
+end-do: end-do-stmt
+     | continue-stmt
+     ;
+
+/* R822 : end-do-stmt */
+end-do-stmt:
+        TOK_ENDDO
+      | TOK_ENDDO TOK_NAME
+      ;
+
+/* R832 : if-construct */
+if-construct: if-then-stmt line-break block opt-else-if-stmt-block opt-else-stmt-block end-if-stmt
+      ;
+
+opt-else-if-stmt-block:
+      | else-if-stmt-block
+      | opt-else-if-stmt-block else-if-stmt-block
+      ;
+
+else-if-stmt-block:
+        else-if-stmt line-break block
+      ;
+
+opt-else-stmt-block:
+      | else-stmt-block
+      | opt-else-stmt-block else-if-stmt-block
+      ;
+
+else-stmt-block: else-stmt line-break block
+        ;
+
+/* R833 : if-then-stmt */
+if-then-stmt:
+         TOK_NAME ':' TOK_LOGICALIF '(' expr ')' TOK_THEN
+      |               TOK_LOGICALIF '(' expr ')' TOK_THEN
+      ;
+
+/* R834 : else-if-stmt */
+else-if-stmt:
+        TOK_ELSEIF '(' expr ')' TOK_THEN
+      | TOK_ELSEIF '(' expr ')' TOK_THEN TOK_NAME
+      ;
+
+/* R835 : else-stmt */
+else-stmt:
+        TOK_ELSE
+      | TOK_ELSE TOK_NAME
+      ;
+
+/* R836 : end-if-stmt */
+end-if-stmt:
+        TOK_ENDIF
+      | TOK_ENDIF TOK_NAME
+      ;
+
+/* R837 : if-stmt */
+if-stmt: TOK_LOGICALIF '(' expr ')' action-stmt
+        ;
+
+/* R838 : case-construct */
+case-construct: select-case-stmt line-break opt_case-stmt-block end-select-stmt
+        ;
+
+opt_case-stmt-block:
+        | case-stmt-block
+        | opt_case-stmt-block case-stmt-block
+        ;
+
+case-stmt-block: case-stmt line-break block
+        ;
+
+/* R839 : select-case-stmt */
+select-case-stmt :
+          TOK_NAME ':' TOK_SELECTCASE '(' expr ')'
+        |              TOK_SELECTCASE '(' expr ')'
+        ;
+
+/* R840 : case-stmt */
+case-stmt:
+          TOK_CASE case-selector
+        | TOK_CASE case-selector TOK_NAME
+        ;
+
+/* R840 : end-select-stmt */
+end-select-stmt:
+          TOK_ENDSELECT
+        | TOK_ENDSELECT TOK_NAME
+        ;
+
+/* R843 : case-selector */
+case-selector:
+          '(' case-value-range-list ')'
+        | TOK_DEFAULT
+        ;
+
+case-value-range-list:
+        case-value-range
+      | case-value-range-list ',' case-value-range
+      ;
+
+/* R844: case-value-range */
+case-value-range :
+        case-value
+      | case-value ':'
+      | ':' case-value
+      | case-value ':' case-value
+      ;
+
+/* R845 : case-value */
+case-value: expr
+        ;
+
+/* R854 : continue-stmt */
+continue-stmt: TOK_CONTINUE
+        ;
+
+/* R1001 : format-stmt */
+format-stmt: TOK_FORMAT
+        ;
+
+word_endsubroutine :
+        TOK_ENDSUBROUTINE
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+            functiondeclarationisdone = 0;
+        }
+      ;
+word_endunit :
+        TOK_ENDUNIT
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+        }
+      ;
+word_endprogram :
+        TOK_ENDPROGRAM
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+        }
+      ;
+word_endfunction :
+        TOK_ENDFUNCTION
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+        }
+      ;
+
+opt_name : '\n'  {strcpy($$,"");}
+      | TOK_NAME {strcpy($$,$1);}
+      ;
+
+before_dims : { created_dimensionlist = 0; }
+      ;
+ident_dims :
+        ident before_dims dims dims
+        {
+            created_dimensionlist = 1;
+            if ( ($3 == NULL) || ($4 == NULL) ) break;
+            if  ( agrif_parentcall == 1 )
+            {
+                ModifyTheAgrifFunction_0($3->dim.last);
+                agrif_parentcall = 0;
+                fprintf(fortran_out," = ");
+            }
+        }
+      | ident_dims '%' declare_after_percent ident before_dims dims dims
+        {
+            created_dimensionlist = 1;
+        }
+      ;
+int_list :
+        TOK_CSTINT
+      | int_list ',' TOK_CSTINT
+      ;
+after_ident_dims :
+        '=' expr
+      | TOK_POINT_TO expr
+      ;
+call :  keywordcall opt_call
+        {
+            inagrifcallargument = 0 ;
+            incalldeclare=0;
+            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
+                strcpy(subofagrifinitgrids,subroutinename);
+            }
+            Instanciation_0(sameagrifname);
+        }
+      ;
+opt_call :
+      | '(' opt_callarglist  ')'
+      ;
+opt_callarglist :
+      | callarglist
+      ;
+keywordcall :
+        before_call TOK_FLUSH
+      | before_call TOK_NAME
+        {
+            if (!strcasecmp($2,"MPI_Init") )    callmpiinit = 1;
+            else                                callmpiinit = 0;
+
+            if (!strcasecmp($2,"Agrif_Init_Grids") )
+            {
+                callagrifinitgrids = 1;
+                strcpy(meetagrifinitgrids,subroutinename);
+            }
+            else
+            {
+                callagrifinitgrids = 0;
+            }
+            if ( Vartonumber($2) == 1 )
+            {
+                incalldeclare = 1;
+                inagrifcallargument = 1 ;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+      ;
+before_call : TOK_CALL  { pos_curcall=setposcur()-4; }
+      ;
+callarglist :
+        callarg
+      | callarglist ',' callarg
+      ;
+callarg :
+        expr
+        {
+            if ( callmpiinit == 1 )
+            {
+                strcpy(mpiinitvar,$1);
+                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
+            }
+        }
+      | '*' TOK_CSTINT
+      ;
+
+stop :  TOK_PAUSE
+      | TOK_STOP
+      ;
+
+option_inlist :
+      | inlist
+      ;
+option_read :
+        ioctl option_inlist
+      | infmt opt_inlist
+      ;
+opt_inlist :
+      | ',' inlist
+      ;
+ioctl : '(' ctllist ')'
+      ;
+after_rewind :
+        '(' ident ')'
+      | '(' TOK_CSTINT ')'
+      | TOK_CSTINT
+      | '(' uexpr ')'
+      | TOK_NAME
+      ;
+ctllist :
+        ioclause
+      | ctllist ',' ioclause
+      ;
+ioclause :
+        fexpr
+      | '*'
+      | TOK_DASTER
+      | ident expr dims
+      | ident expr '%' declare_after_percent ident_dims
+      | ident '(' triplet ')'
+      | ident '*'
+      | ident TOK_DASTER
+      ;
+
+declare_after_percent:      { afterpercent = 1; }
+      ;
+iofctl :
+        TOK_OPEN
+      | TOK_CLOSE
+      | TOK_FLUSH
+      ;
+infmt :  unpar_fexpr
+      | '*'
+      ;
+
+read :  TOK_READ
+      | TOK_INQUIRE
+      | TOK_PRINT
+      ;
+
+fexpr : unpar_fexpr
+      | '(' fexpr ')'
+      ;
+unpar_fexpr :
+        lhs
+      | simple_const
+      | fexpr addop fexpr %prec '+'
+      | fexpr '*' fexpr
+      | fexpr TOK_SLASH fexpr
+      | fexpr TOK_DASTER fexpr
+      | addop fexpr %prec '*'
+      | fexpr TOK_DSLASH fexpr
+      | TOK_FILE expr
+      | TOK_UNIT expr
+      | TOK_NML expr
+      | TOK_FMT expr
+      | TOK_EXIST expr
+      | TOK_ERR expr
+      | TOK_END expr
+      | TOK_NAME '=' expr
+      | predefinedfunction
+      ;
+addop : '+'
+      | '-'
+      ;
+inlist : inelt
+      | inlist ',' inelt
+      ;
+// opt_lhs :
+//       | lhs
+//       ;
+inelt : //opt_lhs opt_operation
+        lhs opt_operation
+      | '(' inlist ')' opt_operation
+      | predefinedfunction opt_operation
+      | simple_const opt_operation
+      | '(' inlist ',' dospec ')'
+      ;
+opt_operation :
+      | operation
+      | opt_operation operation
+      ;
+outlist :
+        complex_const       { strcpy($$,$1); }
+      | predefinedfunction  { strcpy($$,$1); }
+      | uexpr               { strcpy($$,$1); }
+      | other               { strcpy($$,$1); }
+      | uexpr   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
+      | uexpr   ',' other   { sprintf($$,"%s,%s",$1,$3); }
+      | other   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
+      | other   ',' other   { sprintf($$,"%s,%s",$1,$3); }
+      | outlist ',' expr    { sprintf($$,"%s,%s",$1,$3); }
+      | outlist ',' other   { sprintf($$,"%s,%s",$1,$3); }
+      ;
+other :
+        '(' uexpr   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
+      | '(' outlist ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
+      | '(' other   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
+dospec :
+        TOK_NAME '=' expr ',' expr           { sprintf($$,"%s=%s,%s)",$1,$3,$5);}
+      | TOK_NAME '=' expr ',' expr ',' expr  { sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);}
+      ;
+goto :  TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
+      | TOK_PLAINGOTO TOK_CSTINT
+      ;
+allocation_list :
+        allocate_object
+      | allocation_list ',' allocate_object
+      ;
+allocate_object :
+        lhs     { Add_Allocate_Var_1($1,curmodulename); }
+      ;
+allocate_object_list :
+        allocate_object
+      | allocate_object_list ',' allocate_object
+      ;
+opt_stat_spec :
+      | ',' TOK_STAT '=' lhs
+      ;
+pointer_name_list :
+        ident
+      | pointer_name_list ',' ident
+      ;
+
+%%
+
+void process_fortran(const char *input_file)
+{
+    extern FILE *fortran_in;
+    extern FILE *fortran_out;
+
+    char output_file[LONG_FNAME];
+    char input_fullpath[LONG_FNAME];
+
+    if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass);
+
+     yydebug=0;
+/******************************************************************************/
+/*  1-  Open input file                                                       */
+/******************************************************************************/
+
+    strcpy(cur_filename, input_file);
+    sprintf(input_fullpath, "%s/%s", input_dir, input_file);
+
+    fortran_in = fopen(input_fullpath, "r");
+    if (! fortran_in)
+    {
+        printf("Error : File %s does not exist\n", input_fullpath);
+        exit(1);
+    }
+
+/******************************************************************************/
+/*  2-  Variables initialization                                              */
+/******************************************************************************/
+
+    line_num_input = 1;
+    PublicDeclare = 0;
+    PrivateDeclare = 0;
+    ExternalDeclare = 0;
+    SaveDeclare = 0;
+    pointerdeclare = 0;
+    optionaldeclare = 0;
+    incalldeclare = 0;
+    inside_type_declare = 0;
+    Allocatabledeclare = 0 ;
+    Targetdeclare = 0 ;
+    VariableIsParameter =  0 ;
+    strcpy(NamePrecision,"");
+    c_star = 0 ;
+    functiondeclarationisdone = 0;
+    insubroutinedeclare = 0 ;
+    strcpy(subroutinename," ");
+    isrecursive = 0;
+    InitialValueGiven = 0 ;
+    GlobalDeclarationType = 0;
+    inmoduledeclare = 0;
+    incontainssubroutine = 0;
+    afterpercent = 0;
+    aftercontainsdeclare = 1;
+    strcpy(nameinttypename,"");
+
+/******************************************************************************/
+/*  3-  Parsing of the input file (1 time)                                    */
+/******************************************************************************/
+
+    sprintf(output_file, "%s/%s", output_dir, input_file);
+
+    if (firstpass == 0) fortran_out = fopen(output_file,"w");
+
+    fortran_parse();
+
+    if (firstpass == 0) NewModule_Creation_0();
+    if (firstpass == 0) fclose(fortran_out);
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c	(revision 6808)
@@ -48,92 +48,83 @@
 void Add_Common_var_1()
 {
-   listvar *newvar;
-   listvar *newvar2;
-   variable *newvariable;
-   listdim *dims;
-   char listdimension[LONG_C];
-   char ligne[LONG_C];
-   int out;
-
-   if ( firstpass == 1 )
-   {
-
-   newvar = (listvar *)malloc(sizeof(listvar));
-   newvariable = (variable *)malloc(sizeof(variable));
-   /*                                                                         */
-   Init_Variable(newvariable);
-   /*                                                                         */
-   strcpy(newvariable->v_nomvar,commonvar);
-   Save_Length(commonvar,4);
-   strcpy(newvariable->v_commonname,commonblockname);
-   Save_Length(commonblockname,7);
-   strcpy(newvariable->v_modulename,curmodulename);
-   Save_Length(curmodulename,6);
-   strcpy(newvariable->v_subroutinename,subroutinename);
-   Save_Length(subroutinename,11);
-   newvariable->v_positioninblock= positioninblock;
-   newvariable->v_common=1;
-   strcpy(newvariable->v_commoninfile,mainfile);
-   Save_Length(mainfile,10);
-
-   newvar->var = newvariable;
-
-   if ( commondim )
-   {
-      newvariable->v_dimension=commondim;
-      newvariable->v_dimensiongiven=1;
-      newvariable->v_nbdim=num_dims(commondim);
-      /* Creation of the string for the dimension of this variable            */
-      dimsempty = 1;
-      strcpy(listdimension,"");
-
-      if ( commondim )
-      {
-         dims = commondim;
-         while (dims)
-         {
-            if ( strcasecmp(dims->dim.first,"") ||
-                 strcasecmp(dims->dim.last,""))  dimsempty = 0;
-            sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
-            strcat(listdimension,ligne);
-            if ( dims->suiv ) strcat(listdimension,",");
-            dims = dims->suiv;
-         }
-         if ( dimsempty == 1 ) newvariable->v_dimsempty=1;
-      }
-      strcpy(newvariable->v_readedlistdimension,listdimension);
-      Save_Length(listdimension,15);
-   }
-
-
-   newvar->suiv = NULL;
-
-   if ( !List_Common_Var )
-   {
-      List_Common_Var = newvar;
-   }
-   else
-   {
-      newvar2 = List_Common_Var;
-      out = 0 ;
-      while ( newvar2 && out == 0 )
-      {
-         if ( !strcasecmp(newvar2->var->v_nomvar,commonvar) &&
-              !strcasecmp(newvar2->var->v_commonname,commonblockname) &&
-              !strcasecmp(newvar2->var->v_subroutinename,subroutinename)
-                          ) out = 1 ;
-         else newvar2 = newvar2->suiv;
-      }
-      if ( out == 0 )
-      {
-         newvar->suiv = List_Common_Var;
-         List_Common_Var = newvar;
-      }
-      else
-      {
-         free(newvar);
-      }
-   }
-   }
+    listvar *newvar;
+    listvar *newvar2;
+    variable *newvariable;
+    listdim *dims;
+    char listdimension[LONG_M];
+    char ligne[LONG_M];
+    int out;
+
+    if ( firstpass == 1 )
+    {
+        newvar = (listvar *) calloc(1,sizeof(listvar));
+        newvariable = (variable *) calloc(1,sizeof(variable));
+
+        Init_Variable(newvariable);
+
+        strcpy(newvariable->v_nomvar,commonvar);
+        strcpy(newvariable->v_commonname,commonblockname);
+        strcpy(newvariable->v_modulename,curmodulename);
+        strcpy(newvariable->v_subroutinename,subroutinename);
+        strcpy(newvariable->v_commoninfile,cur_filename);
+        newvariable->v_positioninblock = positioninblock;
+        newvariable->v_common = 1;
+        newvar->var = newvariable;
+
+        if ( commondim )
+        {
+            newvariable->v_dimension = commondim;
+            newvariable->v_dimensiongiven = 1;
+            newvariable->v_nbdim = get_num_dims(commondim);
+
+            /* Creation of the string for the dimension of this variable            */
+            dimsempty = 1;
+            strcpy(listdimension,"");
+
+            dims = commondim;
+            while (dims)
+            {
+                if ( strcasecmp(dims->dim.first,"") ||
+                     strcasecmp(dims->dim.last,""))  dimsempty = 0;
+                sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+                strcat(listdimension,ligne);
+                if ( dims->suiv ) strcat(listdimension,",");
+                dims = dims->suiv;
+            }
+            if ( dimsempty == 1 ) newvariable->v_dimsempty = 1;
+
+            strcpy(newvariable->v_readedlistdimension,listdimension);
+            Save_Length(listdimension,15);
+        }
+
+        newvar->suiv = NULL;
+
+        if ( !List_Common_Var )
+        {
+            List_Common_Var = newvar;
+        }
+        else
+        {
+            newvar2 = List_Common_Var;
+            out = 0 ;
+            while ( newvar2 && out == 0 )
+            {
+                if ( !strcasecmp(newvar2->var->v_nomvar,commonvar) &&
+                     !strcasecmp(newvar2->var->v_commonname,commonblockname) &&
+                     !strcasecmp(newvar2->var->v_subroutinename,subroutinename)
+                   ) out = 1 ;
+                else newvar2 = newvar2->suiv;
+            }
+            if ( out == 0 )
+            {
+                newvar->suiv = List_Common_Var;
+                List_Common_Var = newvar;
+            }
+            else
+            {
+                free(newvar);
+            }
+        }
+    }
 }
 
@@ -145,37 +136,39 @@
 /*                                                                            */
 /******************************************************************************/
-listnom *Addtolistnom(char *nom, listnom *listin,int value)
-{
-   listnom *newnom;
-   listnom *parcours;
-   int out;
-
-   newnom=(listnom *) malloc (sizeof (listnom));
-   strcpy(newnom->o_nom,nom);
-   Save_Length(nom,23);
-   newnom->o_val = value;
-   newnom->suiv = NULL;
-
-   if ( !listin ) listin = newnom;
-   else
-   {
-      parcours = listin;
-      out = 0 ;
-      while ( parcours && out == 0 )
-      {
-         if ( !strcasecmp(parcours->o_nom,nom) ) out = 1 ;
-         else parcours=parcours->suiv;
-      }
-      if ( out == 0 )
-      {
-          newnom->suiv = listin;
-          listin = newnom;
-      }
-      else
-      {
-         free(newnom);
-      }
-   }
-   return listin;
+listnom *Addtolistnom(const char *nom, listnom *listin, int value)
+{
+    listnom *newnom;
+    listnom *parcours;
+    int out;
+
+    newnom = (listnom*) calloc(1, sizeof(listnom));
+    strcpy(newnom->o_nom, nom);
+    newnom->o_val = value;
+    newnom->suiv = NULL;
+
+    if ( listin == NULL )
+    {
+        listin = newnom;
+    }
+    else
+    {
+        parcours = listin;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->o_nom, nom) ) out = 1 ;
+            else parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newnom->suiv = listin;
+            listin = newnom;
+        }
+        else
+        {
+            free(newnom);
+        }
+    }
+    return listin;
 }
 
@@ -193,37 +186,35 @@
 /*                                                                            */
 /******************************************************************************/
-listname *Addtolistname(char *nom,listname *input)
-{
-   listname *newnom;
-   listname *parcours;
-   int out;
-
-   if ( !input )
-   {
-      newnom=(listname *) malloc (sizeof (listname));
-      strcpy(newnom->n_name,nom);
-      Save_Length(nom,20);
-      newnom->suiv = NULL;
-      input = newnom;
-   }
-   else
-   {
-      parcours = input;
-      out = 0 ;
-      while ( parcours && out == 0 )
-      {
-         if ( !strcasecmp(parcours->n_name,nom) ) out = 1;
-         else parcours=parcours->suiv;
-      }
-      if ( out == 0 )
-      {
-         newnom=(listname *) malloc (sizeof (listname));
-         strcpy(newnom->n_name,nom);
-         Save_Length(nom,20);
-         newnom->suiv = input;
-         input = newnom;
-      }
-   }
-   return input;
+listname *Addtolistname(const char *nom, listname *input)
+{
+    listname *newnom;
+    listname *parcours;
+    int out;
+
+    if ( !input )
+    {
+        newnom = (listname*) calloc(1, sizeof(listname));
+        strcpy(newnom->n_name, nom);
+        newnom->suiv = NULL;
+        input = newnom;
+    }
+    else
+    {
+        parcours = input;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->n_name,nom) ) out = 1;
+            else parcours=parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newnom = (listname*) calloc(1,sizeof(listname));
+            strcpy(newnom->n_name, nom);
+            newnom->suiv = input;
+            input = newnom;
+        }
+    }
+    return input;
 }
 
@@ -236,20 +227,20 @@
 /*                                                                            */
 /******************************************************************************/
-int ModuleIsDefineInInputFile(char *name)
-{
-   listnom *newnom;
-   int out;
-
-   out = 0;
-   if ( listofmodules )
-   {
-      newnom = listofmodules;
-      while( newnom && out == 0 )
-      {
-         if ( !strcasecmp(newnom->o_nom,name) ) out = 1 ;
-         else newnom=newnom->suiv;
-      }
-   }
-   return out;
+int ModuleIsDefineInInputFile(const char *name)
+{
+    listnom *newnom;
+    int out;
+
+    out = 0;
+    if ( listofmodules )
+    {
+        newnom = listofmodules;
+        while( newnom && out == 0 )
+        {
+            if ( !strcasecmp(newnom->o_nom,name) ) out = 1 ;
+            else newnom = newnom->suiv;
+        }
+    }
+    return out;
 }
 
@@ -270,40 +261,36 @@
 /*                                                                            */
 /******************************************************************************/
-void Addmoduletothelisttmp(char *name)
-{
-  listusemodule *newmodule;
-  listusemodule *parcours;
-  int out;
-
-  if ( !listofmoduletmp)
-  {
-    newmodule =(listusemodule *)malloc(sizeof(listusemodule));
-    strcpy(newmodule->u_usemodule,name);
-    Save_Length(name,16);
-    strcpy(newmodule->u_cursubroutine,subroutinename);
-    Save_Length(subroutinename,18);
-    newmodule->suiv = NULL;
-    listofmoduletmp = newmodule ;
-  }
-  else
-  {
-    parcours = listofmoduletmp;
-    out = 0;
-    while( parcours && out == 0 )
-    {
-       if ( !strcasecmp(parcours->u_usemodule,name) ) out = 1;
-       else parcours = parcours->suiv;
-    }
-    if ( out == 0 )
-    {
-       newmodule =(listusemodule *)malloc(sizeof(listusemodule));
-       strcpy(newmodule->u_usemodule,name);
-       Save_Length(name,16);
-       strcpy(newmodule->u_cursubroutine,subroutinename);
-       Save_Length(subroutinename,18);
-       newmodule->suiv = listofmoduletmp;
-       listofmoduletmp = newmodule;
-    }
-  }
+void Addmoduletothelisttmp(const char *name)
+{
+    listusemodule *newmodule;
+    listusemodule *parcours;
+    int out;
+
+    if ( !listofmoduletmp )
+    {
+        newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
+        strcpy(newmodule->u_usemodule, name);
+        strcpy(newmodule->u_cursubroutine, subroutinename);
+        newmodule->suiv = NULL;
+        listofmoduletmp = newmodule ;
+    }
+    else
+    {
+        parcours = listofmoduletmp;
+        out = 0;
+        while( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->u_usemodule, name) ) out = 1;
+            else parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
+            strcpy(newmodule->u_usemodule, name);
+            strcpy(newmodule->u_cursubroutine, subroutinename);
+            newmodule->suiv = listofmoduletmp;
+            listofmoduletmp = newmodule;
+        }
+    }
 }
 
@@ -321,16 +308,15 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_NameOfModule_1(char *nom)
-{
-   listnom *newnom;
-
-   if ( firstpass == 1 )
-   {
-      newnom=(listnom *) malloc (sizeof (listnom));
-      strcpy(newnom->o_nom,nom);
-      Save_Length(nom,23);
-      newnom->suiv = List_NameOfModule;
-      List_NameOfModule = newnom;
-   }
+void Add_NameOfModule_1(const char *nom)
+{
+    listnom *newnom;
+
+    if ( firstpass == 1 )
+    {
+        newnom = (listnom *) calloc(1,sizeof(listnom));
+        strcpy(newnom->o_nom,nom);
+        newnom->suiv = List_NameOfModule;
+        List_NameOfModule = newnom;
+    }
 }
 
@@ -348,24 +334,23 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_NameOfCommon_1(char *nom,char *cursubroutinename)
-{
-   listnom *newnom;
-   listnom *parcours;
-
-   if ( firstpass == 1 )
-   {
-      parcours = List_NameOfCommon;
-      while ( parcours && strcasecmp(parcours->o_nom,nom) )
-                                                      parcours = parcours->suiv;
-      if ( !parcours )
-      {
-         newnom=(listnom *) malloc (sizeof (listnom));
-         strcpy(newnom->o_nom,nom);
-         strcpy(newnom->o_subroutinename,cursubroutinename);
-         Save_Length(nom,23);
-         newnom->suiv = List_NameOfCommon;
-         List_NameOfCommon = newnom;
-      }
-   }
+void Add_NameOfCommon_1(const char *nom, const char *cursubroutinename)
+{
+    listnom *newnom;
+    listnom *parcours;
+
+    if ( firstpass == 1 )
+    {
+        parcours = List_NameOfCommon;
+        while ( parcours && strcasecmp(parcours->o_nom,nom) )
+            parcours = parcours->suiv;
+        if ( !parcours )
+        {
+            newnom = (listnom *) calloc(1,sizeof(listnom));
+            strcpy(newnom->o_nom,nom);
+            strcpy(newnom->o_subroutinename,cursubroutinename);
+            newnom->suiv = List_NameOfCommon;
+            List_NameOfCommon = newnom;
+        }
+    }
 }
 
@@ -378,28 +363,22 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_CouplePointed_Var_1(char *namemodule,listcouple *couple)
-{
-   listvarpointtovar *pointtmp;
-
-   if ( firstpass == 1 )
-   {
-      /* we should complete the List_CouplePointed_Var                        */
-      pointtmp=(listvarpointtovar *)malloc(sizeof(listvarpointtovar));
-      strcpy(pointtmp->t_usemodule,namemodule);
-      Save_Length(namemodule,28);
-      strcpy(pointtmp->t_cursubroutine,subroutinename);
-      Save_Length(subroutinename,29);
-      pointtmp->t_couple = couple;
-      if ( List_CouplePointed_Var )
-      {
-         pointtmp->suiv = List_CouplePointed_Var;
-         List_CouplePointed_Var = pointtmp;
-      }
-      else
-      {
-         pointtmp->suiv = NULL;
-         List_CouplePointed_Var = pointtmp;
-      }
-   }
+void Add_CouplePointed_Var_1(const char *namemodule, listcouple *couple)
+{
+    listvarpointtovar *pointtmp;
+
+    /* we should complete the List_CouplePointed_Var                        */
+    pointtmp = (listvarpointtovar*) calloc(1, sizeof(listvarpointtovar));
+    strcpy(pointtmp->t_usemodule, namemodule);
+    strcpy(pointtmp->t_cursubroutine, subroutinename);
+    pointtmp->t_couple = couple;
+    if ( List_CouplePointed_Var )
+    {
+        pointtmp->suiv = List_CouplePointed_Var;
+    }
+    else
+    {
+        pointtmp->suiv = NULL;
+    }
+    List_CouplePointed_Var = pointtmp;
 }
 
@@ -420,66 +399,51 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_Include_1(char *name)
+void Add_Include_1(const char *name)
+{
+    listusemodule *newinclude;
+
+    if ( firstpass == 1 )
+    {
+        newinclude = (listusemodule*) calloc(1, sizeof(listusemodule));
+        strcpy(newinclude->u_usemodule,name);
+        strcpy(newinclude->u_cursubroutine,subroutinename);
+
+        newinclude->suiv = List_Include;
+        List_Include  = newinclude ;
+    }
+}
+
+/******************************************************************************/
+/*                     Add_ImplicitNoneSubroutine_1                           */
+/******************************************************************************/
+/* This subroutine is used to add a record to a list of struct                */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_ImplicitNoneSubroutine_1()
+{
+    if ( firstpass == 1 )
+        List_ImplicitNoneSubroutine = Addtolistname(subroutinename,List_ImplicitNoneSubroutine);
+}
+
+/******************************************************************************/
+/*                        WriteIncludeDeclaration                             */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void WriteIncludeDeclaration(FILE* tofile)
 {
   listusemodule *newinclude;
 
-  if ( firstpass == 1 )
-  {
-  newinclude =(listusemodule *)malloc(sizeof(listusemodule));
-  strcpy(newinclude->u_usemodule,name);
-  Save_Length(name,16);
-  strcpy(newinclude->u_cursubroutine,subroutinename);
-  Save_Length(subroutinename,18);
-  newinclude->suiv = NULL;
-
-  if ( !List_Include)
-  {
-     List_Include  = newinclude ;
-  }
-  else
-  {
-    newinclude->suiv = List_Include;
-    List_Include = newinclude;
-  }
-  }
-}
-
-/******************************************************************************/
-/*                     Add_ImplicitNoneSubroutine_1                           */
-/******************************************************************************/
-/* This subroutine is used to add a record to a list of struct                */
-/******************************************************************************/
-/*                                                                            */
-/*                                                                            */
-/******************************************************************************/
-void Add_ImplicitNoneSubroutine_1()
-{
-
-  if ( firstpass == 1 )
-  {
-     List_ImplicitNoneSubroutine = Addtolistname(subroutinename,
-                                                   List_ImplicitNoneSubroutine);
-  }
-}
-
-
-/******************************************************************************/
-/*                        WriteIncludeDeclaration                             */
-/******************************************************************************/
-/* Firstpass 0                                                                */
-/******************************************************************************/
-/*                                                                            */
-/******************************************************************************/
-void WriteIncludeDeclaration()
-{
-  listusemodule *newinclude;
-
   newinclude = List_Include;
-  fprintf(fortranout,"\n");
+  fprintf(tofile,"\n");
   while ( newinclude )
   {
      if ( !strcasecmp(newinclude->u_cursubroutine,subroutinename) )
      {
-        fprintf(fortranout,"      INCLUDE %s \n",newinclude->u_usemodule);
+        fprintf(tofile, "      include %s\n",newinclude->u_usemodule);
      }
      newinclude = newinclude ->suiv;
@@ -498,109 +462,81 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_Save_Var_1 (char *name,listdim *d)
-{
-  listvar *newvar;
-  listdim *dims;
-  char ligne[LONG_C];
-  char listdimension[LONG_C];
-
-  if ( firstpass == 1 )
-  {
-     newvar=(listvar *)malloc(sizeof(listvar));
-     newvar->var=(variable *)malloc(sizeof(variable));
-     /*                                                                       */
-     Init_Variable(newvar->var);
-     /*                                                                       */
-     newvar->var->v_save=1;
-     strcpy(newvar->var->v_nomvar,name);
-     Save_Length(name,4);
-     strcpy(newvar->var->v_modulename,curmodulename);
-     Save_Length(curmodulename,6);
-     strcpy(newvar->var->v_subroutinename,subroutinename);
-     Save_Length(subroutinename,11);
-     strcpy(newvar->var->v_commoninfile,mainfile);
-     Save_Length(mainfile,10);
-
-     newvar->var->v_dimension=d;
-     /* Creation of the string for the dimension of this variable             */
-     dimsempty = 1;
-
-     if ( d )
-     {
-        newvar->var->v_dimensiongiven=1;
-        dims = d;
-        while (dims)
-        {
-           if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
-                                                                  dimsempty = 0;
-           sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
-           strcat(listdimension,ligne);
-           if ( dims->suiv )
-           {
-              strcat(listdimension,",");
-           }
-           dims = dims->suiv;
-        }
-        if ( dimsempty == 1 ) newvar->var->v_dimsempty=1;
-     }
-
-/*     strcpy(newvar->var->v_readedlistdimension,listdimension);
-     Save_Length(listdimension,15);*/
-     /*                                                                       */
-     newvar->suiv = NULL;
-
-     if ( !List_Save_Var )
-     {
-        List_Save_Var  = newvar ;
-     }
-     else
-     {
+void Add_Save_Var_1 (const char *name, listdim *d)
+{
+    listvar *newvar;
+    listdim *dims;
+    char ligne[LONG_M];
+    char listdimension[LONG_M];
+
+    if ( firstpass == 1 )
+    {
+        newvar = (listvar *) calloc(1,sizeof(listvar));
+        newvar->var = (variable *) calloc(1,sizeof(variable));
+
+        Init_Variable(newvar->var);
+
+        newvar->var->v_save = 1;
+        strcpy(newvar->var->v_nomvar,name);
+        strcpy(newvar->var->v_modulename,curmodulename);
+        strcpy(newvar->var->v_subroutinename,subroutinename);
+        strcpy(newvar->var->v_commoninfile,cur_filename);
+
+        newvar->var->v_dimension = d;
+
+        /* Creation of the string for the dimension of this variable             */
+        dimsempty = 1;
+
+        if ( d )
+        {
+            newvar->var->v_dimensiongiven = 1;
+            dims = d;
+            while (dims)
+            {
+                if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
+                    dimsempty = 0;
+                sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+                strcat(listdimension,ligne);
+                if ( dims->suiv )   strcat(listdimension,",");
+                dims = dims->suiv;
+            }
+            if ( dimsempty == 1 ) newvar->var->v_dimsempty = 1;
+        }
+
         newvar->suiv = List_Save_Var;
         List_Save_Var = newvar;
-     }
-  }
+    }
 }
 
 void Add_Save_Var_dcl_1 (listvar *var)
 {
-  listvar *newvar;
-  listvar *parcours;
-
-  if ( firstpass == 1 )
-  {
-     parcours = var;
-     while ( parcours )
-     {
-        newvar=(listvar *)malloc(sizeof(listvar));
-        newvar->var=(variable *)malloc(sizeof(variable));
-        /*                                                                    */
-        Init_Variable(newvar->var);
-        /*                                                                    */
-        newvar->var->v_save=1;
-        strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
-        strcpy(newvar->var->v_modulename,curmodulename);
-        Save_Length(curmodulename,6);
-        strcpy(newvar->var->v_subroutinename,subroutinename);
-        Save_Length(subroutinename,11);
-        strcpy(newvar->var->v_commoninfile,mainfile);
-        Save_Length(mainfile,10);
-        /*                                                                    */
-        strcpy(newvar->var->v_readedlistdimension,
-             parcours->var->v_readedlistdimension);
-        newvar->var->v_nbdim = parcours->var->v_nbdim;
-        newvar->var->v_dimension = parcours->var->v_dimension;
-        /*                                                                    */
-        newvar->var->v_dimensiongiven=parcours->var->v_dimensiongiven;
-        /*                                                                    */
-        newvar->suiv = NULL;
-
-        if ( !List_Save_Var ) List_Save_Var  = newvar ;
-        else
-        {
-           newvar->suiv = List_Save_Var;
-           List_Save_Var = newvar;
-        }
-        parcours = parcours->suiv;
-     }
-  }
-}
+    listvar *newvar;
+    listvar *parcours;
+
+    if ( firstpass == 1 )
+    {
+        parcours = var;
+        while ( parcours )
+        {
+            newvar = (listvar *) calloc(1,sizeof(listvar));
+            newvar->var = (variable *) calloc(1,sizeof(variable));
+
+            Init_Variable(newvar->var);
+
+            newvar->var->v_save = 1;
+            strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
+            strcpy(newvar->var->v_modulename,curmodulename);
+            strcpy(newvar->var->v_subroutinename,subroutinename);
+            strcpy(newvar->var->v_commoninfile,cur_filename);
+            strcpy(newvar->var->v_readedlistdimension,parcours->var->v_readedlistdimension);
+
+            newvar->var->v_nbdim = parcours->var->v_nbdim;
+            newvar->var->v_catvar = parcours->var->v_catvar;
+            newvar->var->v_dimension = parcours->var->v_dimension;
+            newvar->var->v_dimensiongiven=parcours->var->v_dimensiongiven;
+            newvar->suiv = List_Save_Var;
+            List_Save_Var = newvar;
+
+            parcours = parcours->suiv;
+        }
+    }
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile	(revision 6808)
@@ -1,7 +1,2 @@
-#- option to debug
-C_D = -g # -g -Wall
-# Compilation:
-CC		= cc -O
-#-
 OBJS = main.o WriteInFile.o toamr.o fortran.o  \
        dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \
@@ -14,13 +9,31 @@
        WorkWithlistofcoupled.o
 
-
 .SUFFIXES:
 .SUFFIXES: .c .o
 
-all : conv
-	@echo CONV is ok
+all: conv
+	@echo
+	@echo ===================================================
+	@echo   CONV is ok
+	@echo ===================================================
+	@echo
 
-conv :  $(OBJS)
-	@$(CC) $(OBJS) -o ../$@
+#main.c: convert.y convert.lex
+#	@echo ===================================================
+#	@echo   Rebuilding main.c ...
+#	@echo ===================================================
+#	$(MAKE) -f Makefile.lex main.c
+
+#fortran.c: fortran.y fortran.lex
+#	@echo ===================================================
+#	@echo   Rebuilding fortran.c ...
+#	@echo ===================================================
+#	$(MAKE) -f Makefile.lex fortran.c
+
+conv: $(OBJS)
+	$(CC) $(CFLAGS) -g $(OBJS) -o ../$@
+
+%.o: %.c
+	$(CC) $(CFLAGS) -g -c $< -o $@
 
 main.o : main.c
@@ -28,16 +41,16 @@
 toamr.o : toamr.c decl.h
 WriteInFile.o : WriteInFile.c decl.h
-dependfile.o : dependfile.c decl.h	
-SubLoopCreation.o : SubLoopCreation.c decl.h	
-WorkWithglobliste.o : WorkWithglobliste.c decl.h	
-WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h	
-WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h	
-Writedeclarations.o : Writedeclarations.c decl.h	
-UtilFortran.o : UtilFortran.c decl.h	
-WorkWithParameterlist.o : WorkWithParameterlist.c decl.h	
-UtilNotGridDep.o : UtilNotGridDep.c decl.h	
-WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h	
-DiversListe.o : DiversListe.c decl.h	
-UtilAgrif.o : UtilAgrif.c decl.h	
+dependfile.o : dependfile.c decl.h
+SubLoopCreation.o : SubLoopCreation.c decl.h
+WorkWithglobliste.o : WorkWithglobliste.c decl.h
+WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h
+WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h
+Writedeclarations.o : Writedeclarations.c decl.h
+UtilFortran.o : UtilFortran.c decl.h
+WorkWithParameterlist.o : WorkWithParameterlist.c decl.h
+UtilNotGridDep.o : UtilNotGridDep.c decl.h
+WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h
+DiversListe.o : DiversListe.c decl.h
+UtilAgrif.o : UtilAgrif.c decl.h
 WorkWithAllocatelist.o : WorkWithAllocatelist.c decl.h
 UtilCharacter.o : UtilCharacter.c decl.h
@@ -47,4 +60,7 @@
 WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h
 WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h
-clean : 
-	/bin/rm -f *.o y.output
+
+clean:
+#	$(MAKE) -f Makefile.lex clean
+	$(RM) *.o conv
+	
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex	(revision 6807)
+++ 	(revision )
@@ -1,77 +1,0 @@
-# Compilation:
-CC		= cc -O -g -Wall
-LEX		= flex
-
-# option de flex et pas de lex
-LEXFLAGS=-i
-YACC = byacc -t -v -g
-YACC = bison -t -v -g
-YACC = bison 
-
-
-OBJS = main.o WriteInFile.o toamr.o fortran.o  \
-       dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \
-       WorkWithvarofsubroutineliste.o WorkWithParameterlist.o \
-       Writedeclarations.o WorkWithglobliste.o UtilFortran.o \
-       UtilNotGridDep.o WorkWithlistdatavariable.o \
-       DiversListe.o UtilAgrif.o WorkWithAllocatelist.o \
-       UtilCharacter.o UtilListe.o UtilFile.o \
-       WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o \
-       WorkWithlistofcoupled.o
-
-.SUFFIXES:
-.SUFFIXES: .c .o
-
-all : conv
-
-conv :  $(OBJS)
-	$(CC) $(OBJS)  $(LEXLIB) -o ../$@
-
-main.o : main.c
-main.c : convert.tab.c  convert.yy.c
-	rm -f main.c
-	cat convert.tab.c  convert.yy.c > main.c
-	rm -f convert.yy.c convert.tab.c
-fortran.o : fortran.c
-fortran.c : fortran.tab.c fortran.yy.c
-	rm -f fortran.c
-	cat fortran.tab.c  fortran.yy.c > fortran.c
-#rm -f fortran.yy.c fortran.tab.c
-convert.tab.c : convert.y decl.h
-	$(YACC) convert.y
-#	mv -f y.tab.c convert.tab.c
-fortran.tab.c : fortran.y decl.h
-	$(YACC) -p fortran fortran.y
-#	mv -f y.tab.c fortran.tab.c
-#	mv -f y.output fortran.output
-#	mv -f y.dot fortran.dot
-convert.yy.c : convert.lex
-	$(LEX) $(LEXFLAGS) -oconvert.yy.c convert.lex
-fortran.yy.c : fortran.lex
-	$(LEX) $(LEXFLAGS) -Pfortran -ofortran.yy.c fortran.lex
-	
-toamr.o : toamr.c decl.h
-WriteInFile.o : WriteInFile.c decl.h
-dependfile.o : dependfile.c decl.h
-SubLoopCreation.o : SubLoopCreation.c decl.h
-WorkWithglobliste.o : WorkWithglobliste.c decl.h
-WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h
-WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h
-Writedeclarations.o : Writedeclarations.c decl.h
-UtilFortran.o : UtilFortran.c decl.h
-WorkWithParameterlist.o : WorkWithParameterlist.c decl.h
-UtilNotGridDep.o : UtilNotGridDep.c decl.h
-WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h
-DiversListe.o : DiversListe.c decl.h
-UtilAgrif.o : UtilAgrif.c decl.h
-WorkWithAllocatelist.o : WorkWithAllocatelist.c decl.h
-UtilCharacter.o : UtilCharacter.c decl.h
-UtilListe.o : UtilListe.c decl.h
-UtilFile.o : UtilFile.c decl.h
-WorkWithlistofmodulebysubroutine.o : WorkWithlistofmodulebysubroutine.c decl.h
-WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h
-WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h
-clean : 
-	/bin/rm -f *.o y.tab.c main.c lex.yy.c fortran.c \
-	fortran.tab.c fortran.yy.c convert.tab.c convert.yy.c \
-	y.output
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex.byacc
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex.byacc	(revision 6807)
+++ 	(revision )
@@ -1,76 +1,0 @@
-# Compilation:
-CC		= cc -O -g -Wall
-LEX		= flex
-
-# option de flex et pas de lex
-LEXFLAGS=-i
-YACC = byacc -t -v -g
-YACC = bison -t -v -g
-
-
-OBJS = main.o WriteInFile.o toamr.o fortran.o  \
-       dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \
-       WorkWithvarofsubroutineliste.o WorkWithParameterlist.o \
-       Writedeclarations.o WorkWithglobliste.o UtilFortran.o \
-       UtilNotGridDep.o WorkWithlistdatavariable.o \
-       DiversListe.o UtilAgrif.o WorkWithAllocatelist.o \
-       UtilCharacter.o UtilListe.o UtilFile.o \
-       WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o \
-       WorkWithlistofcoupled.o
-
-.SUFFIXES:
-.SUFFIXES: .c .o
-
-all : conv
-
-conv :  $(OBJS)
-	$(CC) $(OBJS)  $(LEXLIB) -o ../$@
-
-main.o : main.c
-main.c : convert.tab.c  convert.yy.c
-	rm -f main.c
-	cat convert.tab.c  convert.yy.c > main.c
-	rm -f convert.yy.c convert.tab.c
-fortran.o : fortran.c
-fortran.c : fortran.tab.c fortran.yy.c
-	rm -f fortran.c
-	cat fortran.tab.c  fortran.yy.c > fortran.c
-#rm -f fortran.yy.c fortran.tab.c
-convert.tab.c : convert.y decl.h
-	$(YACC) convert.y
-	mv -f y.tab.c convert.tab.c
-fortran.tab.c : fortran.y decl.h
-	$(YACC) -p fortran fortran.y
-	mv -f y.tab.c fortran.tab.c
-	mv -f y.output fortran.output
-	mv -f y.dot fortran.dot
-convert.yy.c : convert.lex
-	$(LEX) $(LEXFLAGS) -oconvert.yy.c convert.lex
-fortran.yy.c : fortran.lex
-	$(LEX) $(LEXFLAGS) -Pfortran -ofortran.yy.c fortran.lex
-	
-toamr.o : toamr.c decl.h
-WriteInFile.o : WriteInFile.c decl.h
-dependfile.o : dependfile.c decl.h
-SubLoopCreation.o : SubLoopCreation.c decl.h
-WorkWithglobliste.o : WorkWithglobliste.c decl.h
-WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h
-WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h
-Writedeclarations.o : Writedeclarations.c decl.h
-UtilFortran.o : UtilFortran.c decl.h
-WorkWithParameterlist.o : WorkWithParameterlist.c decl.h
-UtilNotGridDep.o : UtilNotGridDep.c decl.h
-WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h
-DiversListe.o : DiversListe.c decl.h
-UtilAgrif.o : UtilAgrif.c decl.h
-WorkWithAllocatelist.o : WorkWithAllocatelist.c decl.h
-UtilCharacter.o : UtilCharacter.c decl.h
-UtilListe.o : UtilListe.c decl.h
-UtilFile.o : UtilFile.c decl.h
-WorkWithlistofmodulebysubroutine.o : WorkWithlistofmodulebysubroutine.c decl.h
-WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h
-WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h
-clean : 
-	/bin/rm -f *.o y.tab.c main.c lex.yy.c fortran.c \
-	fortran.tab.c fortran.yy.c convert.tab.c convert.yy.c \
-	y.output
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c	(revision 6808)
@@ -45,74 +45,47 @@
 
 /******************************************************************************/
-/*                             writeheadnewsub_0                              */
-/******************************************************************************/
-/* Firstpass 0                                                                */
+/*                           WriteBeginof_SubLoop                             */
+/******************************************************************************/
 /* We should write the head of the subroutine sub_loop_<subroutinename>       */
 /******************************************************************************/
 /*                                                                            */
 /******************************************************************************/
-void writeheadnewsub_0()
-{
-   char ligne[LONG_C];
-
-   if ( firstpass == 0 && IsTabvarsUseInArgument_0() == 1 )
-   {
-      if ( todebug == 1 ) printf("Enter in writeheadnewsub_0\n");
+void WriteBeginof_SubLoop()
+{
+   if (todebug == 1) printf("##\n## Enter in HEAD SUBLOOP for |%s|\n##\n", subroutinename);
+   if ( IsTabvarsUseInArgument_0() == 1 )
+   {
+      if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 1\n");
       /* we should add the use agrif_uti l if it is necessary                 */
       WriteHeadofSubroutineLoop();
       WriteUsemoduleDeclaration(subroutinename);
-      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout,
-                                                       "      IMPLICIT NONE\n");
-      WriteIncludeDeclaration();
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n");
+      WriteIncludeDeclaration(fortran_out);
       /*                                                                      */
       /* We should write once the declaration of tables (extract              */
       /*    from pointer) in the new subroutine                               */
-      if ( mark == 1 ) fprintf(fortranout,"!!! 000000000000000 \n");
-
-      if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration();
-      if ( mark == 1 ) fprintf(fortranout,"!!! 111111111111111 \n");
-
-      sprintf(ligne,"\n#include \"ParamFile%s.h\" \n",subroutinename);
-      tofich(fortranout,ligne,1);
-
-      WriteArgumentDeclaration_Sort();
-
-      if ( mark == 1 ) fprintf(fortranout,"!!! 222222222222222 \n");
-      writesub_loopdeclaration_tab(List_UsedInSubroutine_Var,fortranout);
-      if ( mark == 1 ) fprintf(fortranout,"!!! 333333333333333 \n");
-      writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var,paramout);
-      if ( mark == 1 ) fprintf(fortranout,"!!! 444444444444444 \n");
-      /* now we should write the function declaration                         */
-      /*    case if it is the                                                 */
-      WriteFunctionDeclaration(1);
-      if ( mark == 1 ) fprintf(fortranout,"!!! 555555555555555 \n");
-
-//      if ( SubInList_ContainsSubroutine() == 0 ) WriteSubroutineDeclaration(1);
-  
-      if ( mark == 1 ) fprintf(fortranout,"!!! 666666666666666 \n");
-      if ( todebug == 1 ) printf("Out of writeheadnewsub_0\n");
-   }
-   else if ( firstpass == 0 )
-   {
-      AddUseAgrifUtil_0(fortranout);
+      if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration(fortran_out);
+
+      writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var,fortran_out);
+      writesub_loopdeclaration_tab(List_UsedInSubroutine_Var,fortran_out);
+      WriteArgumentDeclaration_Sort(fortran_out);
+      WriteFunctionDeclaration(fortran_out, 1);
+   }
+   else
+   {
+      if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 0\n");
+      AddUseAgrifUtil_0(fortran_out);
       WriteUsemoduleDeclaration(subroutinename);
-      WriteIncludeDeclaration();
-      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout,
-                                                       "      IMPLICIT NONE\n");
-      if ( mark == 1 ) fprintf(fortranout,"!!! aaaaaaaaaaaaaaa \n");
-      WriteLocalParamDeclaration();
-      if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbbbbbbbbbb \n");   
+      WriteIncludeDeclaration(fortran_out);
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n");
+      WriteLocalParamDeclaration(fortran_out);
       WriteArgumentDeclaration_beforecall();
-      if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbccccccccc \n");
-      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(1);
-/*      writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortranout);
-      writesub_loopdeclaration_tab(List_SubroutineArgument_Var,fortranout);*/
-      if ( mark == 1 ) fprintf(fortranout,"!!! ccccccccccccccc \n");
-      if ( mark == 1 ) fprintf(fortranout,"!!! ddddddddddddddd \n");
-//      WriteSubroutineDeclaration(1);
-      if ( mark == 1 ) fprintf(fortranout,"!!! eeeeeeeeeeeeeee \n");
-   }
-}
-
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 1);
+/*    writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortran_out);
+      writesub_loopdeclaration_tab(List_SubroutineArgument_Var,fortran_out);*/
+   }
+   if ( todebug == 1 ) printf("<   out of WriteBeginof_SubLoop\n");
+   if ( todebug == 1 ) printf("## EXIT HEAD SUBLOOP (%s)\n\n", subroutinename);
+}
 
 /******************************************************************************/
@@ -129,17 +102,14 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteVariablelist_subloop(FILE *outputfile,char *ligne)
+void WriteVariablelist_subloop(char *ligne)
 {
    listvar *parcours;
-   int compteur;
-
-   if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop\n");
+
+   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop\n");
    parcours = List_SubroutineArgument_Var;
    didvariableadded = 0;
-   compteur = 0 ;
 
    while ( parcours )
    {
-
       /* if the readed variable is a variable of the subroutine               */
       /*    subroutinename we should write the name of this variable          */
@@ -147,11 +117,8 @@
       if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
       {
-         if ( didvariableadded == 1 )
-         {
-            strcat(ligne,",");
-         }
+         if ( didvariableadded == 1 )   strcat(ligne,",");
          strcat(ligne,parcours->var->v_nomvar);
          didvariableadded = 1;
-            }
+      }
       parcours = parcours -> suiv;
    }
@@ -161,14 +128,11 @@
       if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
       {
-         if ( didvariableadded == 1 )
-         {
-            strcat(ligne,",");
-         }
+         if ( didvariableadded == 1 )   strcat(ligne,",");
          strcat(ligne,parcours->var->v_nomvar);
          didvariableadded = 1;
-            }
+      }
       parcours = parcours -> suiv;
    }
-   if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop\n");
+   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop\n");
 }
 
@@ -188,14 +152,16 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteVariablelist_subloop_Call(FILE *outputfile,char *ligne)
+void WriteVariablelist_subloop_Call(char **ligne, size_t line_length)
 {
    listvar *parcours;
-   char ligne2[10];
+   char ligne2[LONG_M];
    int i;
-   int compteur ;
-
-   if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Call\n");
+   size_t cur_length;
+
+   cur_length = line_length;
+
+   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Call\n");
    parcours = List_UsedInSubroutine_Var;
-   compteur = 0 ;
+
    while ( parcours )
    {
@@ -207,9 +173,12 @@
          )
       {
-         if ( didvariableadded == 1 )
+         if ( didvariableadded == 1 )   strcat(*ligne,",");
+         const char *vres = vargridcurgridtabvars(parcours->var, 0);
+         if ( (strlen(*ligne)+strlen(vres)+100) > cur_length )
          {
-            strcat(ligne," , ");
+            cur_length += LONG_M;
+            *ligne = realloc( *ligne, cur_length*sizeof(char) );
          }
-         strcat(ligne,vargridcurgridtabvars(parcours->var,0));
+         strcat(*ligne, vres);
          /* if it is asked in the call of the conv we should give             */
          /* scalar in argument, so we should put (1,1,1) after the            */
@@ -223,43 +192,25 @@
              while ( i <=  parcours->var->v_nbdim )
              {
-                if ( i == 1 ) strcat(ligne,"( ");
+                if ( i == 1 ) strcat(*ligne,"( ");
                 if ( SubloopScalar == 2 )
                 {
-                   strcat(ligne,":");
-                   if ( i != parcours->var->v_nbdim ) strcat(ligne,",");
+                   strcat(*ligne,":");
+                   if ( i != parcours->var->v_nbdim ) strcat(*ligne,",");
                 }
                 else
                 {
-                   strcat(ligne," lbound( ");
-                   strcat(ligne,vargridcurgridtabvars(parcours->var,0));
-                   strcat(ligne,",");
-                   strcpy(ligne2,"");
-                   sprintf(ligne2,"%d",i);
-                   strcat(ligne,ligne2);
-                   if ( i != parcours->var->v_nbdim ) strcat(ligne,"),");
+                   sprintf(ligne2,"lbound(%s,%d",vargridcurgridtabvars(parcours->var,0),i);
+                   strcat(*ligne,ligne2);
+                   if ( i != parcours->var->v_nbdim ) strcat(*ligne,"),");
                 }
-                if ( i == parcours->var->v_nbdim ) strcat(ligne,"))");
+                if ( i == parcours->var->v_nbdim ) strcat(*ligne,"))");
                 i++;
              }
          }
          didvariableadded = 1;
-         compteur = compteur +1 ;
-         /*if ( retour77 == 0 )
-         {
-            strcat(ligne," &");
-            fprintf(outputfile,"\n");
-         }
-         else fprintf(outputfile,"\n     & ");*/
-         /*tofich(outputfile,ligne,0);*/
       }
       parcours = parcours -> suiv;
    }
-   
-//   Save_Length(ligne,41);
-//   tofich(outputfile,ligne,0);
-   /* Now we should replace the last ", &" by " &"                            */
-/*   if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR);
-   if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/
-   if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Call\n");
+   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop_Call\n");
 }
 
@@ -280,13 +231,11 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteVariablelist_subloop_Def(FILE *outputfile, char *ligne)
+void WriteVariablelist_subloop_Def(char *ligne)
 {
    listvar *parcours;
-/*   char ligne[LONG_40M];*/
-   int compteur;
-
-   if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Def\n");
+
+   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Def\n");
    parcours = List_UsedInSubroutine_Var;
-   compteur = 0 ;
+
    while ( parcours )
    {
@@ -295,32 +244,15 @@
       /*    in the output file                                                */
       if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  &&
-           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))
-         )
+           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) )
       {
-         if ( didvariableadded == 1 )
-         {
-            strcat(ligne,",");
-         }
+         if ( didvariableadded == 1 )   strcat(ligne,",");
          strcat(ligne,parcours->var->v_nomvar);
          didvariableadded = 1;
-            }
+      }
       parcours = parcours -> suiv;
    }
- /*  if ( compteur != 3 && compteur != 0 )
-   {
-      if ( retour77 == 0 ) fprintf(outputfile,"\n      %s &",ligne);
-      else fprintf(outputfile,"\n     & %s",ligne);
-   }*/
    Save_Length(ligne,41);
- //  tofich(outputfile,ligne,0);
-
-   /* Now we should replace the last ", &" by " &"                            */
-  /* if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR);
-   if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/
-   if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Def\n");
-   
-}
-
-
+   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop_Def\n");
+}
 
 /******************************************************************************/
@@ -340,33 +272,27 @@
 void WriteHeadofSubroutineLoop()
 {
-   char ligne[LONG_40M];
+   char ligne[LONG_M];
    FILE * subloop;
 
-   if ( todebug == 1 ) printf("Enter in WriteHeadofSubroutineLoop\n");
-   tofich(fortranout,"\n",1);
+   if ( todebug == 1 ) printf("> enter in WriteHeadofSubroutineLoop\n");
+   tofich(fortran_out,"\n",1);
    /* Open this newfile                                                       */
    sprintf(ligne,"Sub_Loop_%s.h",subroutinename);
-   subloop = associate(ligne);
+   subloop = open_for_write(ligne);
    /*                                                                         */
-   if (isrecursive) 
-   {
-   sprintf(ligne,"      recursive subroutine Sub_Loop_%s(",subroutinename);
-   }
-   else
-   {
-   sprintf(ligne,"      subroutine Sub_Loop_%s(",subroutinename);
-   }
+   if (isrecursive) sprintf(ligne,"recursive subroutine Sub_Loop_%s(",subroutinename);
+   else             sprintf(ligne,"subroutine Sub_Loop_%s(",subroutinename);
    /*                                                                         */
-   WriteVariablelist_subloop(subloop,ligne);
-   WriteVariablelist_subloop_Def(subloop,ligne);
+   WriteVariablelist_subloop(ligne);
+   WriteVariablelist_subloop_Def(ligne);
    /*                                                                         */
-     strcat(ligne,")");
+   strcat(ligne,")");
    tofich(subloop,ligne,1);
    /* if USE agrif_Uti l should be add                                        */
    AddUseAgrifUtil_0(subloop);
    /*                                                                         */
-   oldfortranout = fortranout;
-   fortranout = subloop;
-   if ( todebug == 1 ) printf("Out of WriteHeadofSubroutineLoop\n");
+   oldfortran_out = fortran_out;
+   fortran_out = subloop;
+   if ( todebug == 1 ) printf("<   out of WriteHeadofSubroutineLoop\n");
 }
 
@@ -386,107 +312,93 @@
 void closeandcallsubloopandincludeit_0(int suborfun)
 {
-   char ligne[LONG_40M];
-
-   if ( firstpass == 0 )
-   {
-
-   if ( todebug == 1 ) printf("Enter in closeandcallsubloopandincludeit_0\n");
+   char *ligne;
+
+   if ( firstpass == 1 )    return;
+   if ( todebug == 1 ) printf("> enter in closeandcallsubloopandincludeit_0\n");
+
+   ligne = (char*) calloc(LONG_M, sizeof(char));
+
    if ( IsTabvarsUseInArgument_0() == 1 )
    {
       /* We should remove the key word end subroutine                         */
-      RemoveWordCUR_0(fortranout,(long)(-(pos_cur-pos_endsubroutine)),
-                                          pos_cur-pos_endsubroutine);
+      RemoveWordCUR_0(fortran_out,setposcur()-pos_endsubroutine);
       /* We should close the loop subroutine                                  */
-      sprintf(ligne,"\n      end subroutine Sub_Loop_%s",subroutinename);
-      tofich(fortranout,ligne,1);
-      fclose(fortranout);
-      fortranout = oldfortranout;
-
-
-      AddUseAgrifUtilBeforeCall_0(fortranout);
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename);
+      tofich(fortran_out,ligne,1);
+      fclose(fortran_out);
+      fortran_out = oldfortran_out;
+
+      AddUseAgrifUtilBeforeCall_0(fortran_out);
       WriteArgumentDeclaration_beforecall();
-      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0);
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0);
       if ( !strcasecmp(subofagrifinitgrids,subroutinename) )
-                     fprintf(oldfortranout,"      Call Agrif_Init_Grids () \n");
+            fprintf(fortran_out,"      call Agrif_Init_Grids()\n");
       /* Now we add the call af the new subroutine                            */
-      sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename);
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"  call Sub_Loop_%s(",subroutinename);
       /* Write the list of the local variables used in this new subroutine    */
-      WriteVariablelist_subloop(fortranout,ligne);
+      WriteVariablelist_subloop(ligne);
       /* Write the list of the global tables used in this new subroutine      */
       /*    in doloop                                                         */
-      WriteVariablelist_subloop_Call(fortranout,ligne);
+      WriteVariablelist_subloop_Call(&ligne, LONG_M);
       /* Close the parenthesis of the new subroutine called                   */
-       strcat(ligne,")");
-      
-      tofich(fortranout,ligne,1);
+      strcat(ligne,")\n");
+      tofich(fortran_out,ligne,1);
+      /* we should include the above file in the original code                */
 
       /* We should close the original subroutine                              */
-      if ( suborfun == 3 ) sprintf(ligne,"\n      end program %s"
-                                                               ,subroutinename);
-      if ( suborfun == 2 ) sprintf(ligne,"\n      end");
-      if ( suborfun == 1 ) sprintf(ligne,"\n      end subroutine %s"
-                                                               ,subroutinename);
-      if ( suborfun == 0 ) sprintf(ligne,"\n      end function %s"
-                                                               ,subroutinename);
-      tofich(fortranout,ligne,1);
-      /* we should include the above file in the original code                */
-      sprintf(ligne,"\n#include \"Sub_Loop_%s.h\" \n",subroutinename);
-      tofich(fortranout,ligne,1);
-      }
-    oldfortranout = (FILE *)NULL;      
-   if ( todebug == 1 ) printf("Out of closeandcallsubloopandincludeit_0\n");
-   }
-   
-}
-
-
-
+      if ( suborfun == 3 ) fprintf(fortran_out, "      end program %s\n"   , subroutinename);
+      if ( suborfun == 2 ) fprintf(fortran_out, "      end\n");
+      if ( suborfun == 1 ) fprintf(fortran_out, "      end subroutine %s\n", subroutinename);
+      if ( suborfun == 0 ) fprintf(fortran_out, "      end function %s\n"  , subroutinename);
+
+      fprintf(fortran_out,"\n\n#include \"Sub_Loop_%s.h\"\n",subroutinename);
+    }
+    oldfortran_out = (FILE *)NULL;
+    if ( todebug == 1 ) printf("<   out of closeandcallsubloopandincludeit_0\n");
+}
 
 void closeandcallsubloop_contains_0()
 {
-   char ligne[LONG_40M];
-
-   if ( firstpass == 0 )
-   {
-   if ( todebug == 1 ) printf("Enter in closeandcallsubloopandincludeit_0\n");
+   char *ligne;
+
+   if ( todebug == 1 ) printf("> enter in closeandcallsubloop_contains_0\n");
    if ( IsTabvarsUseInArgument_0() == 1 )
    {
-      Remove_Word_Contains_0();
-      sprintf(ligne,"\n      end subroutine Sub_Loop_%s",subroutinename);
-      tofich(fortranout,ligne,1);
-      fclose(fortranout);
-      fortranout = oldfortranout;
-
-      AddUseAgrifUtilBeforeCall_0(fortranout);
-      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout,
-                                                       "      IMPLICIT NONE\n");
-      WriteLocalParamDeclaration();
+      ligne = (char*) calloc(LONG_M, sizeof(char));
+      RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename);
+      tofich(fortran_out,ligne,1);
+      fclose(fortran_out);
+      fortran_out = oldfortran_out;
+
+      AddUseAgrifUtilBeforeCall_0(fortran_out);
+
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n");
+      WriteLocalParamDeclaration(fortran_out);
       WriteArgumentDeclaration_beforecall();
-      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0);
-      WriteSubroutineDeclaration(0);
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0);
+/*      WriteSubroutineDeclaration(0);*/
       if ( !strcasecmp(subofagrifinitgrids,subroutinename) )
-                     fprintf(oldfortranout,"      Call Agrif_Init_Grids () \n");
+          fprintf(fortran_out,"      call Agrif_Init_Grids()\n");
       /* Now we add the call af the new subroutine                            */
-      if ( retour77 == 0 ) sprintf(ligne,"\n      Call Sub_Loop_%s( &"
-                                                               ,subroutinename);
-      else sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename);
-      fprintf(fortranout,ligne);
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"  call Sub_Loop_%s(",subroutinename);
       /* Write the list of the local variables used in this new subroutine    */
-      WriteVariablelist_subloop(fortranout,ligne);
+      WriteVariablelist_subloop(ligne);
       /* Write the list of the global tables used in this new subroutine      */
       /*    in doloop                                                         */
-      WriteVariablelist_subloop_Call(fortranout,ligne);
+      WriteVariablelist_subloop_Call(&ligne, LONG_M);
       /* Close the parenthesis of the new subroutine called                   */
-      sprintf(ligne,")");
-      tofich(fortranout,ligne,1);
+      strcat(ligne,")\n");
+      tofich(fortran_out,ligne,1);
       /* We should close the original subroutine                              */
-      sprintf(ligne,"\n      contains");
-      tofich(fortranout,ligne,1);
+      fprintf(fortran_out, "      contains\n");
       /* we should include the above file in the original code                */
-      sprintf(ligne,"\n#include \"Sub_Loop_%s.h\" \n",subroutinename);
-      tofich(fortranout,ligne,1);
+      fprintf(fortran_out,"#include \"Sub_Loop_%s.h\"\n",subroutinename);
       }
-   oldfortranout = (FILE *)NULL;
-   if ( todebug == 1 ) printf("Out of closeandcallsubloopandincludeit_0\n");
-   }
-}
+   oldfortran_out = (FILE *)NULL;
+   if ( todebug == 1 ) printf("<   out of closeandcallsubloop_contains_0\n");
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c	(revision 6808)
@@ -45,5 +45,5 @@
 /*                                                                            */
 /******************************************************************************/
-int Vartonumber(char *tokname)
+int Vartonumber(const char *tokname)
 {
    int agrifintheword;
@@ -68,6 +68,11 @@
    else if ( !strcasecmp(tokname,"Agrif_Set_restore")    ) agrifintheword = 1;
    else if ( !strcasecmp(tokname,"Agrif_Save_Forrestore")) agrifintheword = 1;
-   else if ( !strcasecmp(tokname,"agrif_init_grids")     ) agrifintheword = 1;
-   else if ( !strcasecmp(tokname,"agrif_step")           ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_init_grids")     ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_step")           ) agrifintheword = 1;
+/**************************************************/
+/* adding specific adjoint agrif subroutine names */
+/**************************************************/
+   else if ( !strcasecmp(tokname,"Agrif_bc_variable_adj")    ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_update_variable_adj")) agrifintheword = 1;
 
    return agrifintheword;
@@ -85,12 +90,7 @@
 /*                                                                            */
 /******************************************************************************/
-int Agrif_in_Tok_NAME(char *tokname)
-{
-   int agrifintheword;
-
-   if ( strncasecmp(tokname,"Agrif_",6) == 0 )  agrifintheword = 1;
-   else agrifintheword = 0;
-
-   return agrifintheword;
+int Agrif_in_Tok_NAME(const char *tokname)
+{
+    return ( strncasecmp(tokname,"Agrif_",6) == 0 );
 }
 
@@ -104,230 +104,93 @@
 /*                                                                            */
 /******************************************************************************/
-void ModifyTheVariableName_0(char *ident, int lengthname)
-{
-   listvar *newvar;
-   int out;
-   
-   printf("ICI ident = %s\n",ident);
-   
-   if ( firstpass == 0 )
-   {
-      newvar = List_Global_Var;
-      out=0;
-      while ( newvar && out == 0 )
-      {
-         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-         else newvar=newvar->suiv;
-      }
-       printf("out1 = %d\n",out);
-      if ( out == 0 )
-      {
-         newvar = List_ModuleUsed_Var;
-         while ( newvar && out == 0 )
-         {
+void ModifyTheVariableName_0(const char *ident, int lengthname)
+{
+    listvar *newvar;
+    int out;
+
+    if ( firstpass )  return;
+
+    newvar = List_Global_Var;
+    out = 0;
+    while ( newvar && out == 0 )
+    {
+        if ( !strcasecmp(newvar->var->v_nomvar, ident) ) out = 1;
+        else newvar = newvar->suiv;
+    }
+    if ( out == 0 )
+    {
+        newvar = List_ModuleUsed_Var;
+        while ( newvar && out == 0 )
+        {
             if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-      if (out == 1 && !strcasecmp(newvar->var->v_typevar,"type")) return;
-
-      if ( out == 0 )
-      {
-         newvar = List_Common_Var;
-         while ( newvar && out == 0 )
-         {
+            else newvar = newvar->suiv;
+        }
+    }
+    if ( out && !strcasecmp(newvar->var->v_typevar,"type")) return;
+
+    if ( out == 0 )
+    {
+        newvar = List_Common_Var;
+        while ( newvar && out == 0 )
+        {
             if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-
-      if ( out == 0 )
-      {
-         newvar = List_ModuleUsedInModuleUsed_Var;
-         while ( newvar && out == 0 )
-         {
+            else newvar = newvar->suiv;
+        }
+    }
+    if ( out == 0 )
+    {
+        newvar = List_ModuleUsedInModuleUsed_Var;
+        while ( newvar && out == 0 )
+        {
             if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-
-      if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type"))
-      {
-      printf("ICIC3\n");
-         /* remove the variable                                               */
-         RemoveWordCUR_0(fortranout,(long)(-lengthname),
-                               lengthname);
-         fseek(fortranout,(long)(-lengthname),SEEK_CUR);
-         /* then write the new name                                           */
-         if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
-            fprintf(fortranout,"%d",newvar->var->v_indicetabvars);
-         else
-         {
+            else newvar = newvar->suiv;
+        }
+    }
+    if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type"))
+    {
+        // remove the variable
+        RemoveWordCUR_0(fortran_out,lengthname);
+        // then write the new name
+        if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
+            fprintf(fortran_out,"%d",newvar->var->v_indicetabvars);
+        else
+        {
             if ( retour77 == 0 )
-            {
-               fprintf(fortranout," Agrif_tabvars & \n      ");
-            }
+                fprintf(fortran_out,"Agrif_%s & \n      ", tabvarsname(newvar->var));
             else
             {
-               fprintf(fortranout,"Agrif_tabvars");
-               fprintf(fortranout," \n     & ");
+               fprintf(fortran_out,"Agrif_%s", tabvarsname(newvar->var));
+               fprintf(fortran_out," \n     & ");
             }
-            fprintf(fortranout,"%s",
-                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-            colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-         }
-      }
-      else
-      {
-         /* we should look in the List_ModuleUsed_Var                         */
-         if ( inagrifcallargument != 1 )
-         {
+            fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+        }
+    }
+    else
+    {
+        // we should look in the List_ModuleUsed_Var
+        if ( inagrifcallargument != 1 )
+        {
             newvar = List_ModuleUsed_Var;
             while ( newvar && out == 0 )
             {
-               if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-               else newvar=newvar->suiv;
+                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+                else newvar = newvar->suiv;
             }
-            if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type"))
+            if ( out == 1 && strcasecmp(newvar->var->v_typevar, "type"))
             {
-            printf("ICICIC4 %s\n",newvar->var->v_typevar);
-               /* remove the variable                                         */
-               RemoveWordCUR_0(fortranout,(long)(-lengthname),
-                                     lengthname);
-               fseek(fortranout,(long)(-lengthname),SEEK_CUR);
-               /* then write the new name                                     */
-               if ( retour77 == 0 )
-               {
-                  fprintf(fortranout," Agrif_tabvars & \n      ");
-               }
-               else
-               {
-                  fprintf(fortranout," \n     & Agrif_tabvars");
-               }
-               fprintf(fortranout,"%s",
-                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-               colnum = strlen(
-                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+                // remove the variable
+                RemoveWordCUR_0(fortran_out,lengthname);
+                // then write the new name
+                if ( retour77 == 0 )
+                    fprintf(fortran_out,"Agrif_%s & \n      ",tabvarsname(newvar->var));
+                else
+                {
+                    fprintf(fortran_out," \n     &Agrif_%s",tabvarsname(newvar->var));
+                }
+                fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
             }
-         }
-      }
-   }
-}
-
-/******************************************************************************/
-/*                     ModifyTheVariableName_0                                */
-/******************************************************************************/
-/* Firstpass 0                                                                */
-/******************************************************************************/
-/*                                                                            */
-/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
-/*                                                                            */
-/******************************************************************************/
-void ModifyTheVariableNamecoupled_0(char *ident, char* coupledident)
-{
-   listvar *newvar;
-   int out;
-   
-   if ( firstpass == 0 )
-   {
-      newvar = List_Global_Var;
-      out=0;
-      while ( newvar && out == 0 )
-      {
-         if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
-         else newvar=newvar->suiv;
-      }
-
-      if ( out == 0 )
-      {
-         newvar = List_ModuleUsed_Var;
-         while ( newvar && out == 0 )
-         {
-            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-      if ( out == 0 )
-      {
-         newvar = List_Common_Var;
-         while ( newvar && out == 0 )
-         {
-            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-
-      if ( out == 0 )
-      {
-         newvar = List_ModuleUsedInModuleUsed_Var;
-         while ( newvar && out == 0 )
-         {
-            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-
-      if ( out == 1 )
-      {
-         /* remove the variable                                               */
-         RemoveWordCUR_0(fortranout,(long)(-strlen(ident)),
-                               strlen(ident));
-         fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR);
-         /* then write the new name                                           */
-         if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
-            fprintf(fortranout,"%d",newvar->var->v_indicetabvars);
-         else
-         {
-            if ( retour77 == 0 )
-            {
-               fprintf(fortranout," Agrif_tabvars & \n      ");
-            }
-            else
-            {
-               fprintf(fortranout,"Agrif_tabvars");
-               fprintf(fortranout," \n     & ");
-            }
-            fprintf(fortranout,"%s",
-                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-            colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-         }
-      }
-      else
-      {
-         /* we should look in the List_ModuleUsed_Var                         */
-         if ( inagrifcallargument != 1 )
-         {
-            newvar = List_ModuleUsed_Var;
-            while ( newvar && out == 0 )
-            {
-               if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
-               else newvar=newvar->suiv;
-            }
-            if ( out == 1 )
-            {
-               /* remove the variable                                         */
-               RemoveWordCUR_0(fortranout,(long)(-strlen(ident)),
-                                     strlen(ident));
-               fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR);
-               /* then write the new name                                     */
-               if ( retour77 == 0 )
-               {
-                  fprintf(fortranout," Agrif_tabvars & \n      ");
-               }
-               else
-               {
-                  fprintf(fortranout," \n     & Agrif_tabvars");
-               }
-               fprintf(fortranout,"%s",
-                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-               colnum = strlen(
-                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-            }
-         }
-      }
-   }
-}
-
-
+        }
+    }
+}
 
 /******************************************************************************/
@@ -348,40 +211,36 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_SubroutineWhereAgrifUsed_1(char *sub,char *mod)
-{
-  listnom *listnomtmp;
-  listnom *parcours;
-
-  if ( firstpass == 1 )
-  {
-  if ( !List_SubroutineWhereAgrifUsed )
-  {
-     listnomtmp=(listnom *)malloc(sizeof(listnom));
-     strcpy(listnomtmp->o_nom,sub);
-     Save_Length(sub,23);
-     strcpy(listnomtmp->o_module,mod);
-     Save_Length(mod,24);
-     listnomtmp->suiv = NULL;
-     List_SubroutineWhereAgrifUsed  =  listnomtmp;
-  }
-  else
-  {
-    parcours = List_SubroutineWhereAgrifUsed;
-    while ( parcours && strcasecmp(parcours->o_nom,sub) )
-    {
-       parcours = parcours->suiv;
-    }
-    if ( !parcours )
-    {
-       listnomtmp=(listnom *)malloc(sizeof(listnom));
-       strcpy(listnomtmp->o_nom,sub);
-       Save_Length(sub,23);
-       strcpy(listnomtmp->o_module,mod);
-       Save_Length(mod,24);
-       listnomtmp->suiv = List_SubroutineWhereAgrifUsed;
-       List_SubroutineWhereAgrifUsed  =  listnomtmp;
-    }
-  }
-  }
+void Add_SubroutineWhereAgrifUsed_1(const char *sub, const char *mod)
+{
+    listnom *listnomtmp;
+    listnom *parcours;
+
+    if ( firstpass == 1 )
+    {
+        if ( !List_SubroutineWhereAgrifUsed )
+        {
+            listnomtmp = (listnom*) calloc(1, sizeof(listnom));
+            strcpy(listnomtmp->o_nom, sub);
+            strcpy(listnomtmp->o_module, mod);
+            listnomtmp->suiv = NULL;
+            List_SubroutineWhereAgrifUsed = listnomtmp;
+        }
+        else
+        {
+            parcours = List_SubroutineWhereAgrifUsed;
+            while ( parcours && strcasecmp(parcours->o_nom,sub) )
+            {
+                parcours = parcours->suiv;
+            }
+            if ( !parcours )
+            {
+                listnomtmp = (listnom*) calloc(1, sizeof(listnom));
+                strcpy(listnomtmp->o_nom, sub);
+                strcpy(listnomtmp->o_module, mod);
+                listnomtmp->suiv = List_SubroutineWhereAgrifUsed;
+                List_SubroutineWhereAgrifUsed = listnomtmp;
+            }
+        }
+    }
 }
 
@@ -411,7 +270,11 @@
      parcours = List_SubroutineWhereAgrifUsed;
      while ( parcours && strcasecmp(parcours->o_nom,subroutinename) )
-                                                    parcours = parcours -> suiv;
+     {
+        parcours = parcours -> suiv;
+     }
      if ( parcours && parcours->o_val != 0 )
-                                   fprintf(fileout,"\n      USE Agrif_Util \n");
+        fprintf(fileout,"\n      use Agrif_Util\n");
+     else
+        fprintf(fileout,"\n      use Agrif_Types, only : Agrif_tabvars\n");
   }
 }
@@ -419,25 +282,26 @@
 void  AddUseAgrifUtilBeforeCall_0(FILE *fileout)
 {
-  listusemodule *parcours;
-
-  int out;
-
-  if ( firstpass == 0 )
-  {
-     parcours = List_NameOfModuleUsed;
-     out = 0 ;
-     while ( parcours && out == 0 )
-     {
-        if ( !strcasecmp(parcours->u_usemodule,"Agrif_Util")     &&
-             !strcasecmp(parcours->u_modulename,curmodulename)   &&
-             !strcasecmp(parcours->u_cursubroutine,subroutinename)
-            ) out = 1;
-        else parcours = parcours->suiv;
-     }
-     if ( out == 0 )
-     {
-        fprintf(fileout,"\n      USE Agrif_Util \n");
-     }
-  }
+    listusemodule *parcours;
+
+    int out;
+
+    if ( firstpass == 0 )
+    {
+        parcours = List_NameOfModuleUsed;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->u_usemodule, "Agrif_Util")   &&
+                 !strcasecmp(parcours->u_modulename, curmodulename) &&
+                 !strcasecmp(parcours->u_cursubroutine, subroutinename) )
+                out = 1;
+            else
+                parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            fprintf(fileout,"\n      use Agrif_Util\n");
+        }
+    }
 }
 
@@ -451,164 +315,163 @@
 /*                                                                            */
 /******************************************************************************/
-void NotifyAgrifFunction_0(char *ident)
-{
-   if ( firstpass == 0 )
-   {
-      if ( !strcasecmp(ident,"Agrif_parent") )
-      {
-         InAgrifParentDef = 1;
-         pos_curagrifparent = setposcur()-12;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") )
-      {
-         InAgrifParentDef = 2;
-         pos_curagrifparent = setposcur()-21;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Rhox") )
-      {
-         InAgrifParentDef = 3;
-         pos_curagrifparent = setposcur()-10;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") )
-      {
-         InAgrifParentDef = 4;
-         pos_curagrifparent = setposcur()-17;
-      }
-      else if ( !strcasecmp(ident,"Agrif_IRhox") )
-      {
-         InAgrifParentDef = 5;
-         pos_curagrifparent = setposcur()-11;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") )
-      {
-         InAgrifParentDef = 6;
-         pos_curagrifparent = setposcur()-18;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Rhoy") )
-      {
-         InAgrifParentDef = 7;
-         pos_curagrifparent = setposcur()-10;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") )
-      {
-         InAgrifParentDef = 8;
-         pos_curagrifparent = setposcur()-17;
-      }
-      else if ( !strcasecmp(ident,"Agrif_IRhoy") )
-      {
-         InAgrifParentDef = 9;
-         pos_curagrifparent = setposcur()-11;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") )
-      {
-         InAgrifParentDef = 10;
-         pos_curagrifparent = setposcur()-18;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Rhoz") )
-      {
-         InAgrifParentDef = 11;
-         pos_curagrifparent = setposcur()-10;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") )
-      {
-         InAgrifParentDef = 12;
-         pos_curagrifparent = setposcur()-17;
-      }
-      else if ( !strcasecmp(ident,"Agrif_IRhoz") )
-      {
-         InAgrifParentDef = 13;
-         pos_curagrifparent = setposcur()-11;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") )
-      {
-         InAgrifParentDef = 14;
-         pos_curagrifparent = setposcur()-18;
-      }
-      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") )
-      {
-         InAgrifParentDef = 15;
-         pos_curagrifparent = setposcur()-23;
-      }
-      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") )
-      {
-         InAgrifParentDef = 16;
-         pos_curagrifparent = setposcur()-23;
-      }
-      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") )
-      {
-         InAgrifParentDef = 17;
-         pos_curagrifparent = setposcur()-23;
-      }
-      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") )
-      {
-         InAgrifParentDef = 18;
-         pos_curagrifparent = setposcur()-26;
-      }
-      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") )
-      {
-         InAgrifParentDef = 19;
-         pos_curagrifparent = setposcur()-26;
-      }
-      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") )
-      {
-         InAgrifParentDef = 20;
-         pos_curagrifparent = setposcur()-26;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Get_parent_id") )
-      {
-         InAgrifParentDef = 21;
-         pos_curagrifparent = setposcur()-19;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Get_grid_id") )
-      {
-         InAgrifParentDef = 22;
-         pos_curagrifparent = setposcur()-17;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_Iz") )
-      {
-         InAgrifParentDef = 23;
-         pos_curagrifparent = setposcur()-15;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_Iy") )
-      {
-         InAgrifParentDef = 24;
-         pos_curagrifparent = setposcur()-15;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_Ix") )
-      {
-         InAgrifParentDef = 25;
-         pos_curagrifparent = setposcur()-15;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Iz") )
-      {
-         InAgrifParentDef = 26;
-         pos_curagrifparent = setposcur()-8;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Iy") )
-      {
-         InAgrifParentDef = 27;
-         pos_curagrifparent = setposcur()-8;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Ix") )
-      {
-         InAgrifParentDef = 28;
-         pos_curagrifparent = setposcur()-8;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") )
-      {
-         InAgrifParentDef = 29;
-         pos_curagrifparent = setposcur()-20;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") )
-      {
-         InAgrifParentDef = 29;
-         pos_curagrifparent = setposcur()-19;
-      }
-      else if ( !strcasecmp(ident,"AGRIF_Nb_Step") )
-      {
-         InAgrifParentDef = 30;
-         pos_curagrifparent = setposcur()-13;
-      }
-   }
+void NotifyAgrifFunction_0(const char *ident)
+{
+    if ( firstpass == 1 )   return;
+
+    if ( !strcasecmp(ident,"Agrif_parent") )
+    {
+        InAgrifParentDef = 1;
+        pos_curagrifparent = setposcur()-12;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") )
+    {
+        InAgrifParentDef = 2;
+        pos_curagrifparent = setposcur()-21;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Rhox") )
+    {
+        InAgrifParentDef = 3;
+        pos_curagrifparent = setposcur()-10;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") )
+    {
+        InAgrifParentDef = 4;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_IRhox") )
+    {
+        InAgrifParentDef = 5;
+        pos_curagrifparent = setposcur()-11;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") )
+    {
+        InAgrifParentDef = 6;
+        pos_curagrifparent = setposcur()-18;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Rhoy") )
+    {
+        InAgrifParentDef = 7;
+        pos_curagrifparent = setposcur()-10;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") )
+    {
+        InAgrifParentDef = 8;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_IRhoy") )
+    {
+        InAgrifParentDef = 9;
+        pos_curagrifparent = setposcur()-11;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") )
+    {
+        InAgrifParentDef = 10;
+        pos_curagrifparent = setposcur()-18;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Rhoz") )
+    {
+        InAgrifParentDef = 11;
+        pos_curagrifparent = setposcur()-10;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") )
+    {
+        InAgrifParentDef = 12;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_IRhoz") )
+    {
+        InAgrifParentDef = 13;
+        pos_curagrifparent = setposcur()-11;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") )
+    {
+        InAgrifParentDef = 14;
+        pos_curagrifparent = setposcur()-18;
+    }
+    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") )
+    {
+        InAgrifParentDef = 15;
+        pos_curagrifparent = setposcur()-23;
+    }
+    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") )
+    {
+        InAgrifParentDef = 16;
+        pos_curagrifparent = setposcur()-23;
+    }
+    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") )
+    {
+        InAgrifParentDef = 17;
+        pos_curagrifparent = setposcur()-23;
+    }
+    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") )
+    {
+        InAgrifParentDef = 18;
+        pos_curagrifparent = setposcur()-26;
+    }
+    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") )
+    {
+        InAgrifParentDef = 19;
+        pos_curagrifparent = setposcur()-26;
+    }
+    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") )
+    {
+        InAgrifParentDef = 20;
+        pos_curagrifparent = setposcur()-26;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Get_parent_id") )
+    {
+        InAgrifParentDef = 21;
+        pos_curagrifparent = setposcur()-19;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Get_grid_id") )
+    {
+        InAgrifParentDef = 22;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Iz") )
+    {
+        InAgrifParentDef = 23;
+        pos_curagrifparent = setposcur()-15;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Iy") )
+    {
+        InAgrifParentDef = 24;
+        pos_curagrifparent = setposcur()-15;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Ix") )
+    {
+        InAgrifParentDef = 25;
+        pos_curagrifparent = setposcur()-15;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Iz") )
+    {
+        InAgrifParentDef = 26;
+        pos_curagrifparent = setposcur()-8;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Iy") )
+    {
+        InAgrifParentDef = 27;
+        pos_curagrifparent = setposcur()-8;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Ix") )
+    {
+        InAgrifParentDef = 28;
+        pos_curagrifparent = setposcur()-8;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") )
+    {
+        InAgrifParentDef = 29;
+        pos_curagrifparent = setposcur()-20;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") )
+    {
+        InAgrifParentDef = 29;
+        pos_curagrifparent = setposcur()-19;
+    }
+    else if ( !strcasecmp(ident,"AGRIF_Nb_Step") )
+    {
+        InAgrifParentDef = 30;
+        pos_curagrifparent = setposcur()-13;
+    }
 }
 
@@ -622,9 +485,8 @@
 /*                                                                            */
 /******************************************************************************/
-void ModifyTheAgrifFunction_0(char *ident)
+void ModifyTheAgrifFunction_0(const char *ident)
 {
    if ( InAgrifParentDef != 0 )
           AgriffunctionModify_0(ident,InAgrifParentDef);
-   /*                                                                         */
    InAgrifParentDef = 0;
 }
@@ -700,240 +562,228 @@
 /*                                                                            */
 /******************************************************************************/
-void AgriffunctionModify_0(char *ident,int whichone)
-{
-   char toprint[LONG_C];
-   if ( firstpass == 0 )
-   {
-      strcpy(toprint,"");
-      pos_end = setposcur();
-      fseek(fortranout,pos_curagrifparent,SEEK_SET);
-      if ( whichone == 1 || whichone == 2 )
-      {
-         /*                                                                   */
-         FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1);
-         if ( !strcasecmp(ident,toprint) )
-         {
-            /* la liste des use de cette subroutine                           */
-            strcpy(toprint,"");
-            FindAndChangeNameToTabvars(ident,
-                                          toprint,List_Common_Var,whichone);
-         }
-         if ( !strcasecmp(ident,toprint) )
-         {
-            /* la liste des use de cette subroutine                           */
-            strcpy(toprint,"");
-            FindAndChangeNameToTabvars(ident,
-                                          toprint,List_ModuleUsed_Var,whichone);
-         }
-      }
-      else if ( whichone == 3 ) /* Agrif_Rhox                                 */
-      {
-         sprintf(toprint,"REAL(");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"Agrif_Curgrid % spaceref(1))");
-      }
-      else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */
-      {
-         sprintf(toprint,"REAL(");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))");
-      }
-      else if ( whichone == 5 ) /* Agrif_Rhox                                 */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% spaceref(1)");
-      }
-      else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % spaceref(1)");
-      }
-      else if ( whichone == 7 ) /* Agrif_Rhoy                                 */
-      {
-         sprintf(toprint,"REAL(Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% spaceref(2))");
-      }
-      else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */
-      {
-         sprintf(toprint,"REAL(Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % spaceref(2))");
-      }
-      else if ( whichone == 9 ) /* Agrif_Rhoy                                 */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% spaceref(2)");
-      }
-      else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % spaceref(2)");
-      }
-      else if ( whichone == 11 ) /* Agrif_Rhoz                                */
-      {
-         sprintf(toprint,"REAL(Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% spaceref(3))");
-      }
-      else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */
-      {
-         sprintf(toprint,"REAL(Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % spaceref(3))");
-      }
-      else if ( whichone == 13 ) /* Agrif_Rhoz                                */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% spaceref(3)");
-      }
-      else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % spaceref(3)");
-      }
-      else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% NearRootBorder(1)");
-      }
-      else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% NearRootBorder(2)");
-      }
-      else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% NearRootBorder(3)");
-      }
-      else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
+void AgriffunctionModify_0(const char *ident,int whichone)
+{
+    char toprint[LONG_M];
+    if ( firstpass == 0 )
+    {
+        strcpy(toprint,"");
+        pos_end = setposcur();
+        fseek(fortran_out,pos_curagrifparent,SEEK_SET);
+        if ( whichone == 1 || whichone == 2 )
+        {
+            FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1);
+            if ( !strcasecmp(ident,toprint) )
+            {
+                /* la liste des use de cette subroutine                           */
+                strcpy(toprint,"");
+                FindAndChangeNameToTabvars(ident,toprint,List_Common_Var,whichone);
+            }
+            if ( !strcasecmp(ident,toprint) )
+            {
+                /* la liste des use de cette subroutine                           */
+                strcpy(toprint,"");
+                FindAndChangeNameToTabvars(ident,toprint,List_ModuleUsed_Var,whichone);
+            }
+        }
+        else if ( whichone == 3 ) /* Agrif_Rhox                                 */
+        {
+            sprintf(toprint,"REAL(");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"Agrif_Curgrid % spaceref(1))");
+        }
+        else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */
+        {
+            sprintf(toprint,"REAL(");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))");
+        }
+        else if ( whichone == 5 ) /* Agrif_Rhox                                 */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(1)");
+        }
+        else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(1)");
+        }
+        else if ( whichone == 7 ) /* Agrif_Rhoy                                 */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(2))");
+        }
+        else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(2))");
+        }
+        else if ( whichone == 9 ) /* Agrif_Rhoy                                 */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(2)");
+        }
+        else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(2)");
+        }
+        else if ( whichone == 11 ) /* Agrif_Rhoz                                */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(3))");
+        }
+        else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(3))");
+        }
+        else if ( whichone == 13 ) /* Agrif_Rhoz                                */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(3)");
+        }
+        else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(3)");
+        }
+        else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% NearRootBorder(1)");
+        }
+        else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% NearRootBorder(2)");
+        }
+        else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% NearRootBorder(3)");
+        }
+        else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
          strcat(toprint,"% DistantRootBorder(1)");
-      }
-      else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% DistantRootBorder(2)");
-      }
-      else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% DistantRootBorder(3)");
-      }
-      else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % grid_id");
-      }
-      else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% grid_id");
-      }
-      else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % ix(3)");
-      }
-      else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % ix(2)");
-      }
-      else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % ix(1)");
-      }
-      else if ( whichone == 26 ) /* Agrif_Iz                                  */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint," % ix(3)");
-      }
-      else if ( whichone == 27 ) /* Agrif_Iy                                  */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% ix(2)");
-      }
-      else if ( whichone == 28 ) /* Agrif_Ix                                  */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% ix(1)");
-      }
-      else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */
-      {
-         sprintf(toprint,"Agrif_nbfixedgrids");
-      }
-      else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% ngridstep");
-      }
-      /*                                                                      */
-      if ( whichone == 1 || whichone == 2 )
-      {
-         Save_Length(toprint,43);
-         tofich(fortranout,toprint,2);
-      }
-      else
-      {
-/*         if( retour77 == 0 ) fprintf(fortranout," & \n");
-         else fprintf(fortranout,"\n     & ");*/
-         Save_Length(toprint,43);
-         fprintf(fortranout,"%s",toprint);
-      }
-   }
-}
-
+        }
+        else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% DistantRootBorder(2)");
+        }
+        else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% DistantRootBorder(3)");
+        }
+        else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % grid_id");
+        }
+        else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% grid_id");
+        }
+        else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % ix(3)");
+        }
+        else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % ix(2)");
+        }
+        else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % ix(1)");
+        }
+        else if ( whichone == 26 ) /* Agrif_Iz                                  */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint," % ix(3)");
+        }
+        else if ( whichone == 27 ) /* Agrif_Iy                                  */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% ix(2)");
+        }
+        else if ( whichone == 28 ) /* Agrif_Ix                                  */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% ix(1)");
+        }
+        else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */
+        {
+            sprintf(toprint,"Agrif_nbfixedgrids");
+        }
+        else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% ngridstep");
+        }
+
+        Save_Length(toprint,43);
+
+        if ( whichone == 1 || whichone == 2 )   tofich(fortran_out,toprint,0);
+        else                                    fprintf(fortran_out,"%s",toprint);
+    }
+}
 
 /******************************************************************************/
@@ -946,51 +796,43 @@
 /*                                                                            */
 /******************************************************************************/
-void Instanciation_0(char *ident)
-{
-   listvar *newvar;
-   int out;
-
-   if ( firstpass == 0 && sameagrifargument == 1 )
-   {
-      newvar = List_Global_Var;
-
-      out=0;
-      while ( newvar && out == 0 )
-      {
-         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-         else newvar=newvar->suiv;
-      }
-
-      if ( out == 0 )
-      {
-         newvar = List_Common_Var;
-
-         out=0;
-         while ( newvar && out == 0 )
-         {
+void Instanciation_0(const char *ident)
+{
+    listvar *newvar;
+    int out;
+
+    if ( firstpass == 0 && sameagrifargument == 1 )
+    {
+        newvar = List_Global_Var;
+        out = 0;
+        while ( newvar && out == 0 )
+        {
             if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-      if ( out == 0 )
-      {
-         newvar = List_ModuleUsed_Var;
-
-         out=0;
-         while ( newvar && out == 0 )
-         {
-            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-
-      if ( out == 1 )
-      {
-         /* then write the instanciation                                      */
-         fprintf(fortranout,"\n      %s = %s",ident,
-                                          vargridcurgridtabvars(newvar->var,3));
-         colnum = 0;
-      }
-   }
-   sameagrifargument = 0;
-}
+            else newvar = newvar->suiv;
+        }
+        if ( out == 0 )
+        {
+            newvar = List_Common_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+                else newvar = newvar->suiv;
+            }
+        }
+        if ( out == 0 )
+        {
+            newvar = List_ModuleUsed_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+                else newvar = newvar->suiv;
+            }
+        }
+//         if ( out == 1 )
+//         {
+//             /* then write the instanciation                                      */
+//             fprintf(fortran_out,"\n      %s = %s",ident,vargridcurgridtabvars(newvar->var,3));
+//             printf("#\n# Instanciation_0: |%s = %s|\n#\n", ident,vargridcurgridtabvars(newvar->var,3));
+//         }
+    }
+    sameagrifargument = 0;
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c	(revision 6808)
@@ -46,10 +46,10 @@
 /*                                                                            */
 /******************************************************************************/
-/* if  whichone = 0 ----> Agrif_tabvars(i) % var % array2                     */
-/*                                                                            */
-/* if  whichone = 1 ----> Agrif_tabvars(i) % parentvar % var % array2         */
-/*                                                                            */
-/******************************************************************************/
-void FindAndChangeNameToTabvars(char name[LONG_C],char toprint[LONG_4C],
+/* if  whichone = 0 ----> Agrif_tabvars(i) % array2                           */
+/*                                                                            */
+/* if  whichone = 1 ----> Agrif_tabvars(i) % parentvar % array2               */
+/*                                                                            */
+/******************************************************************************/
+void FindAndChangeNameToTabvars(const char name[LONG_M],char toprint[LONG_M],
                                               listvar * listtosee, int whichone)
 {
@@ -71,5 +71,5 @@
             {
                out = 1;
-               strcat(toprint,vargridcurgridtabvars(newvar->var,whichone));
+               strcat(toprint,vargridcurgridtabvars(newvar->var, whichone));
             }
             else newvar=newvar->suiv;
@@ -92,82 +92,37 @@
 /*                                                                            */
 /******************************************************************************/
-char *ChangeTheInitalvaluebyTabvarsName(char *nom,listvar *listtoread,
-                                                                   int whichone)
-{
-   char toprinttmp[LONG_4C];
-   int i;
-   char chartmp[2];
-
-   i=0;
-   strcpy(toprintglob,"");
-   strcpy(toprinttmp,"");
-
-   /*                                                                         */
-   while ( i < strlen(nom) )
-   {
-      if ( nom[i] == '+' )
-      {
-        FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,"+");
-      }
-      else if ( nom[i] == '-' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,"-");
-      }
-      else if ( nom[i] == '*' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,"*");
-      }
-      else if ( nom[i] == '/' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,"/");
-      }
-      else if ( nom[i] == '(' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,"(");
-      }
-      else if ( nom[i] == ')' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,")");
-      }
-      else if ( nom[i] == ':' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,":");
-      }
-      else if ( nom[i] == ',' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,",");
-      }
-      else
-      {
-         sprintf(chartmp,"%c",nom[i]);
-         strcat(toprinttmp,chartmp);
-      }
-      /*                                                                      */
-      i=i+1;
-   }
-   FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-   strcpy(toprinttmp,"");
-
-   Save_Length(toprinttmp,44);
-   Save_Length(toprintglob,39);
-
-   /*                                                                         */
-   return toprintglob;
+const char *ChangeTheInitalvaluebyTabvarsName(const char *nom, listvar *listtoread)
+{
+    char toprinttmp[LONG_M];
+    char chartmp[2];
+    size_t i = 0;
+
+    strcpy(toprintglob, "");
+    strcpy(toprinttmp,  "");
+
+    while ( i < strlen(nom) )
+    {
+        if ( (nom[i] == '+') || (nom[i] == '-') || (nom[i] == '*') || (nom[i] == '/') ||
+             (nom[i] == '(') || (nom[i] == ')') || (nom[i] == ':') || (nom[i] == ',') )
+        {
+            FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,0);
+            strcpy(toprinttmp, "");
+            sprintf(chartmp, "%c", nom[i]);
+            strcat(toprintglob, chartmp);
+        }
+        else
+        {
+            sprintf(chartmp, "%c", nom[i]);
+            strcat(toprinttmp, chartmp);
+        }
+        i += 1;
+    }
+    FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,0);
+    strcpy(toprinttmp,"");
+
+    Save_Length(toprinttmp,44);
+    Save_Length(toprintglob,39);
+
+    return toprintglob;
 }
 
@@ -181,19 +136,10 @@
 /*                                                                            */
 /******************************************************************************/
-int IsVariableReal(char *nom)
-{
-   int Real;
-
-   Real = 0;
-   if ( ( nom[0] >= 'a' && nom[0] <= 'h' ) ||
+int IsVariableReal(const char *nom)
+{
+    return ( ( nom[0] >= 'a' && nom[0] <= 'h' ) ||
         ( nom[0] >= 'A' && nom[0] <= 'H' ) ||
         ( nom[0] >= 'o' && nom[0] <= 'z' ) ||
-        ( nom[0] >= 'O' && nom[0] <= 'Z' )
-       )
-       {
-          Real = 1;
-       }
-   /*                                                                         */
-   return Real;
+        ( nom[0] >= 'O' && nom[0] <= 'Z' ) );
 }
 /******************************************************************************/
@@ -206,5 +152,5 @@
 /*                                                                            */
 /******************************************************************************/
-void IsVarInUseFile(char *nom)
+void IsVarInUseFile(const char *nom)
 {
    listvar *parcours;
@@ -217,5 +163,5 @@
    while( parcours && out == 0 )
    {
-      if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ;
+      if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ;
      else parcours=parcours->suiv;
    }
@@ -225,4 +171,13 @@
       while( parcours && out == 0 )
       {
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ;
+        else parcours=parcours->suiv;
+      }
+   }
+   if ( out == 0 )
+   {
+      parcours = List_GlobalParameter_Var;
+      while( parcours && out == 0 )
+      {
          if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ;
         else parcours=parcours->suiv;
@@ -231,17 +186,8 @@
    if ( out == 0 )
    {
-      parcours = List_GlobalParameter_Var;
-      while( parcours && out == 0 )
-      {
-         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ;
-        else parcours=parcours->suiv;
-      }
-   }
-   if ( out == 0 )
-   {
       parcours = List_Parameter_Var;
       while( parcours && out == 0 )
       {
-         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ;
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ;
         else parcours=parcours->suiv;
       }
@@ -252,5 +198,5 @@
       while( parcoursparam && out == 0 )
       {
-         if ( !strcasecmp(nom,parcoursparam->p_name) ) out =2 ;
+         if ( !strcasecmp(nom,parcoursparam->p_name) ) out = 2 ;
          else parcoursparam=parcoursparam->suiv;
       }
@@ -261,5 +207,5 @@
       while( parcours && out == 0 )
       {
-         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =2 ;
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 2 ;
         else parcours=parcours->suiv;
       }
@@ -270,5 +216,5 @@
       while( parcoursparam && out != 1 )
       {
-         if ( !strcasecmp(nom,parcoursparam->p_name) ) out =1 ;
+         if ( !strcasecmp(nom,parcoursparam->p_name) ) out = 1 ;
          else parcoursparam=parcoursparam->suiv;
       }
@@ -299,13 +245,12 @@
 /*                                                                            */
 /******************************************************************************/
-listnom *DecomposeTheNameinlistnom(char *nom, listnom * listout)
-{
-   char toprinttmp[LONG_4C];
-   int i;
+listnom *DecomposeTheNameinlistnom(const char *nom, listnom * listout)
+{
+   char toprinttmp[LONG_M];
    char chartmp[2];
-
-   i=0;
+   size_t i = 0;
+
    strcpy(toprinttmp,"");
-   /*                                                                         */
+
    while ( i < strlen(nom) )
    {
@@ -320,5 +265,4 @@
          )
       {
-
          if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
          {
@@ -331,7 +275,5 @@
          sprintf(chartmp,"%c",nom[i]);
          strcat(toprinttmp,chartmp);
-
-      }
-      /*                                                                      */
+      }
       i=i+1;
    }
@@ -340,6 +282,6 @@
       listout = Addtolistnom(toprinttmp,listout,0);
    }
+   Save_Length(toprinttmp,44);
    strcpy(toprinttmp,"");
-   Save_Length(toprinttmp,44);
 
    return listout;
@@ -356,13 +298,12 @@
 /*                                                                            */
 /******************************************************************************/
-void DecomposeTheName(char *nom)
-{
-   char toprinttmp[LONG_4C];
-   int i;
+void DecomposeTheName(const char *nom)
+{
+   char toprinttmp[LONG_M];
    char chartmp[2];
-
-   i=0;
+   size_t i = 0;
+   
    strcpy(toprinttmp,"");
-   /*                                                                         */
+
    while ( i < strlen(nom) )
    {
@@ -390,8 +331,6 @@
          strcat(toprinttmp,chartmp);
       }
-      /*                                                                      */
       i=i+1;
    }
-   Save_Length(toprinttmp,44);
    if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
    {
@@ -400,26 +339,27 @@
       IsVarInUseFile(toprinttmp);
    }
+   Save_Length(toprinttmp,44);
    strcpy(toprinttmp,"");
 
 }
 
-void convert2lower(char *name)
-{
-   int l;
-   int i;
-   int caractere;
-
-   l=strlen(name)-1;
-   for (i=0;i<=l;i++)
-   {
-      caractere=name[i];
-      if ((caractere>=65 && caractere<=90)||(caractere>=192 && caractere<=221))
-      {
-         name[i]+=32;
-      }
-   }
-}
-
-int convert2int(char *name)
+void convert2lower(char *lowername, const char* inputname)
+{
+    int i, l, caractere;
+
+    strcpy(lowername, inputname);
+    l = strlen(lowername)-1;
+
+    for ( i=0 ; i<=l ; i++)
+    {
+        caractere = lowername[i];
+        if ( (caractere>=65 && caractere<=90) || (caractere>=192 && caractere<=221) )
+        {
+            lowername[i] += 32;
+        }
+    }
+}
+
+int convert2int(const char *name)
 {
    int i;
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c	(revision 6808)
@@ -40,31 +40,29 @@
 
 /******************************************************************************/
-/*                            associate                                       */
+/*                         open_for_write                                     */
 /******************************************************************************/
 /* This subroutine is used to open a file                                     */
 /******************************************************************************/
-FILE * associate (char *filename)
+FILE* open_for_write (const char *filename)
 {
-  char filefich[LONG_C];
-  sprintf(filefich,"%s/%s",nomdir,filename);
-  return fopen (filefich, "w");
+    char filefich[LONG_FNAME];
+    sprintf(filefich,"%s/%s",include_dir,filename);
+    return fopen(filefich, "w");
 }
 
-
 /******************************************************************************/
-/*                          associateaplus                                    */
+/*                          open_for_append                                   */
 /******************************************************************************/
 /* This subroutine is used to open a file with option a+                      */
 /******************************************************************************/
-FILE * associateaplus (char *filename)
+FILE* open_for_append (const char *filename)
 {
-  char filefich[LONG_C];
-  sprintf(filefich,"%s/%s",nomdir,filename);
-  return fopen (filefich, "a+");
+    char filefich[LONG_M];
+    sprintf(filefich,"%s/%s",include_dir,filename);
+    return fopen(filefich, "a+");
 }
 
-
 /******************************************************************************/
-/*                           setposcurname                                       */
+/*                           setposcurname                                    */
 /******************************************************************************/
 /* This subroutine is used to know the current position in the file in argument    */
@@ -76,6 +74,6 @@
 long int setposcurname(FILE *fileout)
 {
-   fflush(fileout);
-   return ftell(fileout);
+    fflush(fileout);
+    return ftell(fileout);
 }
 
@@ -91,21 +89,5 @@
 long int setposcur()
 {
-   fflush(fortranout);
-   return ftell(fortranout);
-}
-
-/******************************************************************************/
-/*                      setposcurinoldfortranout                              */
-/******************************************************************************/
-/* This subroutine is used to know the position in the oldfortranout         */
-/******************************************************************************/
-/*                                                                            */
-/*             setposcurinoldfortranout ---------> position in file           */
-/*                                                                            */
-/******************************************************************************/
-long int setposcurinoldfortranout()
-{
-   fflush(oldfortranout);
-   return ftell(oldfortranout);
+    return setposcurname(fortran_out);
 }
 
@@ -114,16 +96,16 @@
 /******************************************************************************/
 /* Firstpass 0                                                                */
-/* We should write in the fortranout the USE tok_name                         */
+/* We should write in the fortran_out the USE tok_name                         */
 /* read in the original file                                                  */
 /******************************************************************************/
 /*                                                                            */
 /******************************************************************************/
-void copyuse_0(char *namemodule)
+void copyuse_0(const char *namemodule)
 {
-   if (firstpass == 0 && IsTabvarsUseInArgument_0() == 1 )
-   {
-      /* We should write this declaration into the original subroutine too    */
-      fprintf(oldfortranout,"      USE %s \n",namemodule);
-   }
+    if ( IsTabvarsUseInArgument_0() == 1 )
+    {
+        /* We should write this declaration into the original subroutine too    */
+        fprintf(oldfortran_out,"      use %s\n", namemodule);
+    }
 }
 
@@ -132,15 +114,15 @@
 /******************************************************************************/
 /* Firstpass 0                                                                */
-/* We should write in the fortranout the USE tok_name, only                   */
+/* We should write in the fortran_out the USE tok_name, only                   */
 /* read in the original file                                                  */
 /******************************************************************************/
 /*                                                                            */
 /******************************************************************************/
-void copyuseonly_0(char *namemodule)
+void copyuseonly_0(const char *namemodule)
 {
    if (firstpass == 0 && IsTabvarsUseInArgument_0() == 1 )
    {
       /* We should write this declaration into the original subroutine too    */
-      fprintf(oldfortranout,"      USE %s , ONLY : \n",namemodule);
+      fprintf(oldfortran_out,"      use %s , only : \n", namemodule);
    }
 }
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c	(revision 6808)
@@ -43,19 +43,15 @@
 /* This subroutine is used to initialized grid dimension variable             */
 /******************************************************************************/
-/*                                                                            */
-/*                                                                            */
-/*                                                                            */
-/******************************************************************************/
-void initdimprob(int dimprobmod, char * nx, char * ny,char* nz)
-{
-  dimprob = dimprobmod;
-
-  strcpy(nbmaillesX,nx);
-  strcpy(nbmaillesY,ny);
-  strcpy(nbmaillesZ,nz);
-}
-
-/******************************************************************************/
-/*                      Variableshouldberemove                                */
+void initdimprob(int dimprobmod, const char * nx, const char * ny, const char* nz)
+{
+    dimprob = dimprobmod;
+
+    strcpy(nbmaillesX, nx);
+    strcpy(nbmaillesY, ny);
+    strcpy(nbmaillesZ, nz);
+}
+
+/******************************************************************************/
+/*                      Variableshouldberemoved                               */
 /******************************************************************************/
 /* Firstpass 0                                                                */
@@ -65,14 +61,7 @@
 /*                                                                            */
 /******************************************************************************/
-int Variableshouldberemove(char *nom)
-{
-
-   int remove;
-
-   remove = 0 ;
-
-   if ( remove == 0 && Agrif_in_Tok_NAME(nom) == 1 ) remove = 1 ;
-
-   return remove;
+int Variableshouldberemoved(const char *nom)
+{
+    return Agrif_in_Tok_NAME(nom);
 }
 
@@ -97,18 +86,17 @@
         /* Now we should give the definition of the variable in the           */
         /* table List_UsedInSubroutine_Var                                    */
-        printf("QDKFLSDFKSLDF\n");
-        strcpy(curvar->var->v_typevar,newvar->var->v_typevar);
-        strcpy(curvar->var->v_dimchar,newvar->var->v_dimchar);
-        curvar->var->v_nbdim = newvar->var->v_nbdim;
+        strcpy(curvar->var->v_typevar, newvar->var->v_typevar);
+        strcpy(curvar->var->v_dimchar, newvar->var->v_dimchar);
+        curvar->var->v_nbdim          = newvar->var->v_nbdim;
         curvar->var->v_dimensiongiven = newvar->var->v_dimensiongiven;
-        curvar->var->v_allocatable = newvar->var->v_allocatable;
-        curvar->var->v_target = newvar->var->v_target;
+        curvar->var->v_allocatable    = newvar->var->v_allocatable;
+        curvar->var->v_target         = newvar->var->v_target;
+        curvar->var->v_catvar         = newvar->var->v_catvar;
         curvar->var->v_pointerdeclare = newvar->var->v_pointerdeclare;
-        curvar->var->v_indicetabvars = newvar->var->v_indicetabvars;
-        strcpy(curvar->var->v_nameinttypename,newvar->var->v_nameinttypename);
-        strcpy(curvar->var->v_precision,newvar->var->v_precision);
-        strcpy(curvar->var->v_readedlistdimension,
-                                            newvar->var->v_readedlistdimension);
-        strcpy(curvar->var->v_commoninfile,newvar->var->v_commoninfile);
+        curvar->var->v_indicetabvars  = newvar->var->v_indicetabvars;
+        strcpy(curvar->var->v_nameinttypename, newvar->var->v_nameinttypename);
+        strcpy(curvar->var->v_precision, newvar->var->v_precision);
+        strcpy(curvar->var->v_readedlistdimension, newvar->var->v_readedlistdimension);
+        strcpy(curvar->var->v_commoninfile, newvar->var->v_commoninfile);
      }
      else
@@ -128,13 +116,12 @@
   present = 0;
   newvar = listin;
+
   while ( newvar && present == 0 )
   {
      if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) &&
-          !strcasecmp(newvar->var->v_subroutinename,
-                                    curvar->var->v_subroutinename)
-        )
+          !strcasecmp(newvar->var->v_subroutinename, curvar->var->v_subroutinename) )
      {
         strcpy(curvar->var->v_commoninfile,newvar->var->v_commoninfile);
-        CopyRecord(curvar->var,newvar->var);
+        Merge_Variables(curvar->var,newvar->var);
         present = 1;
      }
@@ -156,5 +143,5 @@
      if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) )
      {
-        CopyRecord(curvar->var,newvar->var);
+        Merge_Variables(curvar->var,newvar->var);
         present = 1;
      }
@@ -170,5 +157,5 @@
 /* This subroutine is to know if a variable is global                         */
 /******************************************************************************/
-void variableisglobalinmodule(listcouple *listin, char *module, FILE *fileout, long int oldposcuruse)
+void variableisglobalinmodule(listcouple *listin, const char *module, FILE *fileout, long int oldposcuruse)
 {
   int Globalite;
@@ -178,5 +165,5 @@
   listvar *newvar2;
   int out;
-  char truename[LONG_C];  
+  char truename[LONG_VNAME];
 
   Globalite = 1;
@@ -195,5 +182,5 @@
        strcpy(truename,newvar->c_namepointedvar);
      }
-     
+
      out = 0;
      newvar2 = tempo;
@@ -227,11 +214,10 @@
   {
      pos_end = setposcurname(fileout);
-     RemoveWordSET_0(fileout,oldposcuruse,
-                                pos_end-oldposcuruse);
-                                  
+     RemoveWordSET_0(fileout,oldposcuruse,pos_end-oldposcuruse);
+
      newvar = listin;
      while ( newvar )
      {
-        fprintf(fileout,"      USE %s, ONLY : %s \n",module,newvar->c_namevar);
+        fprintf(fileout,"      use %s, only : %s \n",module,newvar->c_namevar);
         newvar = newvar->suiv;
      }
@@ -239,40 +225,13 @@
 }
 
-
-void Remove_Word_Contains_0()
-{
-   if ( firstpass == 0 )
-   {
-      RemoveWordCUR_0(fortranout,(long)(-9),9);
-   }
-}
-
-void Remove_Word_end_module_0(int modulenamelength)
-{
-   if ( firstpass == 0 )
-   {
-      RemoveWordCUR_0(fortranout,(long)(-modulenamelength-12),
-                                         modulenamelength+11);
-   }
-}
-
-void Write_Word_Contains_0()
-{
-   if ( firstpass == 0 )
-   {
-      fprintf(fortranout,"\n      contains\n");
-   }
-}
-
-
 void Write_Word_end_module_0()
 {
-   if ( firstpass == 0 )
-   {
-      fprintf(fortranout,"\n      end module %s",curmodulename);
-   }
-}
-
-void Add_Subroutine_For_Alloc(char *nom)
+    if ( firstpass == 0 )
+    {
+        fprintf(fortran_out,"\n      end module %s",curmodulename);
+    }
+}
+
+void Add_Subroutine_For_Alloc(const char *nom)
 {
    listnom *parcours;
@@ -280,7 +239,6 @@
    int out;
 
-   newvar = (listnom *)malloc(sizeof(listnom));
+   newvar = (listnom*) calloc(1, sizeof(listnom));
    strcpy(newvar->o_nom,nom);
-   Save_Length(nom,23);
    newvar->suiv = NULL;
 
@@ -306,270 +264,137 @@
 }
 
-
-void Write_Alloc_Subroutine_0()
-{
-   listnom *parcours_nom;
-   listnom *parcours_nomprec;
-   int out;
-   char ligne[LONG_C];
-
-   if ( firstpass == 0 )
-   {
-      parcours_nomprec = (listnom *)NULL;
-      parcours_nom = List_NameOfModule;
-      out = 0 ;
-      while ( parcours_nom && out == 0 )
-      {
-         /*                                                                   */
-         if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1;
-         else parcours_nom = parcours_nom -> suiv;
-      }
-      if ( out == 1 )
-      {
-         if ( parcours_nom->o_val == 1 )
-         {
-            strcpy (ligne, "\n      PUBLIC Alloc_agrif_");
-            strcat (ligne, curmodulename);
-            strcat (ligne, "\n");
-            convert2lower(ligne);
-            fprintf(fortranout,ligne);
-         }
-      }
-      Write_Word_Contains_0();
-      if ( out == 1 )
-      {
-         if ( parcours_nom->o_val == 1 )
-         {
-            sprintf (ligne, "Subroutine Alloc_agrif_%s(Agrif_Gr)",
-                                                                 curmodulename);
-            tofich(fortranout,ligne,1);
-            strcpy(ligne,"Use Agrif_Util");
-            tofich(fortranout,ligne,1);
-            strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr");
-            tofich(fortranout,ligne,1);
-            strcpy(ligne, "INTEGER :: i");
-            tofich (fortranout, ligne,1);
-            strcpy (ligne, "\n#include \"alloc_agrif_");
-            strcat (ligne, curmodulename);
-            strcat (ligne, ".h\"\n");
-            convert2lower(ligne);
-            fprintf(fortranout,ligne);
-            strcpy (ligne, "Return");
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "End Subroutine Alloc_agrif_%s",curmodulename);
-            tofich(fortranout,ligne,1);
-            /* List all Call Alloc_agrif_                                     */
+void Write_Closing_Module(int forend)
+{
+    listvar *parcours;
+    listnom *parcours_nom;
+    listnom *parcours_nomprec;
+    variable *v;
+    int out = 0;
+    int headtypewritten = 0;
+    char ligne[LONG_M];
+    int changeval;
+
+    // Write Global Parameter Declaration
+    parcours = List_GlobalParameter_Var;
+    while( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_modulename, curmodulename) )
+        {
+            WriteVarDeclaration(parcours->var, module_declar, 0, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+
+    // Write Global Type declaration
+    parcours = List_Global_Var;
+    while( parcours )
+    {
+        v = parcours->var;
+        if ( !strcasecmp(v->v_modulename, curmodulename) &&
+             !strcasecmp(v->v_typevar, "type") )
+        {
+            if ( headtypewritten == 0 )
+            {
+                fprintf(fortran_out, "\n      type Agrif_%s\n", curmodulename);
+                headtypewritten = 1;
+            }
+            changeval = 0;
+            if ( v->v_allocatable )
+            {
+                changeval = 1;
+                v->v_allocatable = 0;
+                v->v_pointerdeclare = 1;
+            }
+            WriteVarDeclaration(v, fortran_out, 0, 0);
+            if ( changeval )
+            {
+                v->v_allocatable = 1;
+                v->v_pointerdeclare = 0;
+            }
+            out = 1;
+        }
+        parcours = parcours -> suiv;
+    }
+    if (out == 1)
+    {
+        fprintf(fortran_out, "      end type Agrif_%s\n", curmodulename);
+        sprintf(ligne, "type(Agrif_%s), dimension(:), allocatable :: Agrif_%s_var",curmodulename, curmodulename);
+        tofich(fortran_out,ligne,1);
+        fprintf(fortran_out, "      public :: Agrif_%s\n", curmodulename);
+        fprintf(fortran_out, "      public :: Agrif_%s_var\n", curmodulename);
+    }
+
+    // Write NotGridDepend declaration
+    parcours = List_NotGridDepend_Var;
+    while( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
+        {
+            WriteVarDeclaration(parcours->var, fortran_out, 0, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+
+    // Write Alloc_agrif_'modulename' subroutine
+    parcours_nomprec = (listnom*) NULL;
+    parcours_nom = List_NameOfModule;
+    out = 0 ;
+    while ( parcours_nom && out == 0 )
+    {
+        if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1;
+        else parcours_nom = parcours_nom -> suiv;
+    }
+    if ( ! out )
+    {
+        printf("#\n# Write_Closing_Module : OUT == 0   *** /!\\ ***\n");
+        printf("# FIXME: POSSIBLE BUG in CONV !!!\n#\n");
+    }
+    if ( out )
+    {
+        if ( parcours_nom->o_val == 1 )
+        {
+            fprintf(fortran_out,"\n      public :: Alloc_agrif_%s\n",curmodulename);
+        }
+        if ( (forend == 0) || (parcours_nom->o_val == 1) )
+        {
+           fprintf(fortran_out,"\n      contains\n");
+        }
+        if ( parcours_nom->o_val == 1 )
+        {
+            fprintf(fortran_out, "      subroutine Alloc_agrif_%s(Agrif_Gr)\n", curmodulename);
+            fprintf(fortran_out, "          use Agrif_Util\n");
+            fprintf(fortran_out, "          type(Agrif_grid), pointer :: Agrif_Gr\n");
+            fprintf(fortran_out, "          integer :: i\n");
+            fprintf(fortran_out, "\n#include \"alloc_agrif_%s.h\"\n", curmodulename);
+            fprintf(fortran_out, "      end subroutine Alloc_agrif_%s\n", curmodulename);
             Add_Subroutine_For_Alloc(curmodulename);
-         }
-         else
-         {
+        }
+        else
+        {
             parcours_nom = List_Subroutine_For_Alloc;
             out = 0;
             while ( parcours_nom && out == 0 )
             {
-               if ( !strcasecmp(parcours_nom->o_nom,curmodulename) ) out = 1;
-               else
-               {
-                  parcours_nomprec = parcours_nom;
-                  parcours_nom = parcours_nom->suiv;
-               }
-            }
-            if ( out == 1 )
-            {
-               if ( parcours_nom == List_Subroutine_For_Alloc)
-               {
-                  List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv;
-               }
-               else
-               {
-                  parcours_nomprec->suiv = parcours_nom->suiv;
-                  parcours_nom = parcours_nomprec->suiv ;
-               }
-            }
-         }
-      }
-   }
-}
-
-
-void Write_Alloc_Subroutine_For_End_0()
-{
-   listnom *parcours_nom;
-   listnom *parcours_nomprec;
-   int out;
-   char ligne[LONG_C];
-
-   if ( firstpass == 0 )
-   {
-      parcours_nomprec = (listnom *)NULL;
-      parcours_nom = List_NameOfModule;
-      out = 0 ;
-      while ( parcours_nom && out == 0 )
-      {
-         /*                                                                   */
-         if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1;
-         else parcours_nom = parcours_nom -> suiv;
-      }
-      if ( out == 1 )
-      {
-         if ( parcours_nom->o_val == 1 )
-         {
-            strcpy (ligne, "\n      PUBLIC Alloc_agrif_");
-            strcat (ligne, curmodulename);
-            strcat (ligne, "\n");
-            convert2lower(ligne);
-            fprintf(fortranout,ligne);
-            strcpy (ligne, "\n      contains\n");
-            fprintf(fortranout,ligne);
-            sprintf (ligne, "Subroutine Alloc_agrif_%s(Agrif_Gr)",
-                                                                 curmodulename);
-            tofich(fortranout,ligne,1);
-            strcpy(ligne,"Use Agrif_Util");
-            tofich(fortranout,ligne,1);
-            strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr");
-            tofich(fortranout,ligne,1);
-            strcpy(ligne, "INTEGER :: i");
-            tofich (fortranout, ligne,1);
-            strcpy (ligne, "\n#include \"alloc_agrif_");
-            strcat (ligne, curmodulename);
-            strcat (ligne, ".h\"\n");
-            convert2lower(ligne);
-            fprintf(fortranout,ligne);
-            strcpy (ligne, "Return");
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "End Subroutine Alloc_agrif_%s",curmodulename);
-            tofich(fortranout,ligne,1);
-            /* List all Call Alloc_agrif                                      */
-            Add_Subroutine_For_Alloc(parcours_nom->o_nom);
-         }
-         else
-         {
-            parcours_nom = List_Subroutine_For_Alloc;
-            out = 0;
-            while ( parcours_nom && out == 0 )
-            {
-               if ( !strcasecmp(parcours_nom->o_nom,curmodulename) ) out = 1;
-               else
-               {
-                  parcours_nomprec = parcours_nom;
-                  parcours_nom = parcours_nom->suiv;
-               }
-            }
-            if ( out == 1 )
-            {
-               if ( parcours_nom == List_Subroutine_For_Alloc)
-               {
-                  List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv;
-               }
-               else
-               {
-                  parcours_nomprec->suiv = parcours_nom->suiv;
-                  parcours_nom = parcours_nomprec->suiv ;
-               }
-            }
-         }
-      }
-   }
-}
-
-void Write_GlobalParameter_Declaration_0()
-{
-   listvar *parcours;
-
-   if ( firstpass == 0 )
-   {
-      parcours = List_GlobalParameter_Var;
-      while( parcours )
-      {
-         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
-         {
-            writevardeclaration(parcours,module_declar,0,1);
-         }
-         parcours = parcours -> suiv;
-      }
-   }
-}
-
-void Write_GlobalType_Declaration_0()
-{
-   listvar *parcours;
-   int out = 0;
-   int headtypewritten = 0;
-   char ligne[LONGNOM];
-   int changeval;
-
-   if ( firstpass == 0 )
-   {
-      parcours = List_Global_Var;
-      while( parcours )
-      {
-         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
-         {
-           if (!strcasecmp(parcours->var->v_typevar,"type"))
-           {
-            out = 1;
-            if (headtypewritten == 0)
-              {
-/*RB*/
-                sprintf (ligne, "Module_DeclarType_%s.h",curmodulename);
-                module_declar_type = associate(ligne);
-                sprintf (ligne, " ");
-                tofich (module_declar_type, ligne,1);
-                sprintf(ligne,"TYPE :: Agrif_%s",curmodulename);
-                tofich(module_declar_type,ligne,1);
-                headtypewritten = 1;
-/*RBend*/
-              }
-            changeval = 0;
-            if (parcours->var->v_allocatable == 1)
-             {
-               changeval = 1;
-               parcours->var->v_allocatable = 0;
-               parcours->var->v_pointerdeclare = 1;
-             }
-/*RB*/
-            writevardeclaration(parcours,module_declar_type,0,0);
-/*RBend*/
-            if (changeval == 1)
-              {
-               parcours->var->v_allocatable = 1;
-               parcours->var->v_pointerdeclare = 0;
-              }
-            }
-         }
-         parcours = parcours -> suiv;
-      }
-      if (out == 1)
-        {
-/*RB*/
-                sprintf(ligne,"END TYPE Agrif_%s",curmodulename);
-                tofich(module_declar_type,ligne,1);
-                sprintf(ligne,"TYPE(Agrif_%s), DIMENSION(:), ALLOCATABLE :: Agrif_%s_var",curmodulename,curmodulename); 
-                tofich(module_declar_type,ligne,1);
-                sprintf(ligne,"PUBLIC :: Agrif_%s",curmodulename); 
-                tofich(module_declar_type,ligne,1);
-                sprintf(ligne,"PUBLIC :: Agrif_%s_var",curmodulename); 
-                tofich(module_declar_type,ligne,1);
-/*RBend*/
-        }
-   }
-}
-
-void Write_NotGridDepend_Declaration_0()
-{
-   listvar *parcours;
-
-   if ( firstpass == 0 )
-   {
-      parcours = List_NotGridDepend_Var;
-      while( parcours )
-      {
-         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
-         {
-            writevardeclaration(parcours,fortranout,0,1);
-         }
-         parcours = parcours -> suiv;
-      }
-   }
+                if ( !strcasecmp(parcours_nom->o_nom, curmodulename) ) out = 1;
+                else
+                {
+                    parcours_nomprec = parcours_nom;
+                    parcours_nom = parcours_nom->suiv;
+                }
+            }
+            if ( out )
+            {
+                if ( parcours_nom == List_Subroutine_For_Alloc)
+                {
+                    List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv;
+                }
+                else
+                {
+                    parcours_nomprec->suiv = parcours_nom->suiv;
+                    parcours_nom = parcours_nomprec->suiv ;
+                }
+            }
+        }
+    }
 }
 
@@ -669,7 +494,6 @@
       if ( !List_Pointer_Var )
       {
-         newvar = (listname *)malloc(sizeof(listname));
-         strcpy(newvar->n_name,nom);
-         Save_Length(nom,20);
+         newvar = (listname*) calloc(1, sizeof(listname));
+         strcpy(newvar->n_name, nom);
          newvar->suiv = NULL;
          List_Pointer_Var = newvar;
@@ -691,7 +515,6 @@
             {
                /* add the record                                              */
-              newvar = (listname *)malloc(sizeof(listname));
+              newvar = (listname*) calloc(1, sizeof(listname));
               strcpy(newvar->n_name,nom);
-              Save_Length(nom,20);
               newvar->suiv = NULL;
               parcours->suiv = newvar;
@@ -745,5 +568,5 @@
       while( parcours && out == 0 )
       {
-         if ( !strcasecmp(ident,parcours->var->v_nomvar) ) 
+         if ( !strcasecmp(ident,parcours->var->v_nomvar) )
              {
              if (!strcasecmp(parcours->var->v_typevar,"type")) out = 1;
@@ -757,45 +580,56 @@
 
 /******************************************************************************/
-/*                          VariableIsNotFunction                             */
-/******************************************************************************/
-/*                                                                            */
-/******************************************************************************/
-int VariableIsNotFunction(char *ident)
-{
-   int out;
-   listvar *newvar;
-
-   out =0;
-
-   if ( !strcasecmp(ident,"size") ||
-        !strcasecmp(ident,"if")   ||
-        !strcasecmp(ident,"max")  ||
-        !strcasecmp(ident,"min")
-      )
-   {
-      newvar = List_SubroutineDeclaration_Var;
-      while ( newvar && out == 0 )
-      {
-         if ( !strcasecmp(subroutinename, newvar->var->v_subroutinename) &&
-              !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1;
-         newvar = newvar -> suiv ;
-      }
-      if ( out == 1 ) out = 0;
-      else out = 1;
-      /* if it has not been found                                             */
-      if ( out == 1 )
-      {
-         out = 0;
-         newvar = List_Global_Var;
-         while ( newvar && out == 0 )
-         {
-            if ( !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1;
+/*                          VariableIsFunction                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int VariableIsFunction(const char *ident)
+{
+    int out;
+    listvar *newvar;
+
+    out = 0;
+
+    if ( !strcasecmp(ident,"size") ||
+         !strcasecmp(ident,"if")   ||
+         !strcasecmp(ident,"max")  ||
+         !strcasecmp(ident,"min")  )
+    {
+        newvar = List_SubroutineDeclaration_Var;
+        while ( newvar && out == 0 )
+        {
+            if ( !strcasecmp(subroutinename, newvar->var->v_subroutinename) &&
+                 !strcasecmp(ident, newvar->var->v_nomvar) )
+            {
+                out = 1;
+            }
             newvar = newvar -> suiv ;
-         }
-         if ( out == 1 ) out = 0;
-         else out = 1;
-      }
-   }
-   /*                                                                         */
-   return out;
-}
+        }
+        if ( out == 0 ) /* if it has not been found */
+        {
+            newvar = List_Global_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1;
+                newvar = newvar -> suiv ;
+            }
+        }
+    }
+    return (out == 0);
+}
+
+void dump_var(const variable* var)
+{
+    fprintf(stderr, "   var->v_nomvar : %s\n",var->v_nomvar);
+    fprintf(stderr, "   var->v_indice : %d\n",var->v_indicetabvars);
+    fprintf(stderr, "   var->v_typevar: %s\n",var->v_typevar);
+    fprintf(stderr, "   var->v_catvar : %d\n",var->v_catvar);
+    fprintf(stderr, "   var->v_modulename: %s\n",var->v_modulename);
+    fprintf(stderr, "   var->v_subroutinename: %s\n",var->v_subroutinename);
+    fprintf(stderr, "   var->v_commonname: %s\n",var->v_commonname);
+    fprintf(stderr, "   var->v_commoninfile: %s\n",var->v_commoninfile);
+    fprintf(stderr, "   var->v_nbdim: %d\n",var->v_nbdim);
+    fprintf(stderr, "   var->v_common: %d\n",var->v_common);
+    fprintf(stderr, "   var->v_module: %d\n",var->v_module);
+    fprintf(stderr, "   var->v_initialvalue: %s\n",var->v_initialvalue);
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c	(revision 6808)
@@ -41,18 +41,18 @@
 void Init_Variable(variable *var)
 {
-   strcpy(var->v_typevar            ,"");
-   strcpy(var->v_nomvar             ,"");
-   strcpy(var->v_oldname            ,"");
-   strcpy(var->v_dimchar            ,"");
-   strcpy(var->v_modulename         ,"");
-   strcpy(var->v_commonname         ,"");
-   strcpy(var->v_vallengspec        ,"");
-   strcpy(var->v_nameinttypename    ,"");
-   strcpy(var->v_commoninfile       ,"");
-   strcpy(var->v_subroutinename     ,"");
-   strcpy(var->v_precision          ,"");
-   strcpy(var->v_initialvalue       ,"");
-   strcpy(var->v_IntentSpec         ,"");
-   strcpy(var->v_readedlistdimension,"");
+   strcpy(var->v_typevar            , "");
+   strcpy(var->v_nomvar             , "");
+   strcpy(var->v_oldname            , "");
+   strcpy(var->v_dimchar            , "");
+   strcpy(var->v_modulename         , "");
+   strcpy(var->v_commonname         , "");
+   strcpy(var->v_vallengspec        , "");
+   strcpy(var->v_nameinttypename    , "");
+   strcpy(var->v_commoninfile       , "");
+   strcpy(var->v_subroutinename     , "");
+   strcpy(var->v_precision          , "");
+   strcpy(var->v_initialvalue       , "");
+   strcpy(var->v_IntentSpec         , "");
+   strcpy(var->v_readedlistdimension, "");
    var->v_nbdim               = 0 ;
    var->v_common              = 0 ;
@@ -60,4 +60,5 @@
    var->v_module              = 0 ;
    var->v_save                = 0 ;
+   var->v_catvar              = 0 ;
    var->v_VariableIsParameter = 0 ;
    var->v_PublicDeclare       = 0 ;
@@ -74,5 +75,5 @@
    var->v_target              = 0 ;
    var->v_dimsempty           = 0 ;
-   var->v_dimension = (listdim *)NULL;
+   var->v_dimension = (listdim *) NULL;
 }
 /******************************************************************************/
@@ -89,18 +90,19 @@
 /*                                                                            */
 /******************************************************************************/
-listvar * AddListvarToListvar(listvar *l,listvar *glob,int ValueFirstpass)
-{
-   listvar *newvar;
-   if ( firstpass == ValueFirstpass )
-   {
-      if ( !glob) glob = l ;
-      else
-      {
-         newvar=glob;
-         while (newvar->suiv) newvar = newvar->suiv;
-         newvar->suiv = l;
-      }
-   }
-   return glob;
+listvar * AddListvarToListvar ( listvar *l, listvar *glob, int ValueFirstpass )
+{
+    listvar *newvar;
+    if ( firstpass == ValueFirstpass )
+    {
+        if ( !glob ) glob = l;
+        else
+        {
+            newvar = glob;
+            while (newvar->suiv)
+                newvar = newvar->suiv;
+            newvar->suiv = l;
+        }
+    }
+    return glob;
 }
 
@@ -113,65 +115,81 @@
 /*                                                                            */
 /******************************************************************************/
-void CreateAndFillin_Curvar(char *type,variable *curvar)
-{
-   if (!strcasecmp(type,"character") && strcasecmp(CharacterSize,"") )
-   {
-      strcpy(curvar->v_dimchar,CharacterSize);
-      Save_Length(CharacterSize,5);
-   }
-
-  /* On donne la precision de la variable si elle a ete donnee                */
-  curvar->v_c_star = 0;
-  if ( c_star == 1 ) curvar->v_c_star = 1;
-  /*                                                                          */
-  strcpy(curvar->v_vallengspec,"");
-  if ( strcasecmp(vallengspec,"") )
-  {
-     strcpy(curvar->v_vallengspec,vallengspec);
-     Save_Length(vallengspec,8);
-  }
-
-  strcpy(curvar->v_precision,"");
-  if ( strcasecmp(NamePrecision,"") )
-  {
-     strcpy(curvar->v_precision,NamePrecision);
-     Save_Length(NamePrecision,12);
-  }
-  /* Si cette variable a ete declaree dans un module on met curvar->module=1  */
-  if ( inmoduledeclare == 1 || SaveDeclare == 1)
-  {
-      curvar->v_module = 1;
-   }
-   /* Puis on donne le nom du module dans curvar->v_modulename                */
-   strcpy(curvar->v_modulename,curmodulename);
-   Save_Length(curmodulename,6);
-   /* Si cette variable a ete initialisee                                     */
-/*RB*/
-   if ( ! strcmp(InitialValueGiven,"=")  ) 
-/*RBend*/
-   {
-      strcpy(curvar->v_initialvalue,InitValue);
-      Save_Length(InitValue,14);
-   }
-   /* Si cette variable est declaree en save                                  */
-/*RB*/
-   if (SaveDeclare == 1 &&  !strcasecmp(curvar->v_typevar,"type")) {
-/*RBend*/
-   curvar->v_save = 1;
-   }
-
-   /* Si cette variable est v_allocatable                                     */
-   if (Allocatabledeclare == 1 ) curvar->v_allocatable=1;
-   
-   /* Si cette variable est v_targer                                     */
-   if (Targetdeclare == 1 ) curvar->v_target=1;
-   /* if INTENT spec has been given                                           */
-   if ( strcasecmp(IntentSpec,"") )
-   {
-      strcpy(curvar->v_IntentSpec,IntentSpec);
-      Save_Length(IntentSpec,13);
-   }
-}
-
+void CreateAndFillin_Curvar(const char *type, variable *curvar)
+{
+    if ( !strcasecmp(type, "character") && strcasecmp(CharacterSize, "") )
+    {
+        strcpy(curvar->v_dimchar, CharacterSize);
+    }
+
+    /* On donne la precision de la variable si elle a ete donnee                */
+    curvar->v_c_star = 0;
+    if ( c_star == 1 )  curvar->v_c_star = 1;
+
+    strcpy(curvar->v_vallengspec,"");
+    if ( strcasecmp(vallengspec,"") )
+    {
+        strcpy(curvar->v_vallengspec,vallengspec);
+        Save_Length(vallengspec,8);
+    }
+
+    strcpy(curvar->v_precision,"");
+    if ( strcasecmp(NamePrecision,"") )
+    {
+        strcpy(curvar->v_precision,NamePrecision);
+        addprecision_derivedfromkind(curvar);
+        Save_Length(NamePrecision,12);
+    }
+    /* Si cette variable a ete declaree dans un module on met curvar->module=1  */
+    if ( inmoduledeclare == 1 || SaveDeclare == 1 )
+    {
+        curvar->v_module = 1;
+    }
+    /* Puis on donne le nom du module dans curvar->v_modulename                */
+    strcpy(curvar->v_modulename,curmodulename);
+    /* Si cette variable a ete initialisee                                     */
+    if (InitialValueGiven == 1 )
+    {
+        strcpy(curvar->v_initialvalue,InitValue);
+        Save_Length(InitValue,14);
+    }
+    /* Si cette variable est declaree en save                                  */
+    if (SaveDeclare == 1 && !strcasecmp(curvar->v_typevar,"type")) curvar->v_save = 1;
+
+    /* Si cette variable est v_allocatable                                     */
+    if (Allocatabledeclare == 1 ) curvar->v_allocatable=1;
+
+    /* Si cette variable est v_target                                     */
+    if (Targetdeclare == 1 ) curvar->v_target=1;
+
+    /* if INTENT spec has been given                                           */
+    if ( strcasecmp(IntentSpec,"") )
+    {
+        strcpy(curvar->v_IntentSpec,IntentSpec);
+        Save_Length(IntentSpec,13);
+    }
+}
+
+
+void addprecision_derivedfromkind(variable *curvar)
+{
+    listnom *parcours;
+    char kind[LONG_VNAME];
+    char kind_val[LONG_C];
+
+    sscanf(curvar->v_precision, "%100s =", kind_val);
+
+    if ( !strcasecmp(kind_val, "kind") )
+        sscanf(curvar->v_precision, "%50s = %50s", kind, kind_val);
+
+    parcours = listofkind;
+    while (parcours)
+    {
+        if ( !strcasecmp(parcours->o_nom, kind_val) )
+        {
+            sprintf(curvar->v_nameinttypename, "%d", parcours->o_val);
+        }
+        parcours=parcours->suiv;
+    }
+}
 
 /******************************************************************************/
@@ -180,79 +198,74 @@
 /*                                                                            */
 /******************************************************************************/
-void duplicatelistvar(listvar *orig)
-{
-   listvar *parcours;
-   listvar *tmplistvar;
-   listvar *tmplistvarprec;
-   listdim *tmplistdim;
-   variable *tmpvar;
-
-   tmplistvarprec = (listvar *)NULL;
-   parcours = orig;
-   while ( parcours )
-   {
-      tmplistvar = (listvar *)malloc(sizeof(listvar));
-      tmpvar = (variable *)malloc(sizeof(variable));
-      /*                                                                      */
-      Init_Variable(tmpvar);
-      /*                                                                      */
-      strcpy(tmpvar->v_typevar,parcours->var->v_typevar);
-      strcpy(tmpvar->v_nomvar,parcours->var->v_nomvar);
-      strcpy(tmpvar->v_oldname,parcours->var->v_oldname);
-      strcpy(tmpvar->v_dimchar,parcours->var->v_dimchar);
-      if ( parcours->var->v_dimension )
-      {
-         tmplistdim = (listdim *)malloc(sizeof(listdim));
-         tmplistdim = parcours->var->v_dimension;
-         tmpvar->v_dimension = tmplistdim;
-      }
-      tmpvar->v_nbdim=parcours->var->v_nbdim;
-      tmpvar->v_common=parcours->var->v_common;
-      tmpvar->v_positioninblock=parcours->var->v_positioninblock;
-      tmpvar->v_module=parcours->var->v_module;
-      tmpvar->v_save=parcours->var->v_save;
-      tmpvar->v_VariableIsParameter=parcours->var->v_VariableIsParameter;
-      printf("QLKDF\n");
-      tmpvar->v_indicetabvars=parcours->var->v_indicetabvars;
-      strcpy(tmpvar->v_modulename,parcours->var->v_modulename);
-      strcpy(tmpvar->v_commonname,parcours->var->v_commonname);
-      strcpy(tmpvar->v_vallengspec,parcours->var->v_vallengspec);
-
-      strcpy(tmpvar->v_nameinttypename,parcours->var->v_nameinttypename);
-            
-      tmpvar->v_pointedvar=parcours->var->v_pointedvar;
-      strcpy(tmpvar->v_commoninfile,mainfile);
-      Save_Length(mainfile,10);
-      strcpy(tmpvar->v_subroutinename,parcours->var->v_subroutinename);
-      tmpvar->v_dimensiongiven=parcours->var->v_dimensiongiven;
-      tmpvar->v_c_star=parcours->var->v_c_star;
-      strcpy(tmpvar->v_precision,parcours->var->v_precision);
-      strcpy(tmpvar->v_initialvalue,parcours->var->v_initialvalue);
-      tmpvar->v_pointerdeclare=parcours->var->v_pointerdeclare;
-      tmpvar->v_optionaldeclare=parcours->var->v_optionaldeclare;
-      tmpvar->v_allocatable=parcours->var->v_allocatable;
-      tmpvar->v_target=parcours->var->v_target;
-      strcpy(tmpvar->v_IntentSpec,parcours->var->v_IntentSpec);
-      tmpvar->v_dimsempty=parcours->var->v_dimsempty;
-      strcpy(tmpvar->v_readedlistdimension,
-                                          parcours->var->v_readedlistdimension);
-      /*                                                                      */
-      tmplistvar->var = tmpvar;
-      tmplistvar->suiv = NULL;
-      /*                                                                      */
-      if ( !listduplicated )
-      {
-         listduplicated = tmplistvar;
-         tmplistvarprec = listduplicated;
-      }
-      else
-      {
-         tmplistvarprec->suiv = tmplistvar;
-         tmplistvarprec = tmplistvar;
-      }
-      /*                                                                      */
-      parcours = parcours->suiv;
-   }
-}
+// void duplicatelistvar(listvar *orig)
+// {
+//    listvar *parcours;
+//    listvar *tmplistvar;
+//    listvar *tmplistvarprec;
+//    listdim *tmplistdim;
+//    variable *tmpvar;
+//
+//    tmplistvarprec = (listvar *)NULL;
+//    parcours = orig;
+//    while ( parcours )
+//    {
+//       tmplistvar = (listvar *)calloc(1,sizeof(listvar));
+//       tmpvar = (variable *)calloc(1,sizeof(variable));
+//       /*                                                                      */
+//       Init_Variable(tmpvar);
+//       /*                                                                      */
+//       strcpy(tmpvar->v_typevar, parcours->var->v_typevar);
+//       strcpy(tmpvar->v_nomvar,  parcours->var->v_nomvar);
+//       strcpy(tmpvar->v_oldname, parcours->var->v_oldname);
+//       strcpy(tmpvar->v_dimchar, parcours->var->v_dimchar);
+//       if ( parcours->var->v_dimension )
+//       {
+//          tmplistdim = (listdim*) calloc(1,sizeof(listdim));
+//          tmplistdim = parcours->var->v_dimension;
+//          tmpvar->v_dimension = tmplistdim;
+//       }
+//       tmpvar->v_nbdim  = parcours->var->v_nbdim;
+//       tmpvar->v_common = parcours->var->v_common;
+//       tmpvar->v_module = parcours->var->v_module;
+//       tmpvar->v_save   = parcours->var->v_save;
+//       tmpvar->v_positioninblock = parcours->var->v_positioninblock;
+//       tmpvar->v_VariableIsParameter = parcours->var->v_VariableIsParameter;
+//       tmpvar->v_indicetabvars = parcours->var->v_indicetabvars;
+//       tmpvar->v_pointedvar    = parcours->var->v_pointedvar;
+//       tmpvar->v_dimensiongiven = parcours->var->v_dimensiongiven;
+//       tmpvar->v_c_star = parcours->var->v_c_star;
+//       tmpvar->v_catvar = parcours->var->v_catvar;
+//       tmpvar->v_pointerdeclare = parcours->var->v_pointerdeclare;
+//       tmpvar->v_optionaldeclare = parcours->var->v_optionaldeclare;
+//       tmpvar->v_allocatable = parcours->var->v_allocatable;
+//       tmpvar->v_target      = parcours->var->v_target;
+//       tmpvar->v_dimsempty   = parcours->var->v_dimsempty;
+//       strcpy(tmpvar->v_modulename,  parcours->var->v_modulename);
+//       strcpy(tmpvar->v_commonname,  parcours->var->v_commonname);
+//       strcpy(tmpvar->v_vallengspec, parcours->var->v_vallengspec);
+//       strcpy(tmpvar->v_nameinttypename, parcours->var->v_nameinttypename);
+//       strcpy(tmpvar->v_commoninfile, cur_filename);
+//       strcpy(tmpvar->v_subroutinename, parcours->var->v_subroutinename);
+//       strcpy(tmpvar->v_precision, parcours->var->v_precision);
+//       strcpy(tmpvar->v_initialvalue, parcours->var->v_initialvalue);
+//       strcpy(tmpvar->v_IntentSpec, parcours->var->v_IntentSpec);
+//       strcpy(tmpvar->v_readedlistdimension, parcours->var->v_readedlistdimension);
+//
+//       tmplistvar->var = tmpvar;
+//       tmplistvar->suiv = NULL;
+//
+//       if ( !listduplicated )
+//       {
+//          listduplicated = tmplistvar;
+//          tmplistvarprec = listduplicated;
+//       }
+//       else
+//       {
+//          tmplistvarprec->suiv = tmplistvar;
+//          tmplistvarprec = tmplistvar;
+//       }
+//       parcours = parcours->suiv;
+//    }
+// }
 
 /******************************************************************************/
@@ -273,5 +286,5 @@
    listdim *parcours ;
 
-   newdim=(listdim *) malloc (sizeof (listdim));
+   newdim=(listdim *) calloc(1,sizeof(listdim));
    newdim->dim=nom;
    newdim->suiv=NULL;
@@ -310,7 +323,6 @@
    while(parcours_var)
    {
-      v=parcours_var->var;
+      v = parcours_var->var;
       strcpy(v->v_dimchar,(lin->dim).last);
-      Save_Length((lin->dim).last,5);
       parcours_var=parcours_var->suiv;
    }
@@ -319,24 +331,24 @@
 
 /******************************************************************************/
-/*                                num_dims                                    */
+/*                              get_num_dims                                  */
 /******************************************************************************/
 /* This subroutine is used to know the dimension of a table                   */
 /******************************************************************************/
 /*                                                                            */
-/*             Dimension(jpi,jpj,jpk) ----------> num_dims = 3                */
-/*                                                                            */
-/******************************************************************************/
-int num_dims(listdim *d)
-{
-   listdim *parcours;
-   int compteur = 0;
-
-   parcours = d;
-   while(parcours)
-   {
-     compteur++;
-     parcours=parcours->suiv;
-   }
-   return compteur;
+/*             Dimension(jpi,jpj,jpk) ----------> get_num_dims = 3            */
+/*                                                                            */
+/******************************************************************************/
+int get_num_dims ( const listdim *d )
+{
+    listdim *parcours;
+    int compteur = 0;
+
+    parcours = (listdim *) d;
+    while(parcours)
+    {
+        compteur++;
+        parcours = parcours->suiv;
+    }
+    return compteur;
 }
 
@@ -348,69 +360,62 @@
 /*      struct : variable                                                     */
 /******************************************************************************/
-variable * createvar(char *nom,listdim *d)
-{
-  variable *var;
-  listdim *dims;
-  char ligne[LONG_C];
-  char listdimension[LONG_C];
-
-   var=(variable *) malloc(sizeof(variable));
-   /*                                                                         */
-   Init_Variable(var);
-   /*                                                                         */
-   strcpy(var->v_nomvar,nom);
-   Save_Length(nom,4);
-   /*                                                                         */
-   strcpy(listdimension,"");
-   strcpy(var->v_modulename,curmodulename);
-   Save_Length(curmodulename,6);
-   strcpy(var->v_commoninfile,mainfile);
-   Save_Length(mainfile,10);
-   strcpy(var->v_subroutinename,subroutinename);
-   Save_Length(subroutinename,11);
-   /*                                                                         */
-   if ( strcasecmp(nameinttypename,"") )
-   {
-      strcpy(var->v_nameinttypename,nameinttypename);
-      Save_Length(nameinttypename,9);
-   }
-         
-   if ( optionaldeclare     == 1 ) var->v_optionaldeclare = 1;
-   if ( pointerdeclare      == 1 ) var->v_pointerdeclare = 1;
-   if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ;
-   if ( PublicDeclare       == 1 ) var->v_PublicDeclare = 1 ;
-   if ( PrivateDeclare      == 1 ) var->v_PrivateDeclare = 1;
-   if ( ExternalDeclare     == 1 ) var->v_ExternalDeclare = 1;
-   /*                                                                         */
-   var->v_dimension=d;
+variable * createvar(const char *nom, listdim *d)
+{
+    variable *var;
+    listdim *dims;
+    char ligne[LONG_M];
+    char listdimension[LONG_M];
+
+    var = (variable *) calloc(1,sizeof(variable));
+
+    Init_Variable(var);
+
+    strcpy(listdimension,"");
+    strcpy(var->v_nomvar,nom);
+    strcpy(var->v_modulename,curmodulename);
+    strcpy(var->v_commoninfile,cur_filename);
+    strcpy(var->v_subroutinename,subroutinename);
+
+    if ( strcasecmp(nameinttypename,"") )
+    {
+        strcpy(var->v_nameinttypename,nameinttypename);
+    }
+
+    if ( optionaldeclare     == 1 ) var->v_optionaldeclare = 1;
+    if ( pointerdeclare      == 1 ) var->v_pointerdeclare = 1;
+    if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ;
+    if ( PublicDeclare       == 1 ) var->v_PublicDeclare = 1 ;
+    if ( PrivateDeclare      == 1 ) var->v_PrivateDeclare = 1;
+    if ( ExternalDeclare     == 1 ) var->v_ExternalDeclare = 1;
+
+   var->v_dimension = d;
 
    /* Creation of the string for the dimension of this variable               */
-   dimsempty = 1;
-   if ( d )
-   {
-      var->v_dimensiongiven=1;
-      dims = d;
-      while (dims)
-      {
-         if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
-                                                                  dimsempty = 0;
-         sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
-         strcat(listdimension,ligne);
-         if ( dims->suiv )
-         {
-            strcat(listdimension,",");
-         }
-         dims = dims->suiv;
-      }
-/*RB*/
-      if ( dimsempty == 1 || GlobalDeclarationType == 1 ) var->v_dimsempty=1;
-/*RBend*/
-   }
-   strcpy(var->v_readedlistdimension,listdimension);
-   Save_Length(listdimension,15);
-   /*                                                                         */
-   var->v_nbdim=num_dims(d);
-   /*                                                                         */
-   return var;
+    dimsempty = 1;
+    if ( d )
+    {
+        var->v_dimensiongiven = 1;
+        dims = d;
+        while (dims)
+        {
+            if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
+            {
+                dimsempty = 0;
+            }
+            sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+            strcat(listdimension,ligne);
+            if ( dims->suiv )
+            {
+                strcat(listdimension,",");
+            }
+            dims = dims->suiv;
+        }
+        if ( dimsempty == 1 || GlobalDeclarationType == 1 ) var->v_dimsempty = 1;
+    }
+    strcpy(var->v_readedlistdimension,listdimension);
+    Save_Length(listdimension,15);
+    var->v_nbdim = get_num_dims(d);
+
+    return var;
 }
 
@@ -433,5 +438,5 @@
    listvar *tmpvar ;
 
-   newvar=(listvar *) malloc (sizeof (listvar));
+   newvar=(listvar *) calloc(1,sizeof(listvar));
    newvar->var=v;
    newvar->suiv = NULL;
@@ -466,18 +471,18 @@
 /*                                                                            */
 /******************************************************************************/
-listvar *settype(char *nom,listvar *lin)
+listvar *settype(const char *nom, listvar *lin)
 {
    listvar *newvar;
    variable *v;
 
-   newvar=lin;
+   newvar = lin;
    while (newvar)
    {
-      v=newvar->var;
+      v = newvar->var;
       strcpy(v->v_typevar,nom);
-      Save_Length(nom,3);
-      newvar=newvar->suiv;
-   }
-   newvar=lin;
+      v->v_catvar = get_cat_var(v);
+      newvar = newvar->suiv;
+   }
+   newvar = lin;
    return newvar ;
 }
@@ -511,5 +516,5 @@
    variable *v;
    int out ;
-   
+
    newvar=lin;
    out = 0;
@@ -531,5 +536,5 @@
    listname *tmpvar;
 
-   newvar=(listname *) malloc (sizeof (listname));
+   newvar=(listname *) calloc(1,sizeof(listname));
    strcpy(newvar->n_name,nom);
    newvar->suiv = NULL;
@@ -549,5 +554,5 @@
       }
       tmpvar -> suiv = newvar;
-   }
+      }
       else
       {
@@ -568,22 +573,23 @@
     tmpvar = tmpvar->suiv;
    }
-   
+
    tmpvar->suiv = l2;
-   
+
    return l1;
 }
 
-void *createstringfromlistname(char *ligne, listname *lin)
-{
-listname *tmpvar;
-
-strcpy(ligne,"");
-tmpvar = lin;
-while(tmpvar)
-{
-  strcat(ligne,tmpvar->n_name);
-  if (tmpvar->suiv) strcat(ligne,",");
-  tmpvar=tmpvar->suiv;
-}
+void createstringfromlistname(char *ligne, listname *lin)
+{
+    listname *tmpvar;
+
+    strcpy(ligne,"");
+    tmpvar = lin;
+
+    while(tmpvar)
+    {
+        strcat(ligne,tmpvar->n_name);
+        if (tmpvar->suiv) strcat(ligne,",");
+        tmpvar=tmpvar->suiv;
+    }
 }
 
@@ -607,13 +613,12 @@
 void removeglobfromlist(listname **lin)
 {
-  listname *listemp;
   listname *parcours1;
   listvar *parcours2;
   listname * parcourspres;
   int out;
-  
+
   parcours1 = *lin;
   parcourspres = (listname *)NULL;
-  
+
   while (parcours1)
   {
@@ -644,5 +649,5 @@
    {
    parcourspres = parcours1;
-    parcours1 = parcours1->suiv;  
+    parcours1 = parcours1->suiv;
     }
   }
@@ -651,41 +656,51 @@
 void writelistpublic(listname *lin)
 {
-  listname *parcours1;
-  char ligne[LONG_40M];
-  char tempname[LONG_4M];
-  
-  if (lin)
-  {
-  sprintf(ligne,"public :: ");
-  parcours1 = lin;
-  
-  while (parcours1)
-  {
-    strcat(ligne,parcours1->n_name);
-    if (parcours1->suiv) strcat(ligne,", ");
-    parcours1 = parcours1->suiv;  
-  }
-  tofich(fortranout,ligne,1);
-  }
-
+    listname *parcours1;
+    char ligne[LONG_M];
+
+    if (lin)
+    {
+        sprintf(ligne,"public :: ");
+        parcours1 = lin;
+
+        while ( parcours1 )
+        {
+            strcat(ligne, parcours1->n_name);
+            if ( parcours1->suiv ) strcat(ligne,", ");
+            parcours1 = parcours1->suiv;
+        }
+        tofich(fortran_out,ligne,1);
+    }
 }
 
 void Init_List_Data_Var()
 {
-listvar *parcours;
-
-parcours = List_Data_Var_Cur;
-
-if (List_Data_Var_Cur)
-{
-while (parcours)
-{
- List_Data_Var_Cur = List_Data_Var_Cur->suiv;
- free(parcours);
- parcours = List_Data_Var_Cur;
-}
-}
-
-List_Data_Var_Cur = NULL;
-
-}
+    listvar *parcours;
+
+    parcours = List_Data_Var_Cur;
+
+    if (List_Data_Var_Cur)
+    {
+        while (parcours)
+        {
+            List_Data_Var_Cur = List_Data_Var_Cur->suiv;
+            free(parcours);
+            parcours = List_Data_Var_Cur;
+        }
+    }
+    List_Data_Var_Cur = NULL;
+}
+
+int get_cat_var(variable *var)
+{
+    if (!strcasecmp(var->v_typevar, "CHARACTER"))
+        return 1;
+    else if ((var->v_nbdim == 0 ) && (!strcasecmp(var->v_typevar, "REAL")))
+        return 2;
+    else if (!strcasecmp(var->v_typevar, "LOGICAL"))
+        return 3;
+    else if (!strcasecmp(var->v_typevar, "INTEGER"))
+        return 4;
+    else
+        return 0;
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c	(revision 6808)
@@ -71,12 +71,9 @@
    }
    /* if variable does not exist, we add it                                   */
-   newvar=(listvar *)malloc(sizeof(listvar));
-   newvar->var=(variable *)malloc(sizeof(variable));
+   newvar=(listvar *)calloc(1,sizeof(listvar));
+   newvar->var=(variable *)calloc(1,sizeof(variable));
    strcpy(newvar->var->v_nomvar,name);
-   Save_Length(name,4);
-   strcpy(newvar->var->v_commoninfile,mainfile);
-   Save_Length(mainfile,10);
+   strcpy(newvar->var->v_commoninfile,cur_filename);
    strcpy(newvar->var->v_subroutinename,subroutinename);
-   Save_Length(subroutinename,11);
    newvar->var->v_notgrid = 1 ;
    newvar->suiv = List_NotGridDepend_Var;
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c	(revision 6808)
@@ -45,5 +45,5 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_Allocate_Var_1(char *nom,char *nommodule)
+void Add_Allocate_Var_1(const char *nom, const char *nommodule)
 {
    listallocate *newvar;
@@ -55,11 +55,9 @@
       if ( !List_Allocate_Var )
       {
-         newvar = (listallocate *)malloc(sizeof(listallocate));
+         newvar = (listallocate *)calloc(1,sizeof(listallocate));
          strcpy(newvar->a_nomvar,nom);
+         strcpy(newvar->a_subroutine,subroutinename);
+         strcpy(newvar->a_module,nommodule);
          Save_Length(nom,25);
-         strcpy(newvar->a_subroutine,subroutinename);
-         Save_Length(subroutinename,26);
-         strcpy(newvar->a_module,nommodule);
-         Save_Length(nommodule,27);
          newvar->suiv = NULL;
          List_Allocate_Var = newvar;
@@ -71,7 +69,7 @@
          while ( parcours->suiv && out == 0 )
          {
-            if (  !strcasecmp(parcours->a_nomvar,nom) &&
-                  !strcasecmp(parcours->a_subroutine,subroutinename) &&
-                  !strcasecmp(parcours->a_module,nommodule) ) out = 1;
+            if (  !strcasecmp(parcours->a_nomvar, nom) &&
+                  !strcasecmp(parcours->a_subroutine, subroutinename) &&
+                  !strcasecmp(parcours->a_module, nommodule) ) out = 1;
             else
                parcours=parcours->suiv;
@@ -85,11 +83,9 @@
             {
                /* add the record                                              */
-              newvar = (listallocate *)malloc(sizeof(listallocate));
-              strcpy(newvar->a_nomvar,nom);
+              newvar = (listallocate *)calloc(1,sizeof(listallocate));
+              strcpy(newvar->a_nomvar, nom);
+              strcpy(newvar->a_subroutine, subroutinename);
+              strcpy(newvar->a_module, nommodule);
               Save_Length(nom,25);
-              strcpy(newvar->a_subroutine,subroutinename);
-              Save_Length(subroutinename,26);
-              strcpy(newvar->a_module,nommodule);
-              Save_Length(nommodule,27);
               newvar->suiv = NULL;
               parcours->suiv = newvar;
@@ -108,45 +104,19 @@
 /*                                                                            */
 /******************************************************************************/
-int IsVarAllocatable_0(char *ident)
-{
-   listallocate *parcours;
-   int out;
-
-   out = 0 ;
-   if ( firstpass == 0 )
-   {
-      parcours = List_Allocate_Var;
-      while ( parcours && out == 0 )
-      {
-         if ( !strcasecmp(parcours->a_nomvar,ident)  ) out = 1 ;
-         else parcours=parcours->suiv;
-      }
-   }
-   return out;
-}
-
-
-/******************************************************************************/
-/*                          varisallocatable_0                                */
-/******************************************************************************/
-/* Firstpass 0                                                                */
-/******************************************************************************/
-/*                                                                            */
-/******************************************************************************/
-int varisallocatable_0(char *ident)
-{
-   listallocate *newvaralloc;
-   int out;
-
-   out =0;
-   if (firstpass == 0 )
-   {
-         newvaralloc = List_Allocate_Var;
-         while ( newvaralloc && out == 0 )
-         {
-            if ( !strcasecmp(ident,newvaralloc->a_nomvar) )  out = 1;
-            else newvaralloc = newvaralloc->suiv;
-         }
-   }
-   return out;
-}
+// int IsVarAllocatable_0(const char *ident)
+// {
+//    listallocate *parcours;
+//    int out;
+// 
+//    out = 0 ;
+//    if ( firstpass == 0 )
+//    {
+//       parcours = List_Allocate_Var;
+//       while ( parcours && out == 0 )
+//       {
+//          if ( !strcasecmp(parcours->a_nomvar,ident)  ) out = 1 ;
+//          else parcours=parcours->suiv;
+//       }
+//    }
+//    return out;
+// }
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c	(revision 6808)
@@ -47,10 +47,6 @@
 void Add_GlobalParameter_Var_1(listvar *listin)
 {
-   if ( firstpass == 1 )
-   {
-      if ( VariableIsParameter == 1 ) {
-      List_GlobalParameter_Var =  AddListvarToListvar(listin,List_GlobalParameter_Var,1);
-   }
-   }
+    if ( VariableIsParameter )
+        List_GlobalParameter_Var =  AddListvarToListvar(listin, List_GlobalParameter_Var, 1);
 }
 
@@ -64,19 +60,19 @@
 void Add_Parameter_Var_1(listvar *listin)
 {
-   listvar *parcours;
+    listvar *parcours;
 
-   if ( firstpass == 1 && VariableIsParameter == 1 )
-   {
-      if ( !List_Parameter_Var )
-      {
-         List_Parameter_Var = listin;
-      }
-      else
-      {
-         parcours = List_Parameter_Var;
-         while (parcours->suiv) parcours=parcours->suiv;
-         parcours->suiv = listin;
-      }
-   }
+    if ( !VariableIsParameter )    return;
+
+    if ( List_Parameter_Var == NULL )
+    {
+        List_Parameter_Var = listin;
+    }
+    else
+    {
+        parcours = List_Parameter_Var;
+        while ( parcours->suiv )
+            parcours = parcours->suiv;
+        parcours->suiv = listin;
+    }
 }
 
@@ -92,16 +88,14 @@
    listvar *parcours;
 
-   if ( firstpass == 1 )
-   {
-      if ( !List_Dimension_Var )
-      {
-         List_Dimension_Var = listin;
-      }
-      else
-      {
-         parcours = List_Dimension_Var;
-         while (parcours->suiv) parcours=parcours->suiv;
-         parcours->suiv = listin;
-      }
-   }
+    if ( List_Dimension_Var == NULL )
+    {
+        List_Dimension_Var = listin;
+    }
+    else
+    {
+        parcours = List_Dimension_Var;
+        while (parcours->suiv)
+            parcours = parcours->suiv;
+        parcours->suiv = listin;
+    }
 }
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c	(revision 6808)
@@ -46,12 +46,8 @@
 void Add_Globliste_1(listvar *listtoadd)
 {
-   if ( firstpass == 1 )
-   {
-      if ( aftercontainsdeclare == 0 &&
-           VariableIsParameter  == 0 )
-      {
-         List_Global_Var = AddListvarToListvar(listtoadd,List_Global_Var,1);
-      }
-   }
+    if ( aftercontainsdeclare == 0 && VariableIsParameter == 0 )
+    {
+        List_Global_Var = AddListvarToListvar(listtoadd, List_Global_Var, 1);
+    }
 }
 
@@ -100,5 +96,5 @@
    {
     strcpy(oldvar->v_dimension->dim.last,newvar->v_dimension->dim.last);
-    strcpy(oldvar->v_dimension->dim.first,newvar->v_dimension->dim.first);    
+    strcpy(oldvar->v_dimension->dim.first,newvar->v_dimension->dim.first);
    }
    out = 1;
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c	(revision 6808)
@@ -51,10 +51,10 @@
 {
   listvar *newvar;
-  char ligne[LONG_C];
+  char ligne[LONG_M];
 
 //  if ( firstpass == 1 )
 //  {
-     newvar=(listvar *)malloc(sizeof(listvar));
-     newvar->var=(variable *)malloc(sizeof(variable));
+     newvar=(listvar *)calloc(1,sizeof(listvar));
+     newvar->var=(variable *)calloc(1,sizeof(variable));
      /*                                                                       */
      Init_Variable(newvar->var);
@@ -62,17 +62,11 @@
      if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
      strcpy(newvar->var->v_nomvar,name);
-     Save_Length(name,4);
      strcpy(newvar->var->v_subroutinename,subroutinename);
-     Save_Length(subroutinename,11);
      strcpy(newvar->var->v_modulename,curmodulename);
-     Save_Length(curmodulename,6);
-     strcpy(newvar->var->v_commoninfile,mainfile);
-     Save_Length(mainfile,10);
+     strcpy(newvar->var->v_commoninfile,cur_filename);
      if (strchr(values,',') && strncasecmp(values,"'",1))
-            {
-            sprintf(ligne,"(/%s/)",values);
-            }
+        sprintf(ligne,"(/%s/)",values);
      else
-       strcpy(ligne,values);
+        strcpy(ligne,values);
        
      strcpy(newvar->var->v_initialvalue,ligne);
@@ -93,51 +87,59 @@
 void Add_Data_Var_Names_01 (listvar **curlist,listname *l1,listname *l2)
 {
-  listvar *newvar;
-  listvar *tmpvar;
-  listname *tmpvar1;
-  listname *tmpvar2;  
-  char ligne[LONG_C];
+    listvar *newvar;
+    listvar *tmpvar;
+    listname *tmpvar1;
+    listname *tmpvar2;  
+    variable *found_var = NULL;
+    
+    tmpvar1 = l1;
+    tmpvar2 = l2;
   
-  tmpvar1 = l1;
-  tmpvar2 = l2;
-  
-  while (tmpvar1)
-     {
-     newvar=(listvar *)malloc(sizeof(listvar));
-     newvar->var=(variable *)malloc(sizeof(variable));
-     /*                                                                       */
-     Init_Variable(newvar->var);
-     /*                                                                       */
-     if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
-     strcpy(newvar->var->v_nomvar,tmpvar1->n_name);
-     Save_Length(tmpvar1->n_name,4);
-     strcpy(newvar->var->v_subroutinename,subroutinename);
-     Save_Length(subroutinename,11);
-     strcpy(newvar->var->v_modulename,curmodulename);
-     Save_Length(curmodulename,6);
-     strcpy(newvar->var->v_commoninfile,mainfile);
-     Save_Length(mainfile,10);
-       
-     strcpy(newvar->var->v_initialvalue,tmpvar2->n_name);
-     Save_Length(tmpvar2->n_name,14);
-     newvar->suiv = NULL;
+    while (tmpvar1)
+    {
+        newvar = (listvar *) calloc(1,sizeof(listvar));
+        newvar->var = (variable *) calloc(1,sizeof(variable));
+
+        Init_Variable(newvar->var);
+
+        if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
      
-     if ( ! (*curlist) )
-     {
-        *curlist  = newvar ;
-     }
-     else
-     {
-        tmpvar = *curlist;
-        while (tmpvar->suiv)
-          tmpvar=tmpvar->suiv;
-        tmpvar->suiv = newvar;
-     }
+        found_var = get_variable_in_list_from_name(List_Common_Var, tmpvar1->n_name);
+        if ( ! found_var )  found_var = get_variable_in_list_from_name(List_Global_Var,tmpvar1->n_name);
+        if ( ! found_var )  found_var = get_variable_in_list_from_name(List_SubroutineDeclaration_Var,tmpvar1->n_name);
+        
+        if ( found_var && found_var->v_nbdim > 0 )
+        {
+            printf("##############################################################################################################\n");
+            printf("## CONV Error : arrays in data_stmt_object lists not yet supported. Please complain to the proper authorities.\n");
+            printf("##   variable name : %s (in %s:%s:%s)\n", found_var->v_nomvar, found_var->v_modulename,
+                                                              found_var->v_subroutinename, found_var->v_commonname);
+            exit(1);
+        }
+        
+        strcpy(newvar->var->v_nomvar,tmpvar1->n_name);
+        strcpy(newvar->var->v_subroutinename,subroutinename);
+        strcpy(newvar->var->v_modulename,curmodulename);
+        strcpy(newvar->var->v_commoninfile,cur_filename);
+        strcpy(newvar->var->v_initialvalue,tmpvar2->n_name);
+
+        Save_Length(tmpvar2->n_name,14);
+
+        newvar->suiv = NULL;
      
-  tmpvar1 = tmpvar1->suiv;
-  tmpvar2 = tmpvar2->suiv;  
-  }
-  return;
-
-
+        if ( *curlist != NULL )
+        {
+            tmpvar = *curlist;
+            while (tmpvar->suiv)
+                tmpvar = tmpvar->suiv;
+            tmpvar->suiv = newvar;
+        }
+        else
+        {
+            *curlist  = newvar ;
+        }
+     
+        tmpvar1 = tmpvar1->suiv;
+        tmpvar2 = tmpvar2->suiv;  
+    }
 }
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c	(revision 6808)
@@ -38,481 +38,115 @@
 #include "decl.h"
 
-void Save_Length(char *nom, int whichone)
+void Save_Length(const char *nom, int whichone)
 {
-   if ( whichone == 1  && strlen(nom) > length_last )
+    size_t len_nom = strlen(nom);
+    
+   if ( whichone == 1  && len_nom > length_last )
    {
-      length_last               = strlen(nom);
-      if ( length_last > LONG_C )
-      {
-         printf("WARNING 1 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_last+100);
-      }
+      length_last = len_nom;
+      if ( length_last > LONG_M )
+            printf("WARNING 1 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_last+100);
    }
-   if ( whichone == 2  && strlen(nom) > length_first )
+   if ( whichone == 2  && len_nom > length_first )
    {
-      length_first              = strlen(nom);
-      if ( length_first > LONG_C )
-      {
-         printf("WARNING 2 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_first+100);
-      }
+      length_first = len_nom;
+      if ( length_first > LONG_M )
+           printf("WARNING 2 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_first+100);
    }
-   if ( whichone == 3  && strlen(nom) > length_v_typevar )
+   if ( whichone == 8  && len_nom > length_v_vallengspec )
    {
-      length_v_typevar          = strlen(nom);
-      if ( length_v_typevar > LONG_C )
-      {
-         printf("WARNING 3 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_v_typevar+100);
-      }
+      length_v_vallengspec = len_nom;
+      if ( length_v_vallengspec > LONG_M )
+           printf("WARNING 8 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_vallengspec+100);
    }
-   if ( whichone == 4  && strlen(nom) > length_v_nomvar )
+   if ( whichone == 12 && len_nom > length_v_precision )
    {
-      length_v_nomvar           = strlen(nom);
-      if ( length_v_nomvar > LONG_C )
-      {
-         printf("WARNING 4 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_v_nomvar+100);
-      }
+      length_v_precision = len_nom;
+      if ( length_v_precision > LONG_M )
+           printf("WARNING 12 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_precision+100);
    }
-   if ( whichone == 5  && strlen(nom) > length_v_dimchar )
+   if ( whichone == 13 && len_nom > length_v_IntentSpec )
    {
-      length_v_dimchar          = strlen(nom);
-      if ( length_v_dimchar > LONG_C )
-      {
-         printf("WARNING 5 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                          length_v_dimchar+100);
-      }
+      length_v_IntentSpec = len_nom;
+      if ( length_v_IntentSpec > LONG_M )
+           printf("WARNING 13 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_IntentSpec+100);
    }
-   if ( whichone == 6  && strlen(nom) > length_v_modulename )
+   if ( whichone == 14 && len_nom > length_v_initialvalue )
    {
-      length_v_modulename       = strlen(nom);
-      if ( length_v_modulename > LONG_C )
-      {
-         printf("WARNING 6 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_v_modulename+100);
-      }
+      length_v_initialvalue = len_nom;
+      if ( length_v_initialvalue > LONG_M )
+           printf("WARNING 14 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_initialvalue+100);
    }
-   if ( whichone == 7  && strlen(nom) > length_v_commonname )
+   if ( whichone == 15 && len_nom > length_v_readedlistdimension )
    {
-      length_v_commonname       = strlen(nom);
-      if ( length_v_commonname > LONG_C )
-      {
-         printf("WARNING 7 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_v_commonname+100);
-      }
+      length_v_readedlistdimension = len_nom;
+      if ( length_v_readedlistdimension > LONG_M )
+           printf("WARNING 15 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_readedlistdimension+100);
    }
-   if ( whichone == 8  && strlen(nom) > length_v_vallengspec )
+   if ( whichone == 25 && len_nom > length_a_nomvar )
    {
-      length_v_vallengspec      = strlen(nom);
-      if ( length_v_vallengspec > LONG_C )
-      {
-         printf("WARNING 8 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                      length_v_vallengspec+100);
-      }
+      length_a_nomvar = len_nom;
+      if ( length_a_nomvar > LONG_C )
+           printf("WARNING 25 : The value of LONG_C (defined in decl.h) should be upgrated to %lu\n", length_a_nomvar+100);
    }
-   if ( whichone == 9  && strlen(nom) > length_v_nameinttypename )
+   if ( whichone == 39 && len_nom > length_toprintglob )
    {
-      length_v_nameinttypename  = strlen(nom);
-      if ( length_v_nameinttypename > LONG_C )
-      {
-         printf("WARNING 9 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                  length_v_nameinttypename+100);
-      }
+      length_toprintglob = len_nom;
+      if ( length_toprintglob > LONG_M )
+           printf("WARNING 39 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprintglob+100);
    }
-   if ( whichone == 10 && strlen(nom) > length_v_commoninfile )
+   if ( whichone == 40 && len_nom > length_tmpvargridname )
    {
-      length_v_commoninfile     = strlen(nom);
-      if ( length_v_commoninfile > LONG_C )
-      {
-         printf("WARNING 10 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                     length_v_commoninfile+100);
-      }
+      length_tmpvargridname = len_nom;
+      if ( length_tmpvargridname > LONG_M )
+           printf("WARNING 40 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_tmpvargridname+100);
    }
-   if ( whichone == 11 && strlen(nom) > length_v_subroutinename )
+   if ( whichone == 41 && len_nom > length_ligne_Subloop )
    {
-      length_v_subroutinename   = strlen(nom);
-      if ( length_v_subroutinename > LONG_C )
-      {
-         printf("WARNING 11 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                   length_v_subroutinename+100);
-      }
+       length_ligne_Subloop = len_nom;
+      if ( length_ligne_Subloop > LONG_M )
+           printf("WARNING 41 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n",length_ligne_Subloop+100);
    }
-   if ( whichone == 12 && strlen(nom) > length_v_precision )
+   if ( whichone == 43 && len_nom > length_toprint_utilagrif )
    {
-      length_v_precision        = strlen(nom);
-      if ( length_v_precision > LONG_C )
-      {
-         printf("WARNING 12 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_v_precision+100);
-      }
+      length_toprint_utilagrif = len_nom;
+      if ( length_toprint_utilagrif > LONG_M )
+           printf("WARNING 43 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprint_utilagrif+100);
    }
-   if ( whichone == 13 && strlen(nom) > length_v_IntentSpec )
+   if ( whichone == 44 && len_nom > length_toprinttmp_utilchar )
    {
-      length_v_IntentSpec       = strlen(nom);
-      if ( length_v_IntentSpec > LONG_C )
-      {
-         printf("WARNING 13 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_v_IntentSpec+100);
-      }
+      length_toprinttmp_utilchar = len_nom;
+      if ( length_toprinttmp_utilchar > LONG_M)
+           printf("WARNING 44 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprinttmp_utilchar+100);
    }
-   if ( whichone == 14 && strlen(nom) > length_v_initialvalue )
+   if ( whichone == 45 && len_nom > length_ligne_writedecl )
    {
-      length_v_initialvalue     = strlen(nom);
-      if ( length_v_initialvalue > LONG_4C )
-      {
-         printf("WARNING 14 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                     length_v_initialvalue+100);
-      }
+      length_ligne_writedecl = len_nom;
+      if ( length_ligne_writedecl > LONG_M )
+           printf("WARNING 45 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_ligne_writedecl+100);
    }
-   if ( whichone == 15 && strlen(nom) > length_v_readedlistdimension )
+   if ( whichone == 46 && len_nom > length_newname_toamr )
    {
-      length_v_readedlistdimension = strlen(nom);
-      if ( length_v_readedlistdimension > LONG_C )
-      {
-         printf("WARNING 15 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                              length_v_readedlistdimension+100);
-      }
+      length_newname_toamr = len_nom;
+      if ( length_newname_toamr > LONG_C )
+           printf("WARNING 46 : The value of LONG_C (defined in decl.h) should be upgrated to %lu\n", length_newname_toamr+100);
    }
-   if ( whichone == 16 && strlen(nom) > length_u_usemodule )
+   if ( whichone == 47 && len_nom > length_newname_writedecl )
    {
-      length_u_usemodule        = strlen(nom);
-      if ( length_u_usemodule > LONG_C )
-      {
-         printf("WARNING 16 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_u_usemodule+100);
-      }
+      length_newname_writedecl = len_nom;
+      if ( length_newname_writedecl > LONG_M )
+           printf("WARNING 47 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_newname_writedecl +100);
    }
-   if ( whichone == 17 && strlen(nom) > length_u_charusemodule )
+   if ( whichone == 48 && len_nom > length_ligne_toamr )
    {
-      length_u_charusemodule    = strlen(nom);
-      if ( length_u_charusemodule > LONG_C )
-      {
-         printf("WARNING 17 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                    length_u_charusemodule+100);
-      }
+      length_ligne_toamr = len_nom;
+      if ( length_ligne_toamr > LONG_M )
+           printf("WARNING 48 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_ligne_toamr +100);
    }
-   if ( whichone == 18 && strlen(nom) > length_u_cursubroutine )
+   if ( whichone == 49 && len_nom > length_tmpligne_writedecl )
    {
-      length_u_cursubroutine    = strlen(nom);
-      if ( length_u_cursubroutine > LONG_C )
-      {
-         printf("WARNING 18 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                    length_u_cursubroutine+100);
-      }
-   }
-   if ( whichone == 19 && strlen(nom) > length_u_modulename )
-   {
-      length_u_modulename       = strlen(nom);
-      if ( length_u_modulename > LONG_C )
-      {
-         printf("WARNING 19 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_u_modulename+100);
-      }
-   }
-   if ( whichone == 20 && strlen(nom) > length_n_name )
-   {
-      length_n_name             = strlen(nom);
-      if ( length_n_name > LONG_C )
-      {
-         printf("WARNING 20 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_n_name+100);
-      }
-   }
-   if ( whichone == 21 && strlen(nom) > length_c_namevar )
-   {
-      length_c_namevar          = strlen(nom);
-      if ( length_c_namevar > LONG_C )
-      {
-         printf("WARNING 21 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_c_namevar+100);
-      }
-   }
-   if ( whichone == 22 && strlen(nom) > length_c_namepointedvar )
-   {
-      length_c_namepointedvar   = strlen(nom);
-      if ( length_c_namepointedvar > LONG_C )
-      {
-         printf("WARNING 22 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                   length_c_namepointedvar+100);
-      }
-   }
-   if ( whichone == 23 && strlen(nom) > length_o_nom )
-   {
-      length_o_nom              = strlen(nom);
-      if ( length_o_nom > LONG_C )
-      {
-         printf("WARNING 23 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_o_nom+100);
-      }
-   }
-   if ( whichone == 24 && strlen(nom) > length_o_module )
-   {
-      length_o_module           = strlen(nom);
-      if ( length_o_module > LONG_C )
-      {
-         printf("WARNING 24 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_o_module+100);
-      }
-   }
-   if ( whichone == 25 && strlen(nom) > length_a_nomvar )
-   {
-      length_a_nomvar           = strlen(nom);
-      if ( length_a_nomvar > LONG_C )
-      {
-         printf("WARNING 25 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_a_nomvar+100);
-      }
-   }
-   if ( whichone == 26 && strlen(nom) > length_a_subroutine )
-   {
-      length_a_subroutine       = strlen(nom);
-      if ( length_a_subroutine > LONG_C )
-      {
-         printf("WARNING 26 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_a_subroutine+100);
-      }
-   }
-   if ( whichone == 27 && strlen(nom) > length_a_module )
-   {
-      length_a_module           = strlen(nom);
-      if ( length_a_module > LONG_C )
-      {
-         printf("WARNING 27 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_a_module+100);
-      }
-   }
-   if ( whichone == 28 && strlen(nom) > length_t_usemodule )
-   {
-      length_t_usemodule        = strlen(nom);
-      if ( length_t_usemodule > LONG_C )
-      {
-         printf("WARNING 28 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_t_usemodule+100);
-      }
-   }
-   if ( whichone == 29 && strlen(nom) > length_t_cursubroutine )
-   {
-      length_t_cursubroutine    = strlen(nom);
-      if ( length_t_cursubroutine > LONG_C )
-      {
-         printf("WARNING 29 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                    length_t_cursubroutine+100);
-      }
-   }
-   if ( whichone == 30 && strlen(nom) > length_curfilename )
-   {
-      length_curfilename        = strlen(nom);
-      if (length_curfilename  > LONG_C )
-      {
-         printf("WARNING 30 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_curfilename+100);
-      }
-   }
-   if ( whichone == 31 && strlen(nom) > length_nomfileoutput )
-   {
-      length_nomfileoutput      = strlen(nom);
-      if ( length_nomfileoutput > LONG_C )
-      {
-         printf("WARNING 31 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                      length_nomfileoutput+100);
-      }
-   }
-   if ( whichone == 32 && strlen(nom) > length_motparse )
-   {
-      length_motparse           = strlen(nom);
-      if ( length_motparse > LONG_4C )
-      {
-         printf("WARNING 32 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_motparse+100);
-      }
-   }
-   if ( whichone == 33 && strlen(nom) > length_mainfile )
-   {
-      length_mainfile           = strlen(nom);
-      if ( length_mainfile > LONG_C )
-      {
-         printf("WARNING 33 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_mainfile+100);
-      }
-   }
-   if ( whichone == 34 && strlen(nom) > length_nomdir )
-   {
-      length_nomdir             = strlen(nom);
-      if ( length_nomdir > LONG_C )
-      {
-         printf("WARNING 34 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_nomdir+100);
-      }
-   }
-   if ( whichone == 35 && strlen(nom) > length_commondirout )
-   {
-      length_commondirout       = strlen(nom);
-      if ( length_commondirout > LONG_C )
-      {
-         printf("WARNING 35 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_commondirout+100);
-      }
-   }
-   if ( whichone == 36 && strlen(nom) > length_commondirin )
-   {
-      length_commondirin        = strlen(nom);
-      if ( length_commondirin > LONG_C )
-      {
-         printf("WARNING 36 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_commondirin+100);
-      }
-   }
-   if ( whichone == 37 && strlen(nom) > length_filetoparse )
-   {
-      length_filetoparse        = strlen(nom);
-      if ( length_filetoparse > LONG_C )
-      {
-         printf("WARNING 37 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_filetoparse+100);
-      }
-   }
-   if ( whichone == 38 && strlen(nom) > length_curbuf )
-   {
-      length_curbuf             = strlen(nom);
-      if ( length_curbuf > LONG_40M )
-      {
-         printf("WARNING 38 : The value of LONG_40M - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_curbuf+100);
-      }
-   }
-   if ( whichone == 39 && strlen(nom) > length_toprintglob )
-   {
-      length_toprintglob        = strlen(nom);
-      if ( length_toprintglob > LONG_4C )
-      {
-         printf("WARNING 39 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_toprintglob+100);
-      }
-   }
-   if ( whichone == 40 && strlen(nom) > length_tmpvargridname )
-   {
-      length_tmpvargridname     = strlen(nom);
-      if ( length_tmpvargridname > LONG_4C )
-      {
-         printf("WARNING 40 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                     length_tmpvargridname+100);
-      }
-   }
-   if ( whichone == 41 && strlen(nom) > length_ligne_Subloop )
-   {
-       length_ligne_Subloop    = strlen(nom);
-      if ( length_ligne_Subloop > LONG_40M )
-      {
-         printf("WARNING 41 : The value of LONG_40M - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                      length_ligne_Subloop+100);
-      }
-   }
-   if ( whichone == 42 && strlen(nom) > length_lvargridname_toamr )
-   {
-      length_lvargridname_toamr     = strlen(nom);
-      if ( length_lvargridname_toamr > LONG_4C )
-      {
-         printf("WARNING 42 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                 length_lvargridname_toamr+100);
-      }
-   }
-   if ( whichone == 43 && strlen(nom) > length_toprint_utilagrif )
-   {
-      length_toprint_utilagrif     = strlen(nom);
-      if ( length_toprint_utilagrif > LONG_C )
-      {
-         printf("WARNING 43 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                  length_toprint_utilagrif+100);
-      }
-   }
-   if ( whichone == 44 && strlen(nom) > length_toprinttmp_utilchar )
-   {
-      length_toprinttmp_utilchar     = strlen(nom);
-      if ( length_toprinttmp_utilchar > LONG_4C)
-      {
-         printf("WARNING 44 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                length_toprinttmp_utilchar+100);
-      }
-   }
-   if ( whichone == 45 && strlen(nom) > length_ligne_writedecl )
-   {
-      length_ligne_writedecl     = strlen(nom);
-      if ( length_ligne_writedecl > LONG_4C )
-      {
-         printf("WARNING 45 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                    length_ligne_writedecl+100);
-      }
-   }
-   if ( whichone == 46 && strlen(nom) > length_newname_toamr )
-   {
-      length_newname_toamr    = strlen(nom);
-      if ( length_newname_toamr > LONG_4C )
-      {
-         printf("WARNING 46 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                      length_newname_toamr+100);
-      }
-   }
-   if ( whichone == 47 && strlen(nom) > length_newname_writedecl )
-   {
-      length_newname_writedecl    = strlen(nom);
-      if ( length_newname_writedecl > LONG_4C )
-      {
-         printf("WARNING 47 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                 length_newname_writedecl +100);
-      }
-   }
-   if ( whichone == 48 && strlen(nom) > length_ligne_toamr )
-   {
-      length_ligne_toamr    = strlen(nom);
-      if ( length_ligne_toamr > LONGNOM )
-      {
-         printf("WARNING 48 : The value of LONGNOM - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_ligne_toamr +100);
-      }
-   }
-   if ( whichone == 49 && strlen(nom) > length_tmpligne_writedecl )
-   {
-      length_tmpligne_writedecl     = strlen(nom);
-      if ( length_tmpligne_writedecl > LONG_4C )
-      {
-         printf("WARNING 49 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                 length_tmpligne_writedecl+100);
-      }
+      length_tmpligne_writedecl = len_nom;
+      if ( length_tmpligne_writedecl > LONG_M )
+           printf("WARNING 49 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_tmpligne_writedecl+100);
    }
 }
@@ -520,11 +154,7 @@
 void Save_Length_int(int val, int whichone)
 {
-   if ( whichone == 1 && val > value_char_size )
-                               value_char_size                            = val;
-   if ( whichone == 2 && val > value_char_size1 )
-                               value_char_size1                           = val;
-   if ( whichone == 3 && val > value_char_size2 )
-                               value_char_size2                           = val;
-   if ( whichone == 4 && val > value_char_size3 )
-                               value_char_size3                           = val;
+   if ( whichone == 1 && val > value_char_size )    value_char_size  = val;
+   if ( whichone == 2 && val > value_char_size1 )   value_char_size1 = val;
+   if ( whichone == 3 && val > value_char_size2 )   value_char_size2 = val;
+   if ( whichone == 4 && val > value_char_size3 )   value_char_size3 = val;
 }
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c	(revision 6808)
@@ -40,5 +40,5 @@
 
 /******************************************************************************/
-/*                          varisallocatable_0                                */
+/*                          variscoupled_0                                    */
 /******************************************************************************/
 /* Firstpass 0                                                                */
@@ -46,66 +46,60 @@
 /*                                                                            */
 /******************************************************************************/
-int variscoupled_0(char *ident)
+int variscoupled_0(const char *ident)
 {
-   listallocate *newvaralloc;
-  listvarpointtovar *pointtmplist; 
-  listcouple *coupletmp;   
-  int out;
-
-   out =0;
-   if (firstpass == 0 )
-   {
-  pointtmplist = List_CouplePointed_Var;
-  while ( pointtmplist && out == 0)
-  {
-      coupletmp = pointtmplist->t_couple;
-      while ( coupletmp && out == 0)
-      {
-           /* we should find the same variable name in the same subroutine    */
-           if ( !strcasecmp(ident,coupletmp->c_namevar) &&
-                !strcasecmp(subroutinename,
-                                       pointtmplist->t_cursubroutine) &&
-                 strcasecmp(coupletmp->c_namepointedvar,"")
-              )
-           {
-              out = 1;
-           }
-         coupletmp = coupletmp->suiv;
-     }
-     pointtmplist = pointtmplist->suiv;
-   }
-   }
-   return out;
+    listvarpointtovar *pointtmplist; 
+    listcouple *coupletmp;   
+    int out = 0;
+    
+    if (firstpass == 0 )
+    {
+        pointtmplist = List_CouplePointed_Var;
+        while ( pointtmplist && out == 0)
+        {
+            coupletmp = pointtmplist->t_couple;
+            while ( coupletmp && out == 0)
+            {
+                /* we should find the same variable name in the same subroutine    */
+                if ( !strcasecmp(ident, coupletmp->c_namevar) &&
+                     !strcasecmp(subroutinename, pointtmplist->t_cursubroutine) &&
+                      strcasecmp(coupletmp->c_namepointedvar, "") )
+                {
+                    out = 1;
+                }
+                coupletmp = coupletmp->suiv;
+            }
+            pointtmplist = pointtmplist->suiv;
+        }
+    }
+    return out;
 }
 
-char * getcoupledname_0(char *ident)
+const char * getcoupledname_0(const char *ident)
 {
-   listallocate *newvaralloc;
-  listvarpointtovar *pointtmplist; 
-  listcouple *coupletmp;   
-  int out;
-
-   out =0;
-   if (firstpass == 0 )
-   {
-  pointtmplist = List_CouplePointed_Var;
-  while ( pointtmplist && out == 0)
-  {
-      coupletmp = pointtmplist->t_couple;
-      while ( coupletmp && out == 0)
-      {
-           /* we should find the same variable name in the same subroutine    */
-           if ( !strcasecmp(ident,coupletmp->c_namevar) &&
-                !strcasecmp(subroutinename,
-                                       pointtmplist->t_cursubroutine) &&
-                 strcasecmp(coupletmp->c_namepointedvar,"")
-              )
-           {
-              return(coupletmp->c_namepointedvar);
-           }
-         coupletmp = coupletmp->suiv;
-     }
-     pointtmplist = pointtmplist->suiv;
-   }
-   }
+    listvarpointtovar *pointtmplist; 
+    listcouple *coupletmp;   
+    int out = 0;
+    
+    if (firstpass == 0 )
+    {
+        pointtmplist = List_CouplePointed_Var;
+        while ( pointtmplist && out == 0)
+        {
+            coupletmp = pointtmplist->t_couple;
+            while ( coupletmp && out == 0)
+            {
+                /* we should find the same variable name in the same subroutine    */
+                if ( !strcasecmp(coupletmp->c_namevar,ident) &&
+                     !strcasecmp(pointtmplist->t_cursubroutine,subroutinename) &&
+                      strcasecmp(coupletmp->c_namepointedvar,"") )
+                {
+                    return coupletmp->c_namepointedvar;
+                }
+                coupletmp = coupletmp->suiv;
+            }
+            pointtmplist = pointtmplist->suiv;
+        }
+    }
+    printf("end of getcoupledname_0 -- you should not be there !!! \n");
+    return NULL;
 }
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c	(revision 6808)
@@ -61,5 +61,4 @@
            List_ModuleUsed_Var = Readthedependfile
                                (tmplistmodule->u_usemodule,List_ModuleUsed_Var);
-         printf("PPPPPPPPPPPPPP\n");
            List_GlobParamModuleUsed_Var = ReaddependParameterList
                       (tmplistmodule->u_usemodule,List_GlobParamModuleUsed_Var);
@@ -76,55 +75,50 @@
 /******************************************************************************/
 /******************************************************************************/
-void  RecordUseModulesUseModulesVariables()
-{
-  listusemodule *tmplistmodule;
-  listusemodule *tmplistmodule1;
-
-  /* we should record all variables defined in modules used in this file      */
-  if ( List_NameOfModuleUsed )
-  {
-     /* and we should read the .depend of the module used by the module used  */
-     tmplistmodule = List_NameOfModuleUsed;
-     while ( tmplistmodule )
-     {
+void RecordUseModulesUseModulesVariables()
+{
+    listusemodule *tmplistmodule;
+    listusemodule *save_list;
+
+    if ( ! List_NameOfModuleUsed )  return;
+
+    /* we should record all variables defined in modules used in this file      */
+    /* and we should read the .depend of the module used by the module used  */
+    tmplistmodule = List_NameOfModuleUsed;
+    while ( tmplistmodule )
+    {
         Readthedependlistofmoduleused(tmplistmodule->u_usemodule);
         while( tmpuselocallist )
         {
-           Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
-           tmplistmodule1 = tmpuselocallist->suiv;
-           free(tmpuselocallist);
-           tmpuselocallist = tmplistmodule1;
+            Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
+            save_list = tmpuselocallist->suiv;
+            free(tmpuselocallist);
+            tmpuselocallist = save_list;
         }
         tmplistmodule = tmplistmodule->suiv;
-     }
-
-     tmplistmodule = listofmoduletmp;
-     while ( tmplistmodule )
-     {
+    }
+    tmplistmodule = listofmoduletmp;
+    while ( tmplistmodule )
+    {
         Readthedependlistofmoduleused(tmplistmodule->u_usemodule);
         while( tmpuselocallist )
         {
-           Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
-           tmplistmodule1 = tmpuselocallist->suiv;
-           free(tmpuselocallist);
-           tmpuselocallist = tmplistmodule1;
+            Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
+            save_list = tmpuselocallist->suiv;
+            free(tmpuselocallist);
+            tmpuselocallist = save_list;
         }
         tmplistmodule = tmplistmodule->suiv;
-     }
-
-
-
-     tmplistmodule = listofmoduletmp;
-     while ( tmplistmodule )
-     {
-        /* check if the file .depend<u_usemodule> exist                       */
-        List_ModuleUsedInModuleUsed_Var = Readthedependfile
-                   (tmplistmodule->u_usemodule,List_ModuleUsedInModuleUsed_Var);
-
-        List_GlobParamModuleUsedInModuleUsed_Var = ReaddependParameterList
-          (tmplistmodule->u_usemodule,List_GlobParamModuleUsedInModuleUsed_Var);
+    }
+    tmplistmodule = listofmoduletmp;
+    while ( tmplistmodule )
+    {
+        // check if the file .depend<u_usemodule> exists
+        List_ModuleUsedInModuleUsed_Var =
+            Readthedependfile(tmplistmodule->u_usemodule,List_ModuleUsedInModuleUsed_Var);
+
+        List_GlobParamModuleUsedInModuleUsed_Var =
+            ReaddependParameterList(tmplistmodule->u_usemodule,List_GlobParamModuleUsedInModuleUsed_Var);
         tmplistmodule = tmplistmodule->suiv;
-     }
-  }
+    }
 }
 
@@ -147,60 +141,52 @@
 void Add_NameOfModuleUsed_1(char *name)
 {
-  listusemodule *newmodule;
-  listusemodule *parcours;
-  int out;
-
-  if ( firstpass == 1 )
-  {
-     newmodule =(listusemodule *)malloc(sizeof(listusemodule));
-     strcpy(newmodule->u_usemodule,name);
-     Save_Length(name,16);
-     strcpy(newmodule->u_charusemodule,charusemodule);
-     Save_Length(charusemodule,17);
-     strcpy(newmodule->u_modulename,curmodulename);
-     Save_Length(curmodulename,19);
-     strcpy(newmodule->u_cursubroutine,subroutinename);
-     Save_Length(subroutinename,18);
-     newmodule->u_firstuse = 1 ;
-     newmodule->suiv = NULL;
-
-     if ( !List_NameOfModuleUsed)
-     {
-         List_NameOfModuleUsed = newmodule ;
-     }
-     else
-     {
-    parcours = List_NameOfModuleUsed;
-    while ( parcours && newmodule->u_firstuse == 1 )
-    {
-       if ( !strcasecmp(name,parcours->u_usemodule) )
-       {
-          newmodule->u_firstuse = 0 ;
-       }
-       parcours=parcours->suiv;
-    }
-    /* we can not add the same module twice for the same subroutine           */
-    parcours = List_NameOfModuleUsed;
-    out = 0 ;
-    while ( parcours && out == 0 )
-    {
-       if ( !strcasecmp(name,parcours->u_usemodule) &&
-            !strcasecmp(subroutinename,parcours->u_cursubroutine)
-           )
-       {
-          out = 1 ;
-          free(newmodule);
-       }
-       else parcours=parcours->suiv;
-    }
-    if ( out == 0 )
-    {
-       newmodule->suiv = List_NameOfModuleUsed;
-       List_NameOfModuleUsed = newmodule;
-    }
-  }
-  }
-}
-
+    listusemodule *newmodule;
+    listusemodule *parcours;
+    int out;
+
+    newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
+    strcpy(newmodule->u_usemodule, name);
+    strcpy(newmodule->u_charusemodule, charusemodule);
+    strcpy(newmodule->u_modulename, curmodulename);
+    strcpy(newmodule->u_cursubroutine, subroutinename);
+    newmodule->u_firstuse = 1 ;
+    newmodule->suiv = NULL;
+
+    if ( List_NameOfModuleUsed == NULL )
+    {
+        List_NameOfModuleUsed = newmodule ;
+    }
+    else
+    {
+        parcours = List_NameOfModuleUsed;
+        while ( parcours && newmodule->u_firstuse )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) )
+            {
+                newmodule->u_firstuse = 0 ;
+            }
+            parcours = parcours->suiv;
+        }
+        /* we can not add the same module twice for the same subroutine           */
+        parcours = List_NameOfModuleUsed;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) &&
+                 !strcasecmp(subroutinename,parcours->u_cursubroutine) )
+            {
+                out = 1 ;
+                free(newmodule);
+            }
+            else
+                parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newmodule->suiv = List_NameOfModuleUsed;
+            List_NameOfModuleUsed = newmodule;
+        }
+    }
+}
 
 /******************************************************************************/
@@ -220,55 +206,52 @@
 /*                                                                            */
 /******************************************************************************/
-void Addmoduletothelist(char *name)
-{
-  listusemodule *newmodule;
-  listusemodule *parcours;
-  int out;
-
-     newmodule =(listusemodule *)malloc(sizeof(listusemodule));
-     strcpy(newmodule->u_usemodule,name);
-     Save_Length(name,16);
-     strcpy(newmodule->u_charusemodule,charusemodule);
-     Save_Length(charusemodule,17);
-     strcpy(newmodule->u_cursubroutine,subroutinename);
-     Save_Length(subroutinename,18);
-     newmodule->u_firstuse = 1 ;
-     newmodule->suiv = NULL;
-
-     if ( !List_NameOfModuleUsed)
-     {
-         List_NameOfModuleUsed = newmodule ;
-     }
-     else
-     {
-    parcours = List_NameOfModuleUsed;
-    while ( parcours && newmodule->u_firstuse == 1 )
-    {
-       if ( !strcasecmp(name,parcours->u_usemodule) )
-       {
-          newmodule->u_firstuse = 0 ;
-       }
-       parcours=parcours->suiv;
-    }
-    /* we can not add the same module twice for the same subroutine           */
-    parcours = List_NameOfModuleUsed;
-    out = 0 ;
-    while ( parcours && out == 0 )
-    {
-       if ( !strcasecmp(name,parcours->u_usemodule) &&
-            !strcasecmp(subroutinename,parcours->u_cursubroutine)
-           )
-       {
-          out = 1 ;
-          free(newmodule);
-       }
-       else parcours=parcours->suiv;
-    }
-    if ( out == 0 )
-    {
-       newmodule->suiv = List_NameOfModuleUsed;
-       List_NameOfModuleUsed = newmodule;
-    }
-  }
+void Addmoduletothelist(const char *name)
+{
+    listusemodule *newmodule;
+    listusemodule *parcours;
+    int out;
+
+    newmodule = (listusemodule*) calloc(1,sizeof(listusemodule));
+    strcpy(newmodule->u_usemodule, name);
+    strcpy(newmodule->u_charusemodule, charusemodule);
+    strcpy(newmodule->u_cursubroutine, subroutinename);
+    newmodule->u_firstuse = 1 ;
+    newmodule->suiv = NULL;
+
+    if ( !List_NameOfModuleUsed )
+    {
+        List_NameOfModuleUsed = newmodule ;
+    }
+    else
+    {
+        parcours = List_NameOfModuleUsed;
+        while ( parcours && newmodule->u_firstuse == 1 )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) )
+            {
+                newmodule->u_firstuse = 0 ;
+            }
+            parcours=parcours->suiv;
+        }
+        /* we can not add the same module twice for the same subroutine           */
+        parcours = List_NameOfModuleUsed;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) &&
+                 !strcasecmp(subroutinename,parcours->u_cursubroutine) )
+            {
+                out = 1 ;
+                free(newmodule);
+            }
+            else
+                parcours=parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newmodule->suiv = List_NameOfModuleUsed;
+            List_NameOfModuleUsed = newmodule;
+        }
+    }
 }
 
@@ -281,23 +264,40 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteUsemoduleDeclaration(char *cursubroutinename)
-{
-  listusemodule *newmodule;
-  
-
-  newmodule = List_NameOfModuleUsed;
-  fprintf(fortranout,"\n");
-
-  while ( newmodule )
-  {
-     if ( !strcasecmp(newmodule->u_cursubroutine,cursubroutinename) )
-     {
-     if (strcmp(newmodule->u_charusemodule,""))
-     {
-             fprintf(fortranout,"      USE %s \n"
-                                                   ,newmodule->u_charusemodule);
-     }
-     }
+void WriteUsemoduleDeclaration(const char *cursubroutinename)
+{
+    listusemodule     *newmodule;
+    listvarpointtovar *pointtmp;
+    long int          fictifpos;
+    int               findcoupled;
+
+    fprintf(fortran_out,"\n");
+    newmodule = List_NameOfModuleUsed;
+
+    while ( newmodule )
+    {
+        if ( !strcasecmp(newmodule->u_cursubroutine, cursubroutinename) )
+        {
+            if (strcmp(newmodule->u_charusemodule,""))
+            {
+/*
+                findcoupled = 0;
+                pointtmp = List_CouplePointed_Var;
+                while(pointtmp)
+                {
+                    if ((!strcasecmp(pointtmp->t_usemodule, newmodule->u_charusemodule)) && \
+                        (!strcasecmp(pointtmp->t_cursubroutine, cursubroutinename)))
+                    {
+                        fictifpos = setposcur();
+                        variableisglobalinmodule(pointtmp->t_couple,newmodule->u_charusemodule,fortran_out,fictifpos);
+                        findcoupled = 1;
+                    }
+                    pointtmp=pointtmp->suiv;
+                }
+                if (findcoupled == 0)   fprintf(fortran_out,"      use %s\n",newmodule->u_charusemodule);
+*/
+                fprintf(fortran_out,"      use %s\n", newmodule->u_charusemodule);
+            }
+        }
         newmodule = newmodule ->suiv;
-  }
-}
+    }
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c	(revision 6808)
@@ -34,6 +34,6 @@
 /******************************************************************************/
 #include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
+//#include <stdlib.h>
+//#include <string.h>
 
 #include "decl.h"
@@ -47,5 +47,5 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_UsedInSubroutine_Var_1 (char *ident)
+void Add_UsedInSubroutine_Var_1 (const char *ident)
 {
   listvar *newvar;
@@ -59,6 +59,6 @@
   if ( !List_UsedInSubroutine_Var )
   {
-      newvar=(listvar *)malloc(sizeof(listvar));
-      newvar->var=(variable *)malloc(sizeof(variable));
+      newvar=(listvar *)calloc(1,sizeof(listvar));
+      newvar->var=(variable *)calloc(1,sizeof(variable));
       /*                                                                      */
       Init_Variable(newvar->var);
@@ -66,17 +66,9 @@
       newvar->suiv = NULL;
       strcpy(newvar->var->v_nomvar,ident);
-
-      Save_Length(ident,4);
       strcpy(newvar->var->v_modulename,curmodulename);
-      Save_Length(curmodulename,6);
-     printf("ICI %d\n",newvar->var->v_module);
-
-      strcpy(newvar->var->v_commoninfile,mainfile);
-      Save_Length(mainfile,10);
+      strcpy(newvar->var->v_commoninfile,cur_filename);
       strcpy(newvar->var->v_subroutinename,subroutinename);
-      Save_Length(subroutinename,11);
       newvar->var->v_pointedvar=pointedvar;
       List_UsedInSubroutine_Var = newvar ;
-       printf("jaoute %s\n",newvar->var->v_nomvar);
   }
   else
@@ -94,23 +86,16 @@
       if ( out == 0 )
       {
-         newvar=(listvar *)malloc(sizeof(listvar));
-         newvar->var=(variable *)malloc(sizeof(variable));
+         newvar=(listvar *)calloc(1,sizeof(listvar));
+         newvar->var=(variable *)calloc(1,sizeof(variable));
          /*                                                                   */
          Init_Variable(newvar->var);
          /*                                                                   */
          strcpy(newvar->var->v_nomvar,ident);
-
-         Save_Length(ident,4);
-         strcpy(newvar->var->v_commoninfile,mainfile);
-         Save_Length(mainfile,10);
+         strcpy(newvar->var->v_commoninfile,cur_filename);
          strcpy(newvar->var->v_modulename,curmodulename);
-         Save_Length(curmodulename,6);
-       printf("ICI %d\n",newvar->var->v_module);
          strcpy(newvar->var->v_subroutinename,subroutinename);
-         Save_Length(subroutinename,11);
          newvar->var->v_pointedvar=pointedvar;
          newvar->suiv = List_UsedInSubroutine_Var;
-         printf("jaoute %s\n",newvar->var->v_nomvar);
-         List_UsedInSubroutine_Var = newvar;        
+         List_UsedInSubroutine_Var = newvar;
       }
   }
@@ -134,6 +119,6 @@
   if ( !List_UsedInSubroutine_Var )
   {
-      newvar=(listvar *)malloc(sizeof(listvar));
-      newvar->var=(variable *)malloc(sizeof(variable));
+      newvar=(listvar *)calloc(1,sizeof(listvar));
+      newvar->var=(variable *)calloc(1,sizeof(variable));
       /*                                                                      */
       Init_Variable(newvar->var);
@@ -141,12 +126,7 @@
       newvar->suiv = NULL;
       strcpy(newvar->var->v_nomvar,name);
-
-      Save_Length(name,4);
       strcpy(newvar->var->v_modulename,curmodulename);
-      Save_Length(curmodulename,6);
-      strcpy(newvar->var->v_commoninfile,mainfile);
-      Save_Length(mainfile,10);
+      strcpy(newvar->var->v_commoninfile,cur_filename);
       strcpy(newvar->var->v_subroutinename,subroutinename);
-      Save_Length(subroutinename,11);
       newvar->var->v_pointedvar=pointedvar;
       List_UsedInSubroutine_Var = newvar ;
@@ -183,18 +163,13 @@
       if ( out == 2 || out == 0 )
       {
-         newvar=(listvar *)malloc(sizeof(listvar));
-         newvar->var=(variable *)malloc(sizeof(variable));
+         newvar=(listvar *)calloc(1,sizeof(listvar));
+         newvar->var=(variable *)calloc(1,sizeof(variable));
          /*                                                                   */
          Init_Variable(newvar->var);
          /*                                                                   */
          strcpy(newvar->var->v_nomvar,name);
-
-         Save_Length(name,4);
          strcpy(newvar->var->v_modulename,curmodulename);
-         Save_Length(curmodulename,6);
-         strcpy(newvar->var->v_commoninfile,mainfile);
-         Save_Length(mainfile,10);
+         strcpy(newvar->var->v_commoninfile,cur_filename);
          strcpy(newvar->var->v_subroutinename,subroutinename);
-         Save_Length(subroutinename,11);
          newvar->var->v_pointedvar=pointedvar;
 
@@ -254,163 +229,172 @@
 void  CompleteThelistvarindoloop()
 {
-  listvar *newvar;
-  listvarpointtovar *pointtmplist;
-  listcouple *coupletmp;
-  int outvar;
-
-  pointtmplist = List_CouplePointed_Var;
-  while ( pointtmplist )
-  {
-      coupletmp = pointtmplist->t_couple;
-      while ( coupletmp )
-      {
-         newvar = List_UsedInSubroutine_Var;
-         outvar = 0 ;
-         while ( newvar && outvar == 0)
-         {
-           /* we should find the same variable name in the same subroutine    */
-           if ( !strcasecmp(newvar->var->v_nomvar,coupletmp->c_namevar) &&
-                !strcasecmp(newvar->var->v_subroutinename,
-                                       pointtmplist->t_cursubroutine) &&
-                 strcasecmp(coupletmp->c_namepointedvar,"")
-              )
-           {
-              outvar = 1;
-              strcpy(newvar->var->v_oldname,newvar->var->v_nomvar);
-              strcpy(newvar->var->v_nomvar,coupletmp->c_namepointedvar);
-           }
-           else
-           {
-              newvar = newvar->suiv;
-           }
-         }
-         coupletmp = coupletmp->suiv;
-     }
-     pointtmplist = pointtmplist->suiv;
-  }
-}
-
-/******************************************************************************/
-/*                             CopyRecord                                     */
+    listvar *newvar;
+    listvarpointtovar *pointtmplist;
+    listcouple *coupletmp;
+    int outvar;
+
+    pointtmplist = List_CouplePointed_Var;
+    while ( pointtmplist )
+    {
+        coupletmp = pointtmplist->t_couple;
+        while ( coupletmp )
+        {
+            newvar = List_UsedInSubroutine_Var;
+            outvar = 0 ;
+            while ( newvar && outvar == 0)
+            {
+                /* we should find the same variable name in the same subroutine    */
+                if ( !strcasecmp(newvar->var->v_nomvar, coupletmp->c_namevar) &&
+                     !strcasecmp(newvar->var->v_subroutinename, pointtmplist->t_cursubroutine) &&
+                      strcasecmp(coupletmp->c_namepointedvar, "") )
+                {
+                    outvar = 1;
+                    strcpy(newvar->var->v_oldname, newvar->var->v_nomvar);
+                    strcpy(newvar->var->v_nomvar, coupletmp->c_namepointedvar);
+                }
+                else
+                {
+                    newvar = newvar->suiv;
+                }
+            }
+            coupletmp = coupletmp->suiv;
+        }
+        pointtmplist = pointtmplist->suiv;
+    }
+}
+
+/******************************************************************************/
+/*                             Merge_Variables                                */
 /******************************************************************************/
 /*                                                                            */
 /******************************************************************************/
-void CopyRecord(variable *var1,variable *var2)
-{
-   if ( !strcasecmp(var1->v_typevar,"") )
-                                        strcpy(var1->v_typevar,var2->v_typevar);
-   else strcpy(var2->v_typevar,var1->v_typevar);
-
-   if ( !strcasecmp(var1->v_oldname,"") )
-                                        strcpy(var1->v_oldname,var2->v_oldname);
-   else strcpy(var2->v_oldname,var1->v_oldname);
-
-   if ( !strcasecmp(var1->v_dimchar,"") )
-                                        strcpy(var1->v_dimchar,var2->v_dimchar);
-   else strcpy(var2->v_dimchar,var1->v_dimchar);
-
-   if ( !strcasecmp(var1->v_commonname,"") )
-                                  strcpy(var1->v_commonname,var2->v_commonname);
-   else strcpy(var2->v_commonname,var1->v_commonname);
-   
-   printf("modulenameII = %s %s %d %s\n",var1->v_modulename,var2->v_modulename,var1->v_module,var1->v_nomvar);
-
-   if ( !strcasecmp(var1->v_modulename,"") || (var1->v_module ==0))
-                                  strcpy(var1->v_modulename,var2->v_modulename);
-   else strcpy(var2->v_modulename,var1->v_modulename);
-
-   if ( !strcasecmp(var1->v_vallengspec,"") )
-                                strcpy(var1->v_vallengspec,var2->v_vallengspec);
-   else strcpy(var2->v_vallengspec,var1->v_vallengspec);
-
-   if ( !strcasecmp(var1->v_nameinttypename,"") )
-                        strcpy(var1->v_nameinttypename,var2->v_nameinttypename);
-   else strcpy(var2->v_nameinttypename,var1->v_nameinttypename);
-          
-   if ( !strcasecmp(var1->v_commoninfile,"") )
-                              strcpy(var1->v_commoninfile,var2->v_commoninfile);
-   else strcpy(var2->v_commoninfile,var1->v_commoninfile);
-
-   if ( !strcasecmp(var1->v_precision,"") )
-                                    strcpy(var1->v_precision,var2->v_precision);
-   else strcpy(var2->v_precision,var1->v_precision);
-
-   if ( !strcasecmp(var1->v_initialvalue,"") )
-                              strcpy(var1->v_initialvalue,var2->v_initialvalue);
-   else strcpy(var2->v_initialvalue,var1->v_initialvalue);
-
-   if ( !strcasecmp(var1->v_IntentSpec,"") )
-                                  strcpy(var1->v_IntentSpec,var2->v_IntentSpec);
-   else strcpy(var2->v_IntentSpec,var1->v_IntentSpec);
-
-   if ( !strcasecmp(var1->v_readedlistdimension,"") )
-                strcpy(var1->v_readedlistdimension,var2->v_readedlistdimension);
-   else strcpy(var2->v_readedlistdimension,var1->v_readedlistdimension);
-
-   if ( var1->v_dimension ) var2->v_dimension = var1->v_dimension ;
-   else var1->v_dimension = var2->v_dimension ;
-
-   if ( var1->v_nbdim == 0 ) var1->v_nbdim = var2->v_nbdim ;
-   else var2->v_nbdim = var1->v_nbdim ;
-
-   if ( var1->v_common == 0 ) var1->v_common = var2->v_common ;
-   else var2->v_common = var1->v_common ;
-
-   if ( var1->v_positioninblock == 0 ) var1->v_positioninblock =
-                                                       var2->v_positioninblock ;
-   else var2->v_positioninblock = var1->v_positioninblock ;
-
-   if ( var1->v_module == 0 ) var1->v_module = var2->v_module ;
-   else var2->v_module = var1->v_module ;
-
-   if ( var1->v_save == 0 ) var1->v_save = var2->v_save ;
-   else var2->v_save = var1->v_save ;
-   
-   if ( var1->v_VariableIsParameter == 0 )
-                     var1->v_VariableIsParameter = var2->v_VariableIsParameter ;
-                    
-   else var2->v_VariableIsParameter = var1->v_VariableIsParameter ;
-   if ( var1->v_indicetabvars == 0 )
-   {
-   
-                                 var1->v_indicetabvars = var2->v_indicetabvars ;
-       printf("HERHEHR %s mm %s mm %d\n",var1->v_nomvar,var2->v_modulename,var2->v_indicetabvars);
-                                 }
-   else var2->v_indicetabvars = var1->v_indicetabvars ;
-
-   if ( var1->v_ExternalDeclare == 0 )
-                             var1->v_ExternalDeclare = var2->v_ExternalDeclare ;
-   else var2->v_ExternalDeclare = var1->v_ExternalDeclare ;
-
-   if ( var1->v_pointedvar == 0 ) var1->v_pointedvar = var2->v_pointedvar ;
-   else var2->v_pointedvar = var1->v_pointedvar ;
-
-   if ( var1->v_dimensiongiven == 0 )
-                                var1->v_dimensiongiven = var2->v_dimensiongiven;
-   else var2->v_dimensiongiven = var1->v_dimensiongiven ;
-
-   if ( var1->v_c_star == 0 ) var1->v_c_star = var2->v_c_star;
-   else var2->v_c_star = var1->v_c_star ;
-
-   if ( var1->v_pointerdeclare == 0 )
-                               var1->v_pointerdeclare = var2->v_pointerdeclare ;
-   else var2->v_pointerdeclare = var1->v_pointerdeclare ;
-
-
-   if ( var1->v_notgrid == 0 ) var1->v_notgrid = var2->v_notgrid ;
-   else var2->v_notgrid = var1->v_notgrid;
-
-   if ( var1->v_optionaldeclare == 0 )
-                              var1->v_optionaldeclare = var2->v_optionaldeclare;
-   else var2->v_optionaldeclare = var1->v_optionaldeclare ;
-
-   if ( var1->v_allocatable == 0 ) var1->v_allocatable = var2->v_allocatable ;
-   else var2->v_allocatable = var1->v_allocatable ;
-   
-   if ( var1->v_target == 0 ) var1->v_target = var2->v_target ;
-   else var2->v_target = var1->v_target ;
-
-   if ( var1->v_dimsempty == 0 ) var1->v_dimsempty = var2->v_dimsempty ;
-   else var2->v_dimsempty = var1->v_dimsempty ;
+void Merge_Variables(variable *var1, variable *var2)
+{
+    if ( !strcasecmp(var1->v_typevar,"") )
+            strcpy(var1->v_typevar,var2->v_typevar);
+    else
+      {
+      strcpy(var2->v_typevar,var1->v_typevar);
+      }
+
+    if ( !strcasecmp(var1->v_oldname,"") )
+            strcpy(var1->v_oldname,var2->v_oldname);
+    else    strcpy(var2->v_oldname,var1->v_oldname);
+
+    if ( !strcasecmp(var1->v_dimchar,"") )
+            strcpy(var1->v_dimchar,var2->v_dimchar);
+    else    strcpy(var2->v_dimchar,var1->v_dimchar);
+
+    if ( !strcasecmp(var1->v_commonname,"") )
+            strcpy(var1->v_commonname,var2->v_commonname);
+    else    strcpy(var2->v_commonname,var1->v_commonname);
+
+    if ( !strcasecmp(var1->v_modulename,"") || (var1->v_module ==0))
+            strcpy(var1->v_modulename,var2->v_modulename);
+    else    strcpy(var2->v_modulename,var1->v_modulename);
+
+    if ( !strcasecmp(var1->v_vallengspec,"") )
+            strcpy(var1->v_vallengspec,var2->v_vallengspec);
+    else    strcpy(var2->v_vallengspec,var1->v_vallengspec);
+
+    if ( !strcasecmp(var1->v_nameinttypename,"") )
+            strcpy(var1->v_nameinttypename,var2->v_nameinttypename);
+    else    strcpy(var2->v_nameinttypename,var1->v_nameinttypename);
+
+    if ( !strcasecmp(var1->v_commoninfile,"") )
+            strcpy(var1->v_commoninfile,var2->v_commoninfile);
+    else    strcpy(var2->v_commoninfile,var1->v_commoninfile);
+
+    if ( !strcasecmp(var1->v_precision,"") )
+            strcpy(var1->v_precision,var2->v_precision);
+    else    strcpy(var2->v_precision,var1->v_precision);
+
+    if ( !strcasecmp(var1->v_initialvalue,"") )
+            strcpy(var1->v_initialvalue,var2->v_initialvalue);
+    else    strcpy(var2->v_initialvalue,var1->v_initialvalue);
+
+    if ( !strcasecmp(var1->v_IntentSpec,"") )
+            strcpy(var1->v_IntentSpec,var2->v_IntentSpec);
+    else    strcpy(var2->v_IntentSpec,var1->v_IntentSpec);
+
+    if ( !strcasecmp(var1->v_readedlistdimension,"") )
+            strcpy(var1->v_readedlistdimension,var2->v_readedlistdimension);
+    else    strcpy(var2->v_readedlistdimension,var1->v_readedlistdimension);
+
+    if ( var1->v_dimension )
+            var2->v_dimension = var1->v_dimension ;
+    else    var1->v_dimension = var2->v_dimension ;
+
+    if ( var1->v_nbdim == 0 )
+            var1->v_nbdim = var2->v_nbdim ;
+    else    var2->v_nbdim = var1->v_nbdim ;
+
+    if ( var1->v_common == 0 )
+            var1->v_common = var2->v_common ;
+    else    var2->v_common = var1->v_common ;
+
+    if ( var1->v_positioninblock == 0 )
+            var1->v_positioninblock = var2->v_positioninblock ;
+    else    var2->v_positioninblock = var1->v_positioninblock ;
+
+    if ( var1->v_module == 0 )
+            var1->v_module = var2->v_module ;
+    else    var2->v_module = var1->v_module ;
+
+    if ( var1->v_save == 0 )
+            var1->v_save = var2->v_save ;
+    else    var2->v_save = var1->v_save ;
+
+    if ( var1->v_VariableIsParameter == 0 )
+            var1->v_VariableIsParameter = var2->v_VariableIsParameter ;
+    else    var2->v_VariableIsParameter = var1->v_VariableIsParameter ;
+
+    if ( var1->v_indicetabvars == 0 )
+            var1->v_indicetabvars = var2->v_indicetabvars ;
+    else    var2->v_indicetabvars = var1->v_indicetabvars ;
+
+    if ( var1->v_ExternalDeclare == 0 )
+            var1->v_ExternalDeclare = var2->v_ExternalDeclare ;
+    else    var2->v_ExternalDeclare = var1->v_ExternalDeclare ;
+
+    if ( var1->v_pointedvar == 0 )
+            var1->v_pointedvar = var2->v_pointedvar ;
+    else    var2->v_pointedvar = var1->v_pointedvar ;
+
+    if ( var1->v_dimensiongiven == 0 )
+            var1->v_dimensiongiven = var2->v_dimensiongiven;
+    else    var2->v_dimensiongiven = var1->v_dimensiongiven ;
+
+    if ( var1->v_c_star == 0 )
+            var1->v_c_star = var2->v_c_star;
+    else    var2->v_c_star = var1->v_c_star ;
+
+    if ( var1->v_catvar == 0 )
+            var1->v_catvar = var2->v_catvar;
+    else    var2->v_catvar = var1->v_catvar ;
+
+    if ( var1->v_pointerdeclare == 0 )
+            var1->v_pointerdeclare = var2->v_pointerdeclare ;
+    else    var2->v_pointerdeclare = var1->v_pointerdeclare ;
+
+    if ( var1->v_notgrid == 0 )
+            var1->v_notgrid = var2->v_notgrid ;
+    else    var2->v_notgrid = var1->v_notgrid;
+
+    if ( var1->v_optionaldeclare == 0 )
+            var1->v_optionaldeclare = var2->v_optionaldeclare;
+    else    var2->v_optionaldeclare = var1->v_optionaldeclare ;
+
+    if ( var1->v_allocatable == 0 )
+            var1->v_allocatable = var2->v_allocatable ;
+    else    var2->v_allocatable = var1->v_allocatable ;
+
+    if ( var1->v_target == 0 )
+            var1->v_target = var2->v_target ;
+    else    var2->v_target = var1->v_target ;
+
+    if ( var1->v_dimsempty == 0 )
+            var1->v_dimsempty = var2->v_dimsempty ;
+    else    var2->v_dimsempty = var1->v_dimsempty ;
 }
 
@@ -437,10 +421,7 @@
       while ( parcours1 && out == 0 )
       {
-         if ( !strcasecmp(parcours->var->v_nomvar,
-                          parcours1->var->v_nomvar)         &&
-              !strcasecmp(parcours->var->v_subroutinename,
-                          parcours1->var->v_subroutinename) &&
-              !strcasecmp(parcours->var->v_modulename,
-                          parcours1->var->v_modulename)
+         if ( !strcasecmp(parcours->var->v_nomvar,         parcours1->var->v_nomvar)         &&
+              !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+              !strcasecmp(parcours->var->v_modulename,     parcours1->var->v_modulename)
             ) out = 1;
          else parcours1 = parcours1->suiv;
@@ -448,6 +429,6 @@
       /* if variable has been found                                           */
 
-      if ( out == 1 ) CopyRecord(parcours->var,parcours1->var);
-      
+      if ( out == 1 ) Merge_Variables(parcours->var,parcours1->var);
+
       /* looking in List_Dimension_Var                                        */
       if (out == 0 )
@@ -471,8 +452,8 @@
         }
         /* if variable has been found                                         */
-        
+
         if ( out == 1 )
         {
-           CopyRecord(parcours->var,parcours1->var);
+           Merge_Variables(parcours->var,parcours1->var);
            /* we should remove this record from the List_Dimension_Var        */
            if ( parcours1 == List_Dimension_Var )
@@ -495,5 +476,5 @@
    listvar *parcours;
    listvar *newvar;
-   char ligne[LONG_C];
+   char tmpname[LONG_VNAME];
 
    parcours = List_Save_Var;
@@ -503,18 +484,17 @@
       /* Save in subroutine which is not defined in a module                  */
       {
-         newvar = (listvar *)malloc(sizeof(listvar));
-         newvar->var = (variable *)malloc(sizeof(variable));
+         newvar = (listvar *)calloc(1,sizeof(listvar));
+         newvar->var = (variable *)calloc(1,sizeof(variable));
          /*                                                                   */
          Init_Variable(newvar->var);
          /*                                                                   */
          newvar->suiv = NULL;
-         CopyRecord(parcours->var,newvar->var);
+         Merge_Variables(parcours->var,newvar->var);
          strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename);
          strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
-
-         sprintf(ligne,"save_%s",parcours->var->v_subroutinename);
-         Add_NameOfCommon_1(ligne,parcours->var->v_subroutinename);
-         strcpy(newvar->var->v_commonname,ligne);
-         Save_Length(ligne,7);
+         newvar->var->v_catvar=parcours->var->v_catvar;
+         sprintf(tmpname,"save_%s",parcours->var->v_subroutinename);
+         Add_NameOfCommon_1(tmpname,parcours->var->v_subroutinename);
+         strcpy(newvar->var->v_commonname,tmpname);
          List_Common_Var = AddListvarToListvar(newvar,List_Common_Var,1);
       }
@@ -522,6 +502,6 @@
       /* Save in subroutine which is defined in a module                      */
       {
-         newvar = (listvar *)malloc(sizeof(listvar));
-         newvar->var = (variable *)malloc(sizeof(variable));
+         newvar = (listvar *)calloc(1,sizeof(listvar));
+         newvar->var = (variable *)calloc(1,sizeof(variable));
          /*                                                                   */
          Init_Variable(newvar->var);
@@ -529,9 +509,10 @@
          newvar->suiv = NULL;
 
-         CopyRecord(parcours->var,newvar->var);
+         Merge_Variables(parcours->var,newvar->var);
          strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename);
 
          strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
 
+         newvar->var->v_catvar=parcours->var->v_catvar;
          strcpy(newvar->var->v_modulename,parcours->var->v_modulename);
          List_Global_Var = AddListvarToListvar(newvar,List_Global_Var,1);
@@ -560,11 +541,9 @@
       {
 
-         if ( !strcasecmp(parcours->var->v_nomvar,
-                          parcours1->var->v_nomvar)         &&
-              !strcasecmp(parcours->var->v_subroutinename,
-                          parcours1->var->v_subroutinename)
-            ) {
-            out = 1;     
-            }
+         if ( !strcasecmp(parcours->var->v_nomvar,         parcours1->var->v_nomvar) &&
+              !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) )
+         {
+            out = 1;
+         }
          else parcours1 = parcours1->suiv;
       }
@@ -573,6 +552,6 @@
       {
          strcpy(parcours->var->v_commoninfile,parcours1->var->v_commoninfile);
-             
-         CopyRecord(parcours->var,parcours1->var);
+
+         Merge_Variables(parcours->var,parcours1->var);
       }
       parcours = parcours->suiv;
@@ -587,103 +566,77 @@
 void Update_List_Var(listvar *list_to_modify)
 {
-   listvar *parcours;
-   listvar *parcours1;
-   int out;
-   int out2;
-   
-   parcours = list_to_modify;
-
-   while( parcours )
-   {
-     printf("LE NOM EST %s\n",parcours->var->v_nomvar);
-      /* looking in List_Global_Var                                           */
-      
-      out = 0;
-      
-//       if (list_to_modify != List_SubroutineDeclaration_Var && list_to_modify != List_UsedInSubroutine_Var) {
-//       parcours1 = List_Global_Var;
-//       while ( parcours1 && out == 0 )
-//       {
-//          if ( !strcasecmp(parcours->var->v_nomvar,
-//                           parcours1->var->v_nomvar)         &&
-//               !strcasecmp(parcours->var->v_modulename,
-//                           parcours1->var->v_modulename)
-//             ) out = 1;
-//          else parcours1 = parcours1->suiv;
-//       }
-//       }
-      
-  //    if (list_to_modify == List_UsedInSubroutine_Var) {
-      parcours1 = List_Global_Var;
-      while ( parcours1 && out == 0 )
-      {
-      printf("lenombis est %s\n",parcours1->var->v_nomvar);
-         if ( !strcasecmp(parcours->var->v_nomvar,
-                          parcours1->var->v_nomvar)         &&
-                 !strcasecmp(parcours->var->v_subroutinename,
-                             parcours1->var->v_subroutinename) &&
-              !strcasecmp(parcours->var->v_modulename,
-                          parcours1->var->v_modulename)
-            ) {
-            out = 1;
+    listvar *parcours;
+    listvar *parcours1;
+    int out;
+
+    parcours = list_to_modify;
+
+    while( parcours )
+    {
+        /*printf("LE NOM EST %s\n",parcours->var->v_nomvar);*/
+        /* looking in List_Global_Var                                           */
+        out = 0;
+        parcours1 = List_Global_Var;
+
+        while ( parcours1 && out == 0 )
+        {
+            if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)         &&
+                 !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+                 !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
+            {
+                out = 1;
             }
-         else parcours1 = parcours1->suiv;
-      }
-//      }      
-
-      /* if variable has been found                                           */
-      if ( out == 1 ) {
-      CopyRecord(parcours->var,parcours1->var);
-      }
-      /* looking in List_SubroutineDeclaration_Var                            */
-      else
-      {
-         parcours1 = List_SubroutineDeclaration_Var ;
-         out = 0;
-         while ( parcours1)
-         {
-            if ( !strcasecmp(parcours->var->v_nomvar,
-                             parcours1->var->v_nomvar)         &&
-                 !strcasecmp(parcours->var->v_subroutinename,
-                             parcours1->var->v_subroutinename) &&
-                 !strcasecmp(parcours->var->v_modulename,
-                             parcours1->var->v_modulename)
-               ) {
-
-               out = 1;
-               break;
-               }
             else parcours1 = parcours1->suiv;
-         }
-             
-         /* if variable has been found                                        */
-         if ( out == 1 ) {
-         CopyRecord(parcours->var,parcours1->var);
-        
-         }
-         else
-         {
-            parcours1 = List_Common_Var ;
+        }
+
+        /* if variable has been found                                           */
+        if ( out == 1 )
+        {
+            Merge_Variables(parcours->var,parcours1->var);
+        }
+        /* looking in List_SubroutineDeclaration_Var                            */
+        else
+        {
+            parcours1 = List_SubroutineDeclaration_Var ;
             out = 0;
-            while ( parcours1 && out == 0 )
+            while ( parcours1 )
             {
-               if ( !strcasecmp(parcours->var->v_nomvar,
-                                parcours1->var->v_nomvar)         &&
-                    !strcasecmp(parcours->var->v_subroutinename,
-                                parcours1->var->v_subroutinename) &&
-                    !strcasecmp(parcours->var->v_modulename,
-                                parcours1->var->v_modulename)
-                  ) out = 1;
-               else parcours1 = parcours1->suiv;
+                if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)                 &&
+                     !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+                     !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
+                {
+                    out = 1;
+                    break;
+                }
+                else parcours1 = parcours1->suiv;
             }
-            /* if variable has been found                                     */
-            if ( out == 1 ) {
-            CopyRecord(parcours->var,parcours1->var);       
-         }
-      }
-      }
-      parcours = parcours->suiv;
-   }
-   
+            /* if variable has been found                                        */
+            if ( out == 1 )
+            {
+                Merge_Variables(parcours->var,parcours1->var);
+            }
+            else
+            {
+                parcours1 = List_Common_Var ;
+                out = 0;
+                while ( parcours1 && out == 0 )
+                {
+                    if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)                 &&
+                         !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+                         !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
+                    {
+                        out = 1;
+                    }
+                    else parcours1 = parcours1->suiv;
+                }
+                /* if variable has been found                                     */
+                if ( out == 1 )
+                {
+                    Merge_Variables(parcours->var,parcours1->var);
+                }
+            }
+        }
+        parcours = parcours->suiv;
+    }
 }
 
@@ -696,20 +649,16 @@
    int out;
 
-   
+
    parcours = List_UsedInSubroutine_Var;
    while( parcours )
    {
       out = 0 ;
-      printf("OIEROZEIR %s %s\n",parcours->var->v_nomvar,parcours->var->v_modulename);
       if ( parcours->var->v_indicetabvars == 0 )
       {
-       printf("OIEROZEIR %s\n",parcours->var->v_nomvar);
          parcours2 = List_NameOfModuleUsed;
          while( parcours2 )
          {
-            if ( !strcasecmp(parcours2->u_cursubroutine,"") &&
-                 !strcasecmp(parcours2->u_modulename,
-                             parcours->var->v_modulename)
-               )
+            if ( !strcasecmp(parcours2->u_cursubroutine, "") &&
+                 !strcasecmp(parcours2->u_modulename, parcours->var->v_modulename) )
             {
                parcours3 = List_Global_Var;
@@ -722,11 +671,8 @@
                   else parcours3 = parcours3->suiv;
                }
-               if ( out == 1 ) CopyRecord(parcours->var,parcours3->var);
+               if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
             }
-            else if ( !strcasecmp(parcours2->u_cursubroutine,
-                             parcours->var->v_subroutinename) &&
-                 !strcasecmp(parcours2->u_modulename,
-                             parcours->var->v_modulename)
-               )
+            else if ( !strcasecmp(parcours2->u_cursubroutine, parcours->var->v_subroutinename) &&
+                      !strcasecmp(parcours2->u_modulename,    parcours->var->v_modulename) )
             {
                parcours3 = List_Global_Var;
@@ -739,5 +685,5 @@
                   else parcours3 = parcours3->suiv;
                }
-               if ( out == 1 ) CopyRecord(parcours->var,parcours3->var);
+               if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
             }
             parcours2 = parcours2->suiv;
@@ -755,5 +701,5 @@
                else parcours3 = parcours3->suiv;
             }
-            if ( out == 1 ) CopyRecord(parcours->var,parcours3->var);
+            if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
          }
          /*                                                                   */
@@ -792,5 +738,5 @@
       if ( out == 1 )
       {
-         CopyRecord(parcours->var,parcours1->var);
+         Merge_Variables(parcours->var,parcours1->var);
          strcpy(parcours->var->v_subroutinename,
                 parcours1->var->v_subroutinename);
@@ -841,5 +787,5 @@
 }
 
-int LookingForVariableInListName(listvar *listin,char *name)
+int LookingForVariableInListName(listvar *listin,const char *name)
 {
    listvar *parcours1;
@@ -860,4 +806,22 @@
 }
 
+variable *get_variable_in_list_from_name( listvar *listin, const char *name )
+{
+    listvar *parcours = listin;
+    variable *var = NULL;
+
+    while ( parcours && (!var) )
+    {
+        if ( !strcasecmp(name,parcours->var->v_nomvar) &&
+           ( !strcasecmp(subroutinename,parcours->var->v_subroutinename) ||
+             !strcasecmp(subroutinename,"") ) )
+        {
+            var = parcours->var;
+        }
+        else parcours = parcours -> suiv;
+   }
+   return var;
+}
+
 int LookingForVariableInListGlob(listvar *listin,variable *var)
 {
@@ -897,6 +861,5 @@
 void UpdateListDeclarationWithDimensionList()
 {
-   List_SubroutineDeclaration_Var = AddListvarToListvar(List_Dimension_Var,
-                                              List_SubroutineDeclaration_Var,1);
+   List_SubroutineDeclaration_Var = AddListvarToListvar(List_Dimension_Var, List_SubroutineDeclaration_Var,1);
 }
 
@@ -915,32 +878,20 @@
    listvar *parcoursprec;
    int remove;
-    
-        
+
    parcoursprec = (listvar *)NULL;
    parcours = List_UsedInSubroutine_Var;
    while ( parcours )
    {
-      /*                                                                      */
-      remove = LookingForVariableInListGlobal(List_SubroutineArgument_Var,
-                                                                 parcours->var);
+      remove = LookingForVariableInListGlobal(List_SubroutineArgument_Var,   parcours->var);
       if ( remove == 0 )
-           remove = LookingForVariableInList(List_SubroutineDeclaration_Var,
-                                                                 parcours->var);
-
+           remove = LookingForVariableInList(List_SubroutineDeclaration_Var, parcours->var);
       if ( remove == 0 )
-           remove = LookingForVariableInList(List_Parameter_Var,
-                                                                 parcours->var);
+           remove = LookingForVariableInList(List_Parameter_Var, parcours->var);
       if ( remove == 0 )
-           remove = LookingForVariableInList(List_FunctionType_Var,
-                                                                 parcours->var);
+           remove = LookingForVariableInList(List_FunctionType_Var, parcours->var);
       if ( remove == 0 )
-           remove = LookingForVariableInListGlob(List_GlobalParameter_Var,
-                                                                 parcours->var);
-      
+           remove = LookingForVariableInListGlob(List_GlobalParameter_Var, parcours->var);
       if ( remove == 0 )
-           remove = LookingForVariableInListParamGlob(
-                                    List_GlobParamModuleUsed_Var,parcours->var);
-
-  
+           remove = LookingForVariableInListParamGlob(List_GlobParamModuleUsed_Var, parcours->var);
       if ( remove == 0 )
       {
@@ -976,6 +927,4 @@
       }
    }
-   
-
 }
 
@@ -1023,5 +972,4 @@
       }
    }
-
 }
 
@@ -1032,5 +980,5 @@
    listvar *parcoursprec;
    int out ;
-           
+
    parcoursprec = (listvar *)NULL;
    parcours = List_SubroutineDeclaration_Var;
@@ -1041,8 +989,6 @@
       while ( parcours1 && out == 0 )
       {
-         if ( !strcasecmp(parcours->var->v_subroutinename,
-                          parcours1->var->v_subroutinename) &&
-              !strcasecmp(parcours->var->v_nomvar,
-                          parcours1->var->v_nomvar)
+         if ( !strcasecmp(parcours->var->v_subroutinename,parcours1->var->v_subroutinename) &&
+              !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
             ) out = 1;
          else parcours1 = parcours1->suiv;
@@ -1054,8 +1000,6 @@
          while ( parcours1 && out == 0 )
          {
-            if ( !strcasecmp(parcours->var->v_subroutinename,
-                             parcours1->var->v_subroutinename) &&
-                 !strcasecmp(parcours->var->v_nomvar,
-                             parcours1->var->v_nomvar)
+            if ( !strcasecmp(parcours->var->v_subroutinename,parcours1->var->v_subroutinename) &&
+                 !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
                ) out = 1;
             else parcours1 = parcours1->suiv;
@@ -1083,5 +1027,4 @@
       }
    }
-       
 }
 
@@ -1133,5 +1076,5 @@
                          parcours2->var->v_modulename) )
          {
-            CopyRecord(parcours->var,parcours2->var);
+            Merge_Variables(parcours->var,parcours2->var);
             /* remove var from the parcours2                                  */
             parcours2prec ->suiv = parcours2->suiv;
@@ -1160,5 +1103,5 @@
    Clean_List_UsedInSubroutine_Var();
    Clean_List_SubroutineDeclaration_Var();
-   
+
    newvar = (listvar *)NULL;
 /*   newvar = List_Common_Var;*/
@@ -1184,39 +1127,35 @@
 void ListUpdate()
 {
-   listvar *newvar;
-        
-   Update_List_Subroutine_Var(List_SubroutineArgument_Var);
-
-
-       
-   Update_List_Subroutine_Var(List_FunctionType_Var);
-   Update_List_Var(List_Parameter_Var);
-   Update_List_Var(List_Dimension_Var);
-   Update_List_Var(List_Data_Var);
-   Update_List_Var(List_Save_Var);
-   Update_List_Var(List_GlobalParameter_Var);
-   Update_List_Var(List_Common_Var);
-   Update_List_Var(List_SubroutineDeclaration_Var);
-   Update_List_Var(List_UsedInSubroutine_Var);
-   Update_List_From_Common_Var(List_UsedInSubroutine_Var);
-   Update_List_From_Common_Var(List_SubroutineDeclaration_Var);
-   Update_NotGridDepend_Var(List_NotGridDepend_Var);
-    
-   newvar =(listvar * )NULL;
-/*   newvar = List_Common_Var;*/
-/*   newvar = List_UsedInSubroutine_Var;*/
-/*   newvar = List_Data_Var;*/
-   while ( newvar )
-   {
-      printf("++++ %s - %d - %s - %s - %s - %s\n",
-      newvar->var->v_nomvar,
-      newvar->var->v_VariableIsParameter,
-      newvar->var->v_subroutinename,
-      newvar->var->v_modulename,
-      newvar->var->v_typevar,
-      newvar->var->v_initialvalue      
-            );
-      newvar = newvar->suiv;
-   }
+    listvar *newvar;
+
+    Update_List_Subroutine_Var(List_SubroutineArgument_Var);
+    Update_List_Subroutine_Var(List_FunctionType_Var);
+    Update_List_Var(List_Parameter_Var);
+    Update_List_Var(List_Dimension_Var);
+    Update_List_Var(List_Data_Var);
+    Update_List_Var(List_Save_Var);
+    Update_List_Var(List_GlobalParameter_Var);
+    Update_List_Var(List_Common_Var);
+    Update_List_Var(List_SubroutineDeclaration_Var);
+    Update_List_Var(List_UsedInSubroutine_Var);
+    Update_List_From_Common_Var(List_UsedInSubroutine_Var);
+    Update_List_From_Common_Var(List_SubroutineDeclaration_Var);
+    Update_NotGridDepend_Var(List_NotGridDepend_Var);
+
+    newvar = (listvar * ) NULL;
+//   newvar = List_Common_Var;
+//   newvar = List_UsedInSubroutine_Var;
+//   newvar = List_Data_Var;
+    while ( newvar )
+    {
+        printf("++++ %s - %s - %s - %d - %s - %s\n",
+                newvar->var->v_modulename,
+                newvar->var->v_subroutinename,
+                newvar->var->v_nomvar,
+                newvar->var->v_VariableIsParameter,
+                newvar->var->v_typevar,
+                newvar->var->v_initialvalue );
+        newvar = newvar->suiv;
+    }
 }
 
@@ -1273,5 +1212,5 @@
       parcours = parcours -> suiv ;
    }
-       
+
 }
 
@@ -1284,5 +1223,5 @@
    int position;
    int out;
-   char name_sub[LONG_C];
+   char name_sub[LONG_M];
 
    parcours = List_SubroutineArgument_Var;
@@ -1343,5 +1282,5 @@
       parcours = parcours->suiv;
    }
-       
+
 }
 
@@ -1364,5 +1303,5 @@
    parcoursprec = (listvar *)NULL;
 
-   if ( mark == 1 ) printf("MODULE Treated %s \n",nom);
+   if ( todebug == 1 ) printf("MODULE Treated %s \n",nom);
 
    List_ModuleUsed_Var = (listvar *)NULL;
@@ -1389,5 +1328,5 @@
          if ( out == 1 )
          {
-            CopyRecord(parcours->var,parcours1->var);
+            Merge_Variables(parcours->var,parcours1->var);
             /* Remove this variable from the List_ModuleUsed_Var              */
             if ( parcours1 == List_ModuleUsed_Var )
@@ -1405,18 +1344,20 @@
          /* if we do not found the var Module name in the old list            */
          {
-            if ( Listofavailableindices )
-            {
-               parcours->var->v_indicetabvars = Listofavailableindices ->
-                                                                       i_indice;
-               if ( Listofavailableindices->suiv )
-                          Listofavailableindices = Listofavailableindices->suiv;
-               else
-                          Listofavailableindices = (listindice *)NULL;
-            }
-            else
-            {
-               indicemaxtabvars = indicemaxtabvars + 1 ;
-               parcours->var->v_indicetabvars = indicemaxtabvars;
-            }
+  //       update_indicemaxtabvars(parcours->var,Listofavailableindices);
+         update_indicemaxtabvars(parcours->var,Listofavailableindices_glob);
+  //          if ( Listofavailableindices )
+  //          {
+  //             parcours->var->v_indicetabvars = Listofavailableindices ->
+  //                                                                     i_indice;
+  //             if ( Listofavailableindices->suiv )
+  //                        Listofavailableindices = Listofavailableindices->suiv;
+  //             else
+  //                        Listofavailableindices = (listindice *)NULL;
+  //          }
+  //          else
+  //          {
+  //             indicemaxtabvars = indicemaxtabvars + 1 ;
+  //             parcours->var->v_indicetabvars = indicemaxtabvars;
+  //          }
          }
       }
@@ -1428,8 +1369,8 @@
   while ( parcours1 )
   {
-     newindice=(listindice *) malloc (sizeof (listindice));
+     newindice=(listindice *) calloc(1,sizeof(listindice));
      newindice -> i_indice = parcours1 -> var -> v_indicetabvars;
-     newindice -> suiv = Listofavailableindices;
-     Listofavailableindices = newindice;
+     newindice -> suiv = Listofavailableindices_glob[parcours1 -> var -> v_catvar];
+     Listofavailableindices_glob[parcours1 -> var -> v_catvar] = newindice;
      parcours1 = parcours1->suiv;
   }
@@ -1444,5 +1385,5 @@
    listvar *parcours;
 
-   if ( mark == 1 ) printf("MODULE No Treated %s \n",nom);
+   if ( todebug == 1 ) printf("MODULE No Treated %s \n",nom);
 
    parcours = List_Global_Var;
@@ -1454,6 +1395,6 @@
           )
       {
-         indicemaxtabvars = indicemaxtabvars + 1 ;
-         parcours->var->v_indicetabvars = indicemaxtabvars;
+         indicemaxtabvars[parcours->var->v_catvar] = indicemaxtabvars[parcours->var->v_catvar] + 1 ;
+         parcours->var->v_indicetabvars = indicemaxtabvars[parcours->var->v_catvar];
       }
       parcours = parcours->suiv;
@@ -1474,5 +1415,5 @@
       {
          strcpy(parcours->var->v_commoninfile,record->var->v_commoninfile);
-         CopyRecord(parcours->var,record->var);
+         Merge_Variables(parcours->var,record->var);
       }
       parcours = parcours -> suiv;
@@ -1490,5 +1431,4 @@
 {
    listvar *parcours;
-   listvar *parcoursprec;
    listvar *parcours1;
    listvar *List_CommonUsed_Var;
@@ -1496,7 +1436,5 @@
    int out;
 
-   parcoursprec = (listvar *)NULL;
-
-   if ( mark == 1 ) printf("COMMON Treated %s \n",nom);
+   if ( todebug == 1 ) printf("COMMON Treated %s \n",nom);
 
    List_CommonUsed_Var = (listvar *)NULL;
@@ -1518,5 +1456,4 @@
             else
             {
-               parcoursprec = parcours1 ;
                parcours1 = parcours1->suiv;
             }
@@ -1527,23 +1464,25 @@
             strcpy(parcours->var->v_commoninfile,
                    parcours1->var->v_commoninfile);
-            CopyRecord(parcours->var,parcours1->var);
+            Merge_Variables(parcours->var,parcours1->var);
          }
          else
          /* if we do not found the var common name in the old list            */
          {
-            if ( Listofavailableindices )
-            {
-               parcours->var->v_indicetabvars = Listofavailableindices ->
-                                                                       i_indice;
-               if ( Listofavailableindices->suiv )
-                          Listofavailableindices = Listofavailableindices->suiv;
-               else
-                          Listofavailableindices = (listindice *)NULL;
-            }
-            else
-            {
-               indicemaxtabvars = indicemaxtabvars + 1 ;
-               parcours->var->v_indicetabvars = indicemaxtabvars;
-            }
+    //     update_indicemaxtabvars(parcours->var,Listofavailableindices);
+         update_indicemaxtabvars(parcours->var,Listofavailableindices_glob);
+    //        if ( Listofavailableindices )
+    //        {
+    //           parcours->var->v_indicetabvars = Listofavailableindices ->
+    //                                                                   i_indice;
+    //           if ( Listofavailableindices->suiv )
+    //                      Listofavailableindices = Listofavailableindices->suiv;
+    //           else
+    //                      Listofavailableindices = (listindice *)NULL;
+    //        }
+    //        else
+    //        {
+    //           indicemaxtabvars = indicemaxtabvars + 1 ;
+    //           parcours->var->v_indicetabvars = indicemaxtabvars;
+    //        }
          }
          /* Look in the remaining list in the variable is define              */
@@ -1559,12 +1498,33 @@
      if ( parcours1 -> var -> v_indicetabvars == 0 )
      {
-        newindice=(listindice *) malloc (sizeof (listindice));
+        newindice=(listindice *) calloc(1,sizeof(listindice));
         newindice -> i_indice = parcours1 -> var -> v_indicetabvars;
-        newindice -> suiv = Listofavailableindices;
-        Listofavailableindices = newindice;
+        newindice -> suiv = Listofavailableindices_glob[parcours1 -> var -> v_catvar];
+        Listofavailableindices_glob[parcours1 -> var -> v_catvar] = newindice;
      }
      parcours1 = parcours1->suiv;
   }
 }
+
+void update_indicemaxtabvars(variable *var,listindice **Listofindices)
+{
+
+
+            if ( Listofindices[var->v_catvar] )
+            {
+               var->v_indicetabvars = Listofindices[var->v_catvar] -> i_indice;
+               if ( Listofindices[var->v_catvar]->suiv )
+                          Listofindices[var->v_catvar] = Listofindices[var->v_catvar]->suiv;
+               else
+                          Listofindices[var->v_catvar] = (listindice *)NULL;
+            }
+            else
+            {
+               indicemaxtabvars[var->v_catvar] = indicemaxtabvars[var->v_catvar] + 1 ;
+               var->v_indicetabvars = indicemaxtabvars[var->v_catvar];
+            }
+
+}
+
 /******************************************************************************/
 /*                     IndiceTabvars_Common_Var_No_Treated                    */
@@ -1577,5 +1537,5 @@
    listvar *parcours2;
 
-   if ( mark == 1 ) printf("COMMON No Treated %s \n",nom);
+   if ( todebug == 1 ) printf("COMMON No Treated %s \n",nom);
 
    parcours = List_Common_Var;
@@ -1587,6 +1547,6 @@
           )
       {
-         indicemaxtabvars = indicemaxtabvars + 1 ;
-         parcours->var->v_indicetabvars = indicemaxtabvars;
+         indicemaxtabvars[parcours->var->v_catvar] = indicemaxtabvars[parcours->var->v_catvar] + 1 ;
+         parcours->var->v_indicetabvars = indicemaxtabvars[parcours->var->v_catvar];
          parcours2 = parcours;
          while ( parcours2 )
@@ -1619,5 +1579,5 @@
    while ( parcours_nom )
    {
-      if ( Did_module_common_treaded(parcours_nom->o_nom) == 1 )
+      if ( is_dependfile_created(parcours_nom->o_nom) == 1 )
       {
          IndiceTabvars_Global_Var_Treated(parcours_nom->o_nom);
@@ -1633,5 +1593,5 @@
    while ( parcours_nom )
    {
-      if ( Did_module_common_treaded(parcours_nom->o_nom) == 1 )
+      if ( is_dependfile_created(parcours_nom->o_nom) == 1 )
       {
          IndiceTabvars_Common_Var_Treated(parcours_nom->o_nom);
@@ -1663,16 +1623,18 @@
               !strcasecmp(parcours->var->v_subroutinename,"")            &&
               parcours->var->v_VariableIsParameter == 0                  &&
-              (parcours->var->v_allocatable == 0  || !strcasecmp(parcours->var->v_typevar,"type"))      &&
+              ( parcours->var->v_allocatable == 0 || !strcasecmp(parcours->var->v_typevar,"type"))      &&
               parcours->var->v_notgrid == 0                              &&
-              ( parcours->var->v_nbdim != 0 ||
-                strcasecmp(parcours->var->v_initialvalue,"")
-              ) ) out = 1;
+              ( ( parcours->var->v_nbdim != 0 || !strcasecmp(parcours->var->v_typevar,"type") )
+              || strcasecmp(parcours->var->v_initialvalue,"") )
+            )
+         {
+            out = 1;
+         }
          else parcours = parcours -> suiv;
       }
-      if ( out == 1 )
+      if ( out )
       {
          parcours_nom->o_val = 1 ;
       }
-      /*                                                                      */
       parcours_nom = parcours_nom -> suiv;
    }
@@ -1688,5 +1650,4 @@
    while ( parcours_nom )
    {
-      /*                                                                      */
       parcours = List_Common_Var;
       out = 0 ;
@@ -1695,8 +1656,11 @@
          if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom)  &&
               strcasecmp(parcours->var->v_subroutinename,"")                &&
-              !strcasecmp(parcours->var->v_commoninfile,mainfile)           &&
-              ( parcours->var->v_nbdim != 0 ||
-                strcasecmp(parcours->var->v_initialvalue,"")
-              ) ) out = 1;
+              !strcasecmp(parcours->var->v_commoninfile,cur_filename)       &&
+              ( ( parcours->var->v_nbdim != 0 || !strcasecmp(parcours->var->v_typevar,"type") )
+              || strcasecmp(parcours->var->v_initialvalue,"") )
+            )
+         {
+            out = 1;
+         }
          else parcours = parcours -> suiv;
       }
@@ -1705,5 +1669,4 @@
          parcours_nom->o_val = 1 ;
       }
-      /*                                                                      */
       parcours_nom = parcours_nom -> suiv;
    }
@@ -1713,48 +1676,26 @@
 {
    listnom *parcours_nom;
-   char ligne[LONG_C];
-   if ( firstpass == 0 )
-   {
-      parcours_nom = List_NameOfCommon;
-      while ( parcours_nom )
-      {
-         if ( parcours_nom->o_val == 1 )
-         {
-            strcpy(ligne,"");
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "module %s",parcours_nom->o_nom);
-            tofich(fortranout,ligne,1);
-            WriteUsemoduleDeclaration(parcours_nom->o_subroutinename);
-            strcpy(ligne,"implicit none");
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "public Alloc_agrif_%s",parcours_nom->o_nom);
-            tofich(fortranout,ligne,1);
-            strcpy (ligne, "contains");
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "subroutine Alloc_agrif_%s(Agrif_Gr)",
-                                                           parcours_nom->o_nom);
-            tofich(fortranout,ligne,1);
-            strcpy(ligne,"Use Agrif_Util");
-            tofich(fortranout,ligne,1);
-            strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr");
-            tofich(fortranout,ligne,1);
-            strcpy(ligne, "INTEGER :: i");
-            tofich (fortranout, ligne,1);
-            strcpy (ligne, "\n#include \"alloc_agrif_");
-            strcat (ligne, parcours_nom->o_nom);
-            strcat (ligne, ".h\"\n");
-            fprintf(fortranout,ligne);
-            strcpy (ligne, "Return");
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "end subroutine Alloc_agrif_%s",
-                                                           parcours_nom->o_nom);
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "end module %s",parcours_nom->o_nom);
-            tofich(fortranout,ligne,1);
-            /* List all Call Alloc_agrif                                      */
-            Add_Subroutine_For_Alloc(parcours_nom->o_nom);
-         }
-         parcours_nom = parcours_nom->suiv;
-      }
+
+   parcours_nom = List_NameOfCommon;
+   while ( parcours_nom )
+   {
+      if ( parcours_nom->o_val == 1 )
+      {
+         fprintf(fortran_out, "      module %s\n\n", parcours_nom->o_nom);
+         WriteUsemoduleDeclaration(parcours_nom->o_subroutinename);
+         fprintf(fortran_out, "        implicit none\n");
+         fprintf(fortran_out, "        public :: Alloc_agrif_%s\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "      contains\n");
+         fprintf(fortran_out, "      subroutine Alloc_agrif_%s(Agrif_Gr)\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "        use Agrif_Util\n");
+         fprintf(fortran_out, "        type(Agrif_grid), pointer :: Agrif_Gr\n");
+         fprintf(fortran_out, "        integer :: i\n");
+         fprintf(fortran_out, "#include \"alloc_agrif_%s.h\"\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "      end subroutine Alloc_agrif_%s\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "      end module %s\n", parcours_nom->o_nom);
+         /* List all Call Alloc_agrif                                      */
+         Add_Subroutine_For_Alloc(parcours_nom->o_nom);
+      }
+      parcours_nom = parcours_nom->suiv;
    }
 }
@@ -1768,54 +1709,50 @@
    listvar *parcours4;
    int out;
-   char name_module[LONG_C];
+   char name_module[LONG_M];
 
    /* We should integrate allocate and pointer variables                      */
-   parcours2 = List_Allocate_Var;
-   while ( parcours2 )
-   {
-      parcours4 = List_UsedInSubroutine_Var;
-      out = 0 ;
-      while ( parcours4 && out == 0 )
-      {
-         if ( !strcasecmp(parcours2->a_nomvar,parcours4->var->v_nomvar) )
-         {
-            Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename,
-                                           parcours4->var->v_modulename);
-            out = 1;
-         }
-         else parcours4 = parcours4 -> suiv ;
-      }
-      parcours2 = parcours2->suiv;
-   }
-   /*                                                                         */
-   parcours3 = List_Pointer_Var;
-   while ( parcours3 )
-   {
-      parcours4 = List_UsedInSubroutine_Var;
-      out = 0 ;
-      while ( parcours4 && out == 0 )
-      {
-         if ( !strcasecmp(parcours3->n_name,parcours4->var->v_nomvar) )
-         {
-            Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename,
-                                           parcours4->var->v_modulename);
-            out = 1;
-         }
-         else parcours4 = parcours4 -> suiv ;
-      }
-      parcours3 = parcours3 -> suiv;
-   }
-   /*                                                                         */
-   parcours4 = List_UsedInSubroutine_Var;
-   while ( parcours4 )
-   {
-      if ( parcours4->var->v_allocatable == 1 && strcasecmp(parcours4->var->v_typevar,"type"))
-      {
-         Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename,
-                                        parcours4->var->v_modulename);
-      }
-      parcours4 = parcours4 -> suiv ;
-   }
-   /*                                                                         */
+//    parcours2 = List_Allocate_Var;
+//    while ( parcours2 )
+//    {
+//       parcours4 = List_UsedInSubroutine_Var;
+//       out = 0 ;
+//       while ( parcours4 && out == 0 )
+//       {
+//          if ( !strcasecmp(parcours2->a_nomvar,parcours4->var->v_nomvar) )
+//          {
+//             Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
+//             out = 1;
+//          }
+//          else parcours4 = parcours4 -> suiv ;
+//       }
+//       parcours2 = parcours2->suiv;
+//    }
+//
+//    parcours3 = List_Pointer_Var;
+//    while ( parcours3 )
+//    {
+//       parcours4 = List_UsedInSubroutine_Var;
+//       out = 0 ;
+//       while ( parcours4 && out == 0 )
+//       {
+//          if ( !strcasecmp(parcours3->n_name, parcours4->var->v_nomvar) )
+//          {
+//             Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
+//             out = 1;
+//          }
+//          else parcours4 = parcours4 -> suiv ;
+//       }
+//       parcours3 = parcours3 -> suiv;
+//    }
+//    parcours4 = List_UsedInSubroutine_Var;
+//    while ( parcours4 )
+//    {
+//       if ( parcours4->var->v_allocatable == 1 && strcasecmp(parcours4->var->v_typevar,"type"))
+//       {
+//          Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
+//       }
+//       parcours4 = parcours4 -> suiv ;
+//    }
+
    parcours = List_SubroutineWhereAgrifUsed;
    while ( parcours )
@@ -1833,11 +1770,10 @@
             if ( !strcasecmp(parcours->o_nom,parcours1->u_cursubroutine) )
             {
-               strcpy(name_module,parcours->o_module);
+               strcpy(name_module, parcours->o_module);
             }
             parcours1 = parcours1->suiv;
          }
       }
-      /* if out == 0 we should look in the module declaration                 */
-      if ( out == 0 )
+      if ( out == 0 )   /* we should look in the module declaration */
       {
          parcours1 = List_NameOfModuleUsed;
@@ -1853,5 +1789,5 @@
       }
       if ( out == 0 ) parcours->o_val = 1;
-      /*                                                                      */
+
       parcours = parcours->suiv;
    }
@@ -1876,15 +1812,10 @@
 }
 
-void Affiche()
-{
-   listvar *parcours;
-
-   parcours = (listvar *)NULL;
+void Affiche(listvar *in_parcours)
+{
 /*   parcours = List_Global_Var;                  */
 /*   parcours = List_SubroutineDeclaration_Var;   */
-
 /*   parcours = List_SubroutineArgument_Var;      */
 /*   parcours = List_FunctionType_Var;            */
-
 /*   parcours = List_Data_Var;                    */
 /*   parcours = List_Save_Var;                    */
@@ -1893,34 +1824,33 @@
 /*   parcours = List_GlobalParameter_Var;         */
 /*   parcours = List_NotGridDepend_Var;           */
-
 /*   parcours = List_Common_Var;                  */
+   listvar *parcours = in_parcours;
 
    while( parcours )
    {
-      printf("module- %s \n",parcours->var->v_modulename);
-      printf("subroutine- %s  \n",parcours->var->v_subroutinename);
-      printf("nom- %s  \n",parcours->var->v_nomvar);
-      printf("common- %s  \n",parcours->var->v_commonname);
-      printf("type- %s  \n",parcours->var->v_typevar);
-      printf("indice- %d  \n",parcours->var->v_indicetabvars);
-      printf("variableisparameter- %d \n",parcours->var->v_VariableIsParameter);
-      printf("module1- %d  \n",parcours->var->v_module);
-      printf("save- %d  \n",parcours->var->v_save);
-      printf("notgrid- %d  \n",parcours->var->v_notgrid);
-      printf("nbdim- %d  \n",parcours->var->v_nbdim);
-      printf("common1- %d  \n",parcours->var->v_common);
-      printf("v_dimensiongiven- %d  \n",parcours->var->v_dimensiongiven);
-      printf("v_dimsempty- %d  \n",parcours->var->v_dimsempty);
-      printf("initialvalue- %s\n \n",parcours->var->v_initialvalue);
-      printf("dim- %s\n \n",parcours->var->v_readedlistdimension);
+      printf("modulename     - %s \n", parcours->var->v_modulename);
+      printf("subroutinename - %s \n", parcours->var->v_subroutinename);
+      printf("nomvar         - %s \n", parcours->var->v_nomvar);
+      printf("commonname     - %s \n", parcours->var->v_commonname);
+      printf("commoninfile   - %s \n", parcours->var->v_commoninfile);
+      printf("typevar        - %s \n", parcours->var->v_typevar);
+      printf("catvar         - %d \n", parcours->var->v_catvar);
+      printf("indicetabvars  - %d \n", parcours->var->v_indicetabvars);
+      printf("isparameter    - %d \n", parcours->var->v_VariableIsParameter);
+      printf("module         - %d \n", parcours->var->v_module);
+      printf("save           - %d \n", parcours->var->v_save);
+      printf("notgrid        - %d \n", parcours->var->v_notgrid);
+      printf("nbdim          - %d \n", parcours->var->v_nbdim);
+      printf("common         - %d \n", parcours->var->v_common);
+      printf("dimensiongiven - %d \n", parcours->var->v_dimensiongiven);
+      printf("dimsempty      - %d \n", parcours->var->v_dimsempty);
+      printf("initialvalue   - %s \n", parcours->var->v_initialvalue);
+      printf("readedlistdim  - %s \n", parcours->var->v_readedlistdimension);
+      printf("-------------------------------------\n");
 
       parcours = parcours -> suiv ;
    }
-   if ( mark == 1 ) printf("Indicemaxtabvars = %d \n",indicemaxtabvars);
-   
-}
-
-
-
+   if ( todebug == 1 ) printf("Indicemaxtabvars = %d \n",indicemaxtabvars[0]);
+}
 
 int SubInList_ContainsSubroutine()
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c	(revision 6808)
@@ -41,18 +41,7 @@
 /*                      Add_SubroutineArgument_Var_1                          */
 /******************************************************************************/
-/* Firstpass 1                                                                */
-/* We should complete the                                                     */
-/******************************************************************************/
-/*                                                                            */
-/*                                                                            */
-/******************************************************************************/
 void Add_SubroutineArgument_Var_1(listvar *listtoadd)
 {
-
-   if ( firstpass == 1 )
-   {
-       List_SubroutineArgument_Var = AddListvarToListvar
-                              (listtoadd,List_SubroutineArgument_Var,1);
-   }
+    List_SubroutineArgument_Var = AddListvarToListvar(listtoadd, List_SubroutineArgument_Var, 1);
 }
 
@@ -60,46 +49,30 @@
 /*                             Add_FunctionType_Var_1                         */
 /******************************************************************************/
-/* Firstpass 1                                                                */
-/* We should complete the                                                     */
-/******************************************************************************/
-/*                                                                            */
-/*                                                                            */
-/******************************************************************************/
-void Add_FunctionType_Var_1(char *nom)
+void Add_FunctionType_Var_1(const char *nom)
 {
-   listvar *newvar;
+    listvar *newvar;
 
-   if ( firstpass == 1 )
-   {
-      curvar=createvar(nom,NULL);
-      strcpy(curvar->v_typevar,DeclType);
-      newvar = insertvar(NULL,curvar);
-      List_FunctionType_Var = AddListvarToListvar
-                              (newvar,List_FunctionType_Var,1);
-   }
+    curvar = createvar(nom, NULL);
+    strcpy(curvar->v_typevar, DeclType);
+    newvar = insertvar(NULL, curvar);
+    List_FunctionType_Var = AddListvarToListvar(newvar,List_FunctionType_Var,1);
 }
-
 
 /******************************************************************************/
 /*                      Add_SubroutineDeclaration_Var_1                       */
 /******************************************************************************/
-/* Firstpass 1                                                                */
 /* We should complete the listvarofsubroutine                                 */
 /******************************************************************************/
-/*                                                                            */
-/*                                                                            */
-/******************************************************************************/
-void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd)
-{
-   if ( firstpass == 1 )
-   {
-      if ( VariableIsParameter == 0 &&
-           SaveDeclare         == 0 )
-      {
-         listduplicated = (listvar *)NULL;
-         duplicatelistvar(listtoadd);
-         List_SubroutineDeclaration_Var = AddListvarToListvar
-                              (listduplicated,List_SubroutineDeclaration_Var,1);
-      }
-   }
-}
+// void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd)
+// {
+//    if ( firstpass == 1 )
+//    {
+//       if ( VariableIsParameter == 0 &&
+//            SaveDeclare         == 0 )
+//       {
+//          listduplicated = (listvar *)NULL;
+//          duplicatelistvar(listtoadd);
+//          List_SubroutineDeclaration_Var = AddListvarToListvar(listduplicated,List_SubroutineDeclaration_Var,1);
+//       }
+//    }
+// }
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c	(revision 6808)
@@ -43,60 +43,30 @@
 /* This subroutine is used to write the string s into the fileout             */
 /******************************************************************************/
-void tofich_reste (FILE * filout, char *s,int returnlineornot)
+void tofich_reste (FILE * filout, const char *s, int do_returnline)
 {
-  char temp[61];
-  char *tmp;
-  int size;
-  int val_min;
+    const size_t line_length = 66;
+    char temp[line_length+1];
+    size_t s_length;
 
-  if (strlen (s) <= 60)
+    s_length = strlen(s);
+
+    if ( !strcmp(&s[strlen(s)-1], "\n") )
+        s_length = strlen(s)-1;
+
+    if ( s_length <= line_length )
     {
-      if ( returnlineornot == 0 ) fprintf (filout, "     &%s", s);
-      else if ( returnlineornot == 2 ) fprintf (filout, "&%s", s);
-      else if ( returnlineornot == 3 ) fprintf (filout, "&%s\n", s);
-      else                             fprintf (filout, "     &%s\n", s);
-      if ( returnlineornot == 0 ||
-           returnlineornot == 2 ) colnum=colnum+strlen(s)+6;
-      else colnum=0;
+        if ( do_returnline ) fprintf(filout, "     &%s\n", s);
+        else                 fprintf(filout, "&%s", s);
     }
-  else
+    else
     {
-      val_min = 60;
-      strncpy (temp, s, 60);
-      strcpy (&temp[60], "\0");
+        strncpy(temp, s, line_length);
+        temp[line_length] = '\0';
+        if ( retour77 == 0 && (s_length-strlen(temp) > 0) )
+                fprintf(filout, "     &%s&\n", temp);
+        else    fprintf(filout, "     &%s\n", temp);
 
-      tmp = strrchr(temp, '+');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '-');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '/');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '*');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '%');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, ',');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, ')');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '(');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-
-      size = val_min;
-
-      strcpy (&temp[60-size], "\0");
-
-      if ( retour77 == 0 ) fprintf (filout, "     &%s&\n", temp);
-      else fprintf (filout, "     &%s\n", temp);
-      colnum=0;
-      tofich_reste (filout, (char *) &s[60-size],returnlineornot);
+        if ( s_length-strlen(temp) > 0 )
+            tofich_reste(filout, (char *) &s[line_length], do_returnline);
     }
 }
@@ -107,60 +77,29 @@
 /* This subroutine is used to write the string s into the fileout             */
 /******************************************************************************/
-void tofich (FILE * filout, char *s, int returnlineornot)
+void tofich (FILE * filout, const char *s, int do_returnline)
 {
-  char temp[61];
-  char *tmp;
-  int size;
-  int val_min;
+    const size_t line_length = 66;
+    char temp[line_length+1];
+    size_t s_length;
 
-  if (strlen (s) <= 60)
+    s_length = strlen(s);
+
+    if ( !strcmp(&s[strlen(s)-1], "\n") )
+        s_length = strlen(s)-1;
+
+    if ( s_length <= line_length )
     {
-      if ( returnlineornot == 0 ) fprintf (filout, "      %s", s);
-      else if ( returnlineornot == 2 ) fprintf (filout, "%s", s);
-      else if ( returnlineornot == 3 ) fprintf (filout, "%s\n", s);
-      else                             fprintf (filout, "      %s\n", s);
-      if ( returnlineornot == 0 || returnlineornot == 2 )
-                                                      colnum=colnum+strlen(s)+6;
-      else colnum=0;
+        if ( do_returnline ) fprintf(filout, "      %s\n", s);
+        else                 fprintf(filout, "%s", s);
     }
-  else
+    else
     {
-      val_min = 60;
-      strncpy (temp, s, 60);
-      strcpy (&temp[60], "\0");
+        strncpy(temp, s, line_length);
+        temp[line_length] = '\0';
 
-      tmp = strrchr(temp, '+');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '-');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '/');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '*');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '%');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, ',');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, ')');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '(');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+        if ( retour77 == 0 )    fprintf(filout, "      %s&\n", temp);
+        else                    fprintf(filout, "      %s\n", temp);
 
-      size = val_min;
-
-      strcpy (&temp[60-size], "\0");
-
-      if ( retour77 == 0 ) fprintf (filout, "      %s&\n", temp);
-      else fprintf (filout, "      %s\n", temp);
-      colnum=0;
-      tofich_reste (filout, (char *) &s[60-size], returnlineornot);
+        tofich_reste(filout, (char *) &s[line_length], do_returnline);
     }
 }
@@ -173,49 +112,21 @@
 void tofich_blanc (FILE * filout, int size)
 {
-  int i;
+    const char* empty_char = " ";
+    int i = 0;
 
-  if (size <= 65) fprintf (filout, "%*s\n",size,EmptyChar);
-  else
-  {
-      i=0;
-      do
-      {
-         fprintf (filout, "%*s\n",65,EmptyChar);
-         i = i+1;
-      } while ( i <= size / 65 );
-         fprintf (filout, "%*s\n",size%65,EmptyChar);
-  }
+    if (size <= 65)
+        fprintf(filout, "%*s\n", size, empty_char);
+    else
+    {
+        do
+        {
+            fprintf(filout, "%*s\n", 65, empty_char);
+            i++;
+        }
+        while ( i <= size / 65 );
 
+        fprintf(filout, "%*s\n", size%65, empty_char);
+    }
 }
-/******************************************************************************/
-/*                       tofich_line                                          */
-/******************************************************************************/
-/* This subroutine is used to write size blank into the fileout               */
-/******************************************************************************/
-void tofich_line (FILE * filout, int size, int long position)
-{
-  int i;
-  int retour;
-
-  if (size <= 65) fprintf (filout, "%*s",size,EmptyChar);
-  else
-  {
-      i=0;
-      do
-      {
-         fprintf (filout, "%*s",65,EmptyChar);
-         i = i+1;
-      } while ( i <= size / 65 );
-         fprintf (filout, "%*s",size%65,EmptyChar);
-  }
-
-   if ( !strstr(motparse1,"\n") ) retour=0;
-   else retour=1;
-
-   fseek(filout,position,SEEK_SET);
-   if (retour == 1 ) fprintf (filout, "\n");
-
-}
-
 
 /******************************************************************************/
@@ -224,14 +135,12 @@
 /* This subroutine is used to remove a sentence in the file filout            */
 /******************************************************************************/
-void RemoveWordSET_0(FILE * filout, long int position, long int sizetoremove)
+void RemoveWordSET_0(FILE * filout, long int position, int sizetoremove)
 {
-   if ( firstpass == 0 && couldaddvariable == 1 )
-   {
-      fseek(filout,position,SEEK_SET);
-      tofich_line(filout,sizetoremove,position);
+    if ( inside_type_declare || firstpass ) return;
 
-   }
+    fseek(filout, position, SEEK_SET);
+    tofich_blanc(filout, sizetoremove);
+    fseek(filout, position, SEEK_SET);
 }
-
 
 /******************************************************************************/
@@ -240,11 +149,11 @@
 /* This subroutine is used to remove a sentence in the file filout            */
 /******************************************************************************/
-void RemoveWordCUR_0(FILE * filout, long int position, long int sizetoremove)
+void RemoveWordCUR_0(FILE * filout, int sizetoremove)
 {
-   if ( firstpass == 0  && couldaddvariable == 1 )
-   {
-      fseek(filout,position,SEEK_CUR);
-      tofich_blanc(filout,sizetoremove);
+    if ( inside_type_declare || firstpass ) return;
 
-   }
+    fseek(filout, (long int)(-sizetoremove), SEEK_CUR);
+    tofich_blanc(filout, sizetoremove);
+    fseek(filout, (long int)(-sizetoremove), SEEK_CUR);
+    if ( strstr(fortran_text, "\n") )   fprintf(filout, "\n");
 }
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c	(revision 6808)
@@ -50,60 +50,59 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteBeginDeclaration(variable *v,char ligne[LONG_4C], int visibility)
-{
-  char tmpligne[LONG_4C];
+void WriteBeginDeclaration(variable *v, char line[LONG_M], int visibility)
+{
+  char tmpligne[LONG_M];
+  int precision_given ;
 
   if ( !strcasecmp(v->v_typevar,"") )
   {
-     printf("WARNING : The type of the variable %s \n",v->v_nomvar);
-     printf("          is unknown. CONV should define a type\n");
-  }
-  
-  sprintf (ligne, "%s", v->v_typevar);
-  if ( v->v_c_star == 1 ) strcat(ligne,"*");
-  
+     printf("# WARNING : The type of the variable %s is unknown.\n", v->v_nomvar);
+     printf("#           CONV should define a type\n");
+  }
+
+  sprintf(line, "%s", v->v_typevar);
+  if ( v->v_c_star == 1 ) strcat(line, "*");
+
   /* We should give the precision of the variable if it has been given        */
+  precision_given = 0;
   if ( strcasecmp(v->v_precision,"") )
   {
-     sprintf(tmpligne,"(%s)",v->v_precision);
-     Save_Length(tmpligne,49);
-     strcat(ligne,tmpligne);
-  }
-  
+     sprintf(tmpligne, "(%s)", v->v_precision);
+     Save_Length(tmpligne, 49);
+     strcat(line, tmpligne);
+     precision_given = 1;
+  }
+
   if (strcasecmp(v->v_dimchar,""))
   {
      sprintf(tmpligne,"(%s)",v->v_dimchar);
-     Save_Length(tmpligne,49);
-     strcat(ligne,tmpligne);
-  }
-  
-  if ( strcasecmp(v->v_nameinttypename,"") )
+     Save_Length(tmpligne, 49);
+     strcat(line,tmpligne);
+  }
+
+  if ((precision_given == 0) && ( strcasecmp(v->v_nameinttypename,"") ))
   {
      sprintf(tmpligne,"*%s",v->v_nameinttypename);
-     Save_Length(tmpligne,49);
-     strcat(ligne,tmpligne);
+     Save_Length(tmpligne, 49);
+     strcat(line,tmpligne);
   }
   if (strcasecmp (v->v_IntentSpec, ""))
   {
-     sprintf(tmpligne,",INTENT(%s) ",v->v_IntentSpec);
-     Save_Length(tmpligne,49);
-     strcat(ligne,tmpligne);
-  }
-  if ( v->v_VariableIsParameter == 1 ) strcat(ligne, ", PARAMETER");
-  if (visibility == 1)
-  {
-  if ( v->v_PublicDeclare       == 1 ) strcat(ligne, ", PUBLIC");
-  if ( v->v_PrivateDeclare      == 1 ) strcat(ligne, ", PRIVATE");
-  }
-  if ( v->v_ExternalDeclare     == 1 ) strcat(ligne, ", EXTERNAL");
-  if ( v->v_allocatable         == 1)
-       {strcat(ligne,", ALLOCATABLE");
-       }
-  if ( v->v_target         == 1)
-       {strcat(ligne,", TARGET");
-       }
-  if ( v->v_optionaldeclare     == 1 ) strcat(ligne,", OPTIONAL");
-  if ( v->v_pointerdeclare      == 1 ) strcat(ligne,", POINTER");
-  Save_Length(ligne,45);
+     sprintf(tmpligne,", intent(%s)", v->v_IntentSpec);
+     Save_Length(tmpligne, 49);
+     strcat(line,tmpligne);
+  }
+  if ( v->v_VariableIsParameter ) strcat(line, ", parameter");
+  if ( visibility )
+  {
+      if ( v->v_PublicDeclare  )  strcat(line, ", public");
+      if ( v->v_PrivateDeclare )  strcat(line, ", private");
+  }
+  if ( v->v_ExternalDeclare ) strcat(line, ", external");
+  if ( v->v_allocatable     ) strcat(line, ", allocatable");
+  if ( v->v_target          ) strcat(line, ", target");
+  if ( v->v_optionaldeclare ) strcat(line, ", optional");
+  if ( v->v_pointerdeclare  ) strcat(line, ", pointer");
+  Save_Length(line, 45);
 }
 
@@ -120,18 +119,17 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteScalarDeclaration(variable *v,char ligne[LONG_4C])
-{
-
-  strcat (ligne, " :: ");
-  strcat (ligne, v->v_nomvar);
-  if ( strcasecmp(v->v_vallengspec,"") ) strcat(ligne,v->v_vallengspec);
-  if ( v->v_VariableIsParameter == 1 )
-  {
-     strcat(ligne," = ");
-     strcat(ligne,v->v_initialvalue);
-  }
-  Save_Length(ligne,45);
-}
-
+void WriteScalarDeclaration( variable *v, char line[LONG_M])
+{
+    strcat(line, " :: ");
+    strcat(line, v->v_nomvar);
+
+    if ( strcasecmp(v->v_vallengspec, "") ) strcat(line,v->v_vallengspec);
+    if ( v->v_VariableIsParameter )
+    {
+        strcat(line," = ");
+        strcat(line, v->v_initialvalue);
+    }
+    Save_Length(line, 45);
+}
 
 /******************************************************************************/
@@ -147,48 +145,39 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteTableDeclaration(variable * v,char ligne[LONG_4C],int tmpok)
-{
-  char newname[LONG_4C];
-
-  strcat (ligne, ", Dimension(");
-
-  if ( v->v_dimensiongiven == 1 && tmpok == 1 )
-  {
-                                         strcat(ligne,v->v_readedlistdimension);
-                                         }
-  if ( v->v_dimensiongiven == 1 && tmpok == 0 )
-  {
-     strcpy(newname,ChangeTheInitalvaluebyTabvarsName
-                                  (v->v_readedlistdimension,List_Global_Var,0));
-
-     if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
-
-        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
-                                 (newname,List_Common_Var,0));
-
-     if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
-     
-        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
-                              (newname,List_ModuleUsed_Var,0));
+void WriteTableDeclaration(variable * v,char ligne[LONG_M],int tmpok)
+{
+    char newname[LONG_M];
+
+    strcat (ligne, ", dimension(");
+
+    if ( v->v_dimensiongiven == 1 && tmpok == 1 )   strcat(ligne,v->v_readedlistdimension);
+    if ( v->v_dimensiongiven == 1 && tmpok == 0 )
+    {
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(v->v_readedlistdimension,List_Global_Var));
         if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
 
-     Save_Length(newname,47);
-     strcat(ligne,newname);
-  }
-  strcat (ligne, ")");
-  strcat (ligne, " :: ");
-  strcat (ligne, v->v_nomvar);
-  if ( strcasecmp(vallengspec,"") ) strcat(ligne,v->v_vallengspec);
-
-  if ( v->v_VariableIsParameter == 1 )
-  {
-     strcat(ligne," = ");
-     strcat(ligne,v->v_initialvalue);
-  }
-  Save_Length(ligne,45);
-}
-
-/******************************************************************************/
-/*                        writevardeclaration                                 */
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_Common_Var));
+        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
+
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_ModuleUsed_Var));
+        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
+
+        Save_Length(newname,47);
+        strcat(ligne,newname);
+    }
+    strcat(ligne, ") :: ");
+    strcat(ligne, v->v_nomvar);
+    if ( strcasecmp(vallengspec,"") ) strcat(ligne,v->v_vallengspec);
+
+    if ( v->v_VariableIsParameter == 1 )
+    {
+        strcat(ligne," = ");
+        strcat(ligne,v->v_initialvalue);
+    }
+    Save_Length(ligne,45);
+}
+
+/******************************************************************************/
+/*                        WriteVarDeclaration                                 */
 /******************************************************************************/
 /* This subroutine is used to write the initial declaration in the file       */
@@ -201,216 +190,228 @@
 /*                                                                            */
 /******************************************************************************/
-void writevardeclaration (listvar * var_record, FILE *fileout, int value, int visibility)
+void WriteVarDeclaration( variable *v, FILE *fileout, int value, int visibility )
 {
   FILE *filecommon;
+  char ligne[LONG_M];
+
+  filecommon = fileout;
+
+  if ( v->v_save == 0 || inmodulemeet == 0 )
+  {
+     WriteBeginDeclaration(v, ligne, visibility);
+
+     if ( v->v_nbdim == 0 )
+        WriteScalarDeclaration(v, ligne);
+     else
+        WriteTableDeclaration(v, ligne, value);
+
+     if ( v->v_VariableIsParameter != 1 && strcasecmp(v->v_initialvalue,"") )
+     {
+        strcat(ligne," = ");
+        strcat(ligne,v->v_initialvalue);
+     }
+     tofich(filecommon, ligne, 1);
+  }
+  else
+    printf("-- in writevardeclaration : |%s| -- MHCHECK\n", v->v_nomvar);
+  Save_Length(ligne,45);
+}
+
+
+void WriteLocalParamDeclaration(FILE* tofile)
+{
+    listvar *parcours;
+
+    parcours = List_Parameter_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
+        {
+            WriteVarDeclaration(parcours->var, tofile, 0, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+void WriteFunctionDeclaration(FILE* tofile, int value)
+{
+    listvar *parcours;
+
+    parcours = List_FunctionType_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) &&
+              strcasecmp(parcours->var->v_typevar, "") )
+        {
+            WriteVarDeclaration(parcours->var, tofile, value, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+void WriteSubroutineDeclaration(int value)
+{
+    listvar *parcours;
+    variable *v;
+
+    parcours = List_SubroutineDeclaration_Var;
+    while ( parcours )
+    {
+        v = parcours->var;
+        if ( !strcasecmp(v->v_subroutinename, subroutinename)   &&
+             (v->v_save == 0)                                   &&
+             (v->v_pointerdeclare == 0)                         &&
+             (v->v_VariableIsParameter == 0)                    &&
+             (v->v_common == 0) )
+        {
+            WriteVarDeclaration(v, fortran_out, value, 1);
+        }
+        else if ( !strcasecmp(v->v_subroutinename, subroutinename)  &&
+                  (v->v_save == 0)                                  &&
+                  (v->v_VariableIsParameter == 0)                   &&
+                  (v->v_common == 0) )
+        {
+            WriteVarDeclaration(v, fortran_out, value, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+void WriteArgumentDeclaration_beforecall()
+{
+    int position;
+    listnom *neededparameter;
+    FILE *paramtoamr;
+    listvar *parcours;
+    variable *v;
+    char ligne[LONG_M];
+
+    fprintf(fortran_out,"#include \"Param_BeforeCall_%s.h\"\n",subroutinename);
+
+    sprintf(ligne,"Param_BeforeCall_%s.h",subroutinename);
+    paramtoamr = open_for_write(ligne);
+
+    neededparameter = (listnom * )NULL;
+    position = 1;
+    parcours = List_SubroutineArgument_Var;
+
+    while ( parcours )
+    {
+        v = parcours->var;
+        if ( !strcasecmp(v->v_subroutinename, subroutinename) && (v->v_positioninblock == position) )
+        {
+            position++;
+            WriteVarDeclaration(v, fortran_out, 0, 1);
+            neededparameter = writedeclarationintoamr(List_Parameter_Var, paramtoamr,
+                                    v, v->v_subroutinename, neededparameter, subroutinename);
+            parcours = List_SubroutineArgument_Var;
+        }
+        else parcours = parcours -> suiv;
+    }
+    Save_Length(ligne,45);
+
+    // Write interface for 'Sub_Loop_machin' in 'Param_BeforeCall_machin.h' when outside a module
+    if ( IsTabvarsUseInArgument_0() && (inmodulemeet == 0) && (inprogramdeclare == 0) )
+    {
+        fprintf(paramtoamr, "      interface\n");
+        if (isrecursive) sprintf(ligne,"  recursive subroutine Sub_Loop_%s(", subroutinename);
+        else             sprintf(ligne,"  subroutine Sub_Loop_%s(", subroutinename);
+        WriteVariablelist_subloop(ligne);
+        WriteVariablelist_subloop_Def(ligne);
+        strcat(ligne,")");
+        Save_Length(ligne,45);
+        tofich(paramtoamr,ligne,1);
+
+        listusemodule *parcours_mod;
+        parcours_mod = List_NameOfModuleUsed;
+        while ( parcours_mod )
+        {
+            if ( !strcasecmp(parcours_mod->u_cursubroutine, subroutinename) )
+            {
+                fprintf(paramtoamr, "          use %s\n", parcours_mod->u_usemodule);
+            }
+            parcours_mod = parcours_mod->suiv;
+        }
+        fprintf(paramtoamr, "          implicit none\n");
+        WriteLocalParamDeclaration(paramtoamr);
+        writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var, paramtoamr);
+        writesub_loopdeclaration_tab(List_UsedInSubroutine_Var, paramtoamr);
+        WriteArgumentDeclaration_Sort(paramtoamr);
+        WriteFunctionDeclaration(paramtoamr, 1);
+
+        sprintf(ligne,"  end subroutine Sub_Loop_%s\n", subroutinename);
+        tofich(paramtoamr, ligne, 1);
+        fprintf(paramtoamr, "      end interface\n");
+    }
+    fclose(paramtoamr);
+}
+
+void WriteArgumentDeclaration_Sort(FILE* tofile)
+{
+    int position = 1;
+    listvar *parcours;
+
+    parcours = List_SubroutineArgument_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) &&
+                         parcours->var->v_positioninblock == position )
+        {
+            position = position + 1;
+            WriteVarDeclaration(parcours->var, tofile, 1, 1);
+            parcours = List_SubroutineArgument_Var;
+        }
+        else parcours = parcours -> suiv;
+    }
+
+    parcours = List_SubroutineArgument_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
+                         parcours->var->v_positioninblock == 0           &&
+                        parcours->var->v_nbdim == 0 )
+        {
+            WriteVarDeclaration(parcours->var,tofile,1,1);
+        }
+        parcours = parcours -> suiv;
+    }
+
+    parcours = List_SubroutineArgument_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
+                         parcours->var->v_positioninblock == 0           &&
+                         parcours->var->v_nbdim != 0 )
+        {
+            WriteVarDeclaration(parcours->var, tofile, 1, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+/******************************************************************************/
+/*                      writedeclarationintoamr                               */
+/******************************************************************************/
+/* This subroutine is used to write the declaration of parameters needed in   */
+/*    allocation subroutines creates in toamr.c                               */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout,
+                              variable *var , const char *commonname,
+                           listnom *neededparameter, const char *name_common)
+{
   listvar *newvar;
   variable *v;
-  char ligne[LONG_4C];
-
-  filecommon=fileout;
-  newvar = var_record;
-  
-  if ( newvar->var->v_save == 0 || inmodulemeet == 0 )
-  {
-     v = newvar->var;
-     if (mark == 1) fprintf(fileout,"222222233333333\n");
-     WriteBeginDeclaration(v,ligne,visibility);
-
-     if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne);
-     else WriteTableDeclaration(v,ligne,value);
-
-     if ( v->v_VariableIsParameter != 1 && strcasecmp(v->v_initialvalue,"") )
-     {
-        strcat(ligne," = ");
-        strcat(ligne,v->v_initialvalue);
-     }
-     
-     tofich (filecommon, ligne,1);
-     if (mark == 1) fprintf(fileout,"44444433333333\n");     
-  }
-  Save_Length(ligne,45);
-  
-}
-
-
-void WriteLocalParamDeclaration()
-{
-   listvar *parcours;
-
-   parcours = List_Parameter_Var;
-   while ( parcours )
-   {
-      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
-      {
-         writevardeclaration(parcours,fortranout,0,1);
-      }
-      parcours = parcours -> suiv;
-   }
-}
-
-void WriteFunctionDeclaration(int value)
-{
-   listvar *parcours;
-
-   parcours = List_FunctionType_Var;
-   while ( parcours )
-   {
-      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
-            strcasecmp(parcours->var->v_typevar,"")
-         )
-      {
-         writevardeclaration(parcours,fortranout,value,1);
-      }
-      parcours = parcours -> suiv;
-   }
-}
-
-void WriteSubroutineDeclaration(int value)
-{
-   listvar *parcours;
-
-   parcours = List_SubroutineDeclaration_Var;
-   while ( parcours )
-   {
-      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
-           parcours->var->v_save == 0                                  &&
-           parcours->var->v_pointerdeclare == 0                        &&
-           parcours->var->v_VariableIsParameter == 0                   &&
-           parcours->var->v_common == 0
-         )
-      {
-         writevardeclaration(parcours,fortranout,value,1);
-
-      }
-      else if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
-           parcours->var->v_save == 0                                  &&
-           parcours->var->v_VariableIsParameter == 0                   &&
-           parcours->var->v_common == 0
-              )
-      {
-         writevardeclaration(parcours,fortranout,value,1);
-
-      }
-      parcours = parcours -> suiv;
-   }
-}
-
-void WriteArgumentDeclaration_beforecall()
-{
-   int position;
-   listnom *neededparameter;
-   FILE *paramtoamr;
-   listvar *newvar;
-   char ligne[LONG_4C];
-
-   fprintf(fortranout,"#include \"Param_BeforeCall_%s.h\" \n",subroutinename);
-   /*                                                                         */
-   sprintf(ligne,"Param_BeforeCall_%s.h",subroutinename);
-   paramtoamr = associate (ligne);
-   /*                                                                         */
-   neededparameter = (listnom * )NULL;
-   /*                                                                         */
-   position = 1;
-   newvar = List_SubroutineArgument_Var;
-   while ( newvar )
-   {
-      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
-                       newvar->var->v_positioninblock == position
-         )
-      {
-         position = position + 1;
-
-         writevardeclaration(newvar,fortranout,0,1);
-         neededparameter = writedeclarationintoamr(List_Parameter_Var,
-                   paramtoamr,newvar->var,newvar->var->v_subroutinename,
-                   neededparameter,subroutinename);
-
-         newvar = List_SubroutineArgument_Var;
-      }
-      else newvar = newvar -> suiv;
-   }
-   Save_Length(ligne,45);
-   fclose(paramtoamr);
-}
-
-void WriteArgumentDeclaration_Sort()
-{
-   int position;
-   listvar *newvar;
-
-   /*                                                                         */
-   position = 1;
-   newvar = List_SubroutineArgument_Var;
-   while ( newvar )
-   {
-      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
-                       newvar->var->v_positioninblock == position
-         )
-      {
-         position = position + 1;
-
-         writevardeclaration(newvar,fortranout,1,1);
-         /*                                                                   */
-         newvar = List_SubroutineArgument_Var;
-      }
-      else newvar = newvar -> suiv;
-   }
-   /*                                                                         */
-   newvar = List_SubroutineArgument_Var;
-   while ( newvar )
-   {
-      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
-                       newvar->var->v_positioninblock == 0           &&
-                       newvar->var->v_nbdim == 0
-         )
-      {
-
-         writevardeclaration(newvar,fortranout,1,1);
-      }
-      newvar = newvar -> suiv;
-   }
-   /*                                                                         */
-   newvar = List_SubroutineArgument_Var;
-   while ( newvar )
-   {
-      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
-                       newvar->var->v_positioninblock == 0           &&
-                       newvar->var->v_nbdim != 0
-         )
-      {
-         writevardeclaration(newvar,fortranout,1,1);
-      }
-      newvar = newvar -> suiv;
-   }
-}
-
-/******************************************************************************/
-/*                      writedeclarationintoamr                               */
-/******************************************************************************/
-/* This subroutine is used to write the declaration of parameters needed in   */
-/*    allocation subroutines creates in toamr.c                               */
-/******************************************************************************/
-/*                                                                            */
-/*                                                                            */
-/******************************************************************************/
-listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout,
-                              variable *var , char commonname[LONG_C],
-                           listnom *neededparameter, char name_common[LONG_C])
-{
-  listvar *newvar;
-  variable *v;
-  char ligne[LONG_4C];
+  char ligne[LONG_M];
   int changeval;
   int out;
   int writeit;
   listnom *parcours;
-  listnom *parcoursprec;
-
-  parcoursprec = (listnom * )NULL;
 
   /* we should list the needed parameter                                      */
   if ( !strcasecmp(name_common,commonname) )
-     neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,
-                                                               neededparameter);
+     neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,neededparameter);
   /*                                                                          */
   parcours = neededparameter;
@@ -422,5 +423,5 @@
      while ( newvar && out == 0 )
      {
-     
+
         if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))
         {
@@ -443,5 +444,5 @@
      while ( newvar && out == 0 )
      {
-        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))        
+        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))
         {
            out=1;
@@ -455,6 +456,4 @@
      parcours=parcours->suiv;
    }
-  /*                                                                          */
-  tofich (fileout, "",1);
   parcours = neededparameter;
   while (parcours)
@@ -482,9 +481,9 @@
 //           v->v_allocatable = 0;
 //        }
-        WriteBeginDeclaration(v,ligne,1);
+        WriteBeginDeclaration(v, ligne, 1);
         if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne);
-        else WriteTableDeclaration(v,ligne,1);
-
-        tofich (fileout, ligne,1);
+        else WriteTableDeclaration(v, ligne, 1);
+
+        tofich(fileout, ligne, 1);
         if ( changeval == 1 )
         {
@@ -498,5 +497,5 @@
         {
            shouldincludempif = 0;
-           fprintf(fileout,"      include \'mpif.h\' \n");
+           fprintf(fileout,"      include \'mpif.h\'\n");
         }
      }
@@ -524,7 +523,7 @@
   listvar *newvar;
   variable *v;
-  char ligne[LONG_4C];
-
-  tofich (fileout, "",1);
+  char ligne[LONG_M];
+
+//   tofich (fileout, "",1);
   newvar = deb_common;
 
@@ -533,8 +532,5 @@
      if ( newvar->var->v_nbdim == 0 &&
           !strcasecmp(newvar->var->v_subroutinename,subroutinename)  &&
-/*RB*/
-           (newvar->var->v_pointerdeclare == 0  || !strcasecmp(newvar->var->v_typevar,"type"))  
-/*RBend*/
-         )
+           (newvar->var->v_pointerdeclare == 0 || !strcasecmp(newvar->var->v_typevar,"type")) )
      {
         v = newvar->var;
@@ -565,19 +561,16 @@
   listvar *newvar;
   variable *v;
-  char ligne[LONG_4C];
+  char ligne[LONG_M];
   int changeval;
 
-  tofich (fileout, "",1);
   newvar = deb_common;
   while (newvar)
   {
-  printf("newvar = %s %d %s\n",newvar->var->v_nomvar,newvar->var->v_pointerdeclare,newvar->var->v_typevar);
-     if ( newvar->var->v_nbdim != 0                                 &&
-          !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
-          (newvar->var->v_pointerdeclare == 0 || !strcasecmp(newvar->var->v_typevar,"type"))
-        )
+      v = newvar->var;
+//  printf("newvar = %s %d %s\n",newvar->var->v_nomvar,newvar->var->v_pointerdeclare,newvar->var->v_typevar);
+     if ( (v->v_nbdim != 0)  && !strcasecmp(v->v_subroutinename, subroutinename) &&
+          (v->v_pointerdeclare == 0 || !strcasecmp(v->v_typevar,"type")) )
      {
         changeval = 0;
-        v = newvar->var;
         if ( v->v_allocatable == 1)
         {
@@ -595,6 +588,6 @@
         }
 
-        WriteBeginDeclaration(v,ligne,1);
-        WriteTableDeclaration(v,ligne,1);
+        WriteBeginDeclaration(v, ligne, 1);
+        WriteTableDeclaration(v, ligne, 1);
         tofich (fileout, ligne,1);
         if ( changeval >= 1 ) v->v_allocatable = 1;
@@ -606,99 +599,70 @@
 }
 
-
 void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl)
 {
-listvar *parcours;
-listvar *parcours2;
-listvar *parcours3;
-int out;
-
-if (insubroutinedeclare == 1)
-{
-parcours = listdecl;
-while (parcours)
-{
-/*
-parcours2 = List_SubroutineArgument_Var;
-out = 0;
-while (parcours2 && out == 0)
-{
-if (!strcasecmp(parcours2->var->v_subroutinename,subroutinename) && !strcasecmp(parcours2->var->v_nomvar,parcours->var->v_nomvar))
- {
- out = 1;
- }
-parcours2 = parcours2->suiv;
-}
-*/
-out = LookingForVariableInList(List_SubroutineArgument_Var,parcours->var);
-if (out == 0) out = VariableIsInListCommon(parcours,List_Common_Var);
-
-
-
-if (out == 0) out = LookingForVariableInList(List_Parameter_Var,parcours->var);
-if (out == 0) out = LookingForVariableInList(List_FunctionType_Var,parcours->var);
-if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var,parcours->var);
-
-/*
-parcours2 = List_Common_Var;
-while (parcours2 && out == 0)
-{
-if (!strcasecmp(parcours2->var->v_commoninfile,mainfile) && !strcasecmp(parcours2->var->v_nomvar,parcours->var->v_nomvar))
- {
- out = 1;
- }
-parcours2 = parcours2->suiv;
-}
-*/
-//printf("nom = %s %d %d %d\n",parcours->var->v_nomvar,out,VariableIsParameter,SaveDeclare);
-if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0) 
-
-{
-writevardeclaration(parcours,fortranout,1,1);
-}
-//if (firstpass == 1 && out == 1)
-if (firstpass == 1)
-  {
-  if (VariableIsParameter == 0 && SaveDeclare == 0)
-    {
-    List_SubroutineDeclaration_Var = insertvar(List_SubroutineDeclaration_Var,parcours->var);
-    }
-  }
-parcours = parcours->suiv;
-}
-}
+    listvar *parcours;
+    variable *v;
+    int out;
+
+    if ( insubroutinedeclare )
+    {
+        parcours = listdecl;
+        while ( parcours )
+        {
+            v = parcours->var;
+                          out = LookingForVariableInList(List_SubroutineArgument_Var, v);
+            if (out == 0) out = VariableIsInListCommon(parcours, List_Common_Var);
+            if (out == 0) out = LookingForVariableInList(List_Parameter_Var, v);
+            if (out == 0) out = LookingForVariableInList(List_FunctionType_Var, v);
+            if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var, v);
+
+            if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0)
+            {
+                WriteVarDeclaration(v, fortran_out, 1, 1);
+            }
+            if (firstpass == 1)
+            {
+                if (VariableIsParameter == 0 && SaveDeclare == 0)
+                {
+                    List_SubroutineDeclaration_Var = insertvar(List_SubroutineDeclaration_Var, v);
+                }
+            }
+            parcours = parcours->suiv;
+        }
+    }
 }
 
 void ReWriteDataStatement_0(FILE * filout)
 {
-listvar *parcours;
-int out;
-char ligne[LONG_C];
-char initialvalue[LONG_C];
-
-if (insubroutinedeclare == 1)
-{
-parcours = List_Data_Var_Cur ;
-while (parcours)
-{
-out = VariableIsInListCommon(parcours,List_Common_Var);
-if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var,parcours->var);
-
-if (out == 0)
-{
-if (strncasecmp(parcours->var->v_initialvalue,"(/",2))
-{
-strcpy(initialvalue,parcours->var->v_initialvalue);
-}
-else
-{
-strncpy(initialvalue,&parcours->var->v_initialvalue[2],strlen(parcours->var->v_initialvalue)-4);
-strcpy(&initialvalue[strlen(parcours->var->v_initialvalue)-4],"\0");
-}
-sprintf(ligne,"data %s/%s/",parcours->var->v_nomvar,initialvalue);
-tofich(filout,ligne,1);
-}
-parcours = parcours->suiv;
-}
-}
-}
+    listvar *parcours;
+    int out;
+    char ligne[LONG_M];
+    char initialvalue[LONG_M];
+
+    if (insubroutinedeclare == 1)
+    {
+        parcours = List_Data_Var_Cur ;
+        while (parcours)
+        {
+            out = VariableIsInListCommon(parcours,List_Common_Var);
+            if (out)   break;
+
+            out = LookingForVariableInListGlobal(List_Global_Var,parcours->var);
+            if (out)   break;
+
+            if (strncasecmp(parcours->var->v_initialvalue,"(/",2))
+            {
+                strcpy(initialvalue,parcours->var->v_initialvalue);
+            }
+            else
+            {
+                strncpy(initialvalue,&parcours->var->v_initialvalue[2],strlen(parcours->var->v_initialvalue)-4);
+                strcpy(&initialvalue[strlen(parcours->var->v_initialvalue)-4],"\0");
+            }
+            sprintf(ligne,"data %s/%s/",parcours->var->v_nomvar,initialvalue);
+            tofich(filout,ligne,1);
+
+            parcours = parcours->suiv;
+        }
+    }
+}
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.lex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.lex	(revision 6807)
+++ 	(revision )
@@ -1,87 +1,0 @@
-/******************************************************************************/
-/*                                                                            */
-/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
-/*                                                                            */
-/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
-/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
-/* This software is governed by the CeCILL-C license under French law and     */
-/* abiding by the rules of distribution of free software.  You can  use,      */
-/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
-/* license as circulated by CEA, CNRS and INRIA at the following URL          */
-/* "http://www.cecill.info".                                                  */
-/*                                                                            */
-/* As a counterpart to the access to the source code and  rights to copy,     */
-/* modify and redistribute granted by the license, users are provided only    */
-/* with a limited warranty  and the software's author,  the holder of the     */
-/* economic rights,  and the successive licensors  have only  limited         */
-/* liability.                                                                 */
-/*                                                                            */
-/* In this respect, the user's attention is drawn to the risks associated     */
-/* with loading,  using,  modifying and/or developing or reproducing the      */
-/* software by the user in light of its specific status of free software,     */
-/* that may mean  that it is complicated to manipulate,  and  that  also      */
-/* therefore means  that it is reserved for developers  and  experienced      */
-/* professionals having in-depth computer knowledge. Users are therefore      */
-/* encouraged to load and test the software's suitability as regards their    */
-/* requirements in conditions enabling the security of their systems and/or   */
-/* data to be ensured and,  more generally, to use and operate it in the      */
-/* same conditions as regards security.                                       */
-/*                                                                            */
-/* The fact that you are presently reading this means that you have had       */
-/* knowledge of the CeCILL-C license and that you accept its terms.           */
-/******************************************************************************/
-/* version 1.7                                                                */
-/******************************************************************************/
-%s character
-%{
-#include <math.h>
-#include <stdlib.h>
-#include <string.h>
-int line_num=1;
-extern FILE * yyin;
-#define MAX_INCLUDE_DEPTH 30
-YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
-%}
-
-COMMENT "%"
-SEPARATEUR "::"
-NIMPORTEQUOI .
-COMMENTAIRES1 {COMMENT}{NIMPORTEQUOI}*{COMMENT}
-PROBTYPE "1D"|"2D"|"3D"
-USEITEM "FIXED_GRIDS"|"ONLY_FIXED_GRIDS"|"F77"
-NAME [a-zA-Z\_][a-zA-Z0-9\_]*
-DIGIT [0-9]+
-NEXTLINE \n+[ \t]+"$"|\n+[ \t]+"&"
-%%
-parammodule return TOK_MODULEMAIN; /* name of the module                      */
-notgriddep  return TOK_NOTGRIDDEP; /* variable which are not grid dependent   */
-use         return TOK_USE;
-{COMMENTAIRES1}    {}
-{SEPARATEUR}        return TOK_SEP;
-{USEITEM}          {strcpy(yylval.na,yytext); return TOK_USEITEM;}
-{PROBTYPE}         {strcpy(yylval.na,yytext); return TOK_PROBTYPE;}
-                                   /* dimension of the problem                */
-{NAME}             {strcpy(yylval.na,yytext); return TOK_NAME;}
-;|\,|\(|\)|:|\[|\] {return (int) *yytext;}
-\n                 {line_num++;return (int) *yytext;}
-[ \t]+ ;
-%%
-
-
-int yywrap()
-{
-}
-
-
-yyerror(char *s)
-{
-if (!strcasecmp(curfile,mainfile))
-{
-   printf("Dans convert %s line %d, fichier %s\n",s,line_num,curfile);
-}
-else
-{
-   printf("Dans convert %s line %d, fichier %s\n",s,line_num,curfile);
-}
-exit(0);
-}
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.y
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.y	(revision 6807)
+++ 	(revision )
@@ -1,450 +1,0 @@
-/******************************************************************************/
-/*                                                                            */
-/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
-/*                                                                            */
-/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
-/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
-/* This software is governed by the CeCILL-C license under French law and     */
-/* abiding by the rules of distribution of free software.  You can  use,      */
-/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
-/* license as circulated by CEA, CNRS and INRIA at the following URL          */
-/* "http://www.cecill.info".                                                  */
-/*                                                                            */
-/* As a counterpart to the access to the source code and  rights to copy,     */
-/* modify and redistribute granted by the license, users are provided only    */
-/* with a limited warranty  and the software's author,  the holder of the     */
-/* economic rights,  and the successive licensors  have only  limited         */
-/* liability.                                                                 */
-/*                                                                            */
-/* In this respect, the user's attention is drawn to the risks associated     */
-/* with loading,  using,  modifying and/or developing or reproducing the      */
-/* software by the user in light of its specific status of free software,     */
-/* that may mean  that it is complicated to manipulate,  and  that  also      */
-/* therefore means  that it is reserved for developers  and  experienced      */
-/* professionals having in-depth computer knowledge. Users are therefore      */
-/* encouraged to load and test the software's suitability as regards their    */
-/* requirements in conditions enabling the security of their systems and/or   */
-/* data to be ensured and,  more generally, to use and operate it in the      */
-/* same conditions as regards security.                                       */
-/*                                                                            */
-/* The fact that you are presently reading this means that you have had       */
-/* knowledge of the CeCILL-C license and that you accept its terms.           */
-/******************************************************************************/
-/* version 1.7                                                                */
-/******************************************************************************/
-%{
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include "decl.h"
-%}
-
-%union {
-       int ival;
-       char na[LONG_C];
-       listnom * ln;
-       }
-
-%token TOK_SEP
-%token TOK_USE
-%token TOK_MODULEMAIN      /* name of the module                              */
-%token TOK_NOTGRIDDEP      /* Variable which are not grid dependent           */
-%token <na> TOK_USEITEM
-%token <na> TOK_NAME
-%token <na> TOK_PROBTYPE   /* dimension of the problem                        */
-%token ','
-%token ';'
-%token ':'
-%token '('
-%token ')'
-%token '['
-%token ']'
-%%
-input :
-      | input line
-;
-line :'\n'
-      | TOK_PROBTYPE TOK_NAME ';'                   {initdimprob(1,$2,"0","0");}
-      | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ';'      {initdimprob(2,$2, $4,"0");}
-      | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ',' TOK_NAME ';'
-                                                    {initdimprob(3,$2, $4, $6);}
-      | TOK_MODULEMAIN TOK_NAME ';'
-                             {listofmodules = Addtolistnom($2,listofmodules,0);
-                                                        Addmoduletothelist($2);}
-      | TOK_NOTGRIDDEP TOK_SEP TOK_NAME ';'       {Add_NotGridDepend_Var_1($3);}
-      | TOK_USE TOK_USEITEM ';'  {
-                                    if (!strcasecmp($2,"FIXED_GRIDS"))
-                                                                 fixedgrids=1;
-                                    if (!strcasecmp($2,"ONLY_FIXED_GRIDS"))
-                                                             onlyfixedgrids=1;
-                                 }
-      ;
-%%
-
-int main(int argc,char *argv[])
-{
-   extern FILE * yyin ;
-   FILE *dependglobaloutput;
-   int i;
-   listnom *parcours;
-   listvar *newvar;
-   int stylegiven = 0;
-   int infreegiven ;
-   int infixedgiven ;
-   int lengthmainfile;
-
-   if (argc < 2)
-   {
-       printf("usage : conv <file> [-rm] [-incdir <directory>] \n");
-       printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
-       printf(" [-convfile  <FILENAME >] -SubloopScalar -SubloopScalar1 \n");
-       printf(" [-free|-fixed]\n");
-       exit(0);
-   }
-/******************************************************************************/
-/*  1-  Variables initialization                                              */
-/******************************************************************************/
-   List_Global_Var=(listvar *)NULL;
-   List_GlobalParameter_Var=(listvar *)NULL;
-   List_Allocate_Var=(listallocate *)NULL;
-   List_Common_Var=(listvar *)NULL;
-   List_SubroutineWhereAgrifUsed=(listnom *)NULL;
-   List_Subroutine_For_Alloc=(listnom *)NULL;
-   List_Include=(listusemodule *)NULL;
-   List_NameOfModuleUsed=(listusemodule *)NULL;
-   listofmoduletmp=(listusemodule *)NULL;
-   List_SubroutineDeclaration_Var=(listvar *)NULL;
-   List_UsedInSubroutine_Var=(listvar *)NULL;
-   List_NotGridDepend_Var=(listvar *)NULL;
-   Listofavailableindices=(listindice *)NULL;
-   List_CouplePointed_Var=(listvarpointtovar *)NULL;
-   List_ModuleUsed_Var = (listvar *)NULL;
-   List_ModuleUsedInModuleUsed_Var = (listvar *)NULL;
-   List_GlobParamModuleUsed_Var = (listparameter *)NULL;
-   List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *)NULL;
-   List_SubroutineArgument_Var = (listvar *)NULL;
-   List_FunctionType_Var = (listvar *)NULL;
-   tmpuselocallist = (listusemodule *)NULL;
-   List_ContainsSubroutine = (listnom *)NULL;
-   oldfortranout = (FILE *)NULL;
-
-   strcpy(mainfile,argv[1]);
-   strcpy(nomdir,"AGRIF_INC");
-   strcpy(commondirin,".");
-   strcpy(commondirout,".");
-   strcpy(filetoparse," ");
-   strcpy(subofagrifinitgrids,"");
-   strcpy(meetagrifinitgrids,"");
-   strcpy(mpiinitvar,"");
-
-   length_last = 0 ;
-   length_first = 0 ;
-   length_v_typevar = 0 ;
-   length_v_nomvar = 0 ;
-   length_v_dimchar = 0 ;
-   length_v_modulename = 0 ;
-   length_v_commonname = 0 ;
-   length_v_vallengspec = 0 ;
-   length_v_nameinttypename = 0 ;
-   length_v_commoninfile = 0 ;
-   length_v_subroutinename = 0 ;
-   length_v_precision = 0 ;
-   length_v_IntentSpec = 0 ;
-   length_v_initialvalue = 0 ;
-   length_v_readedlistdimension = 0 ;
-   length_u_usemodule = 0 ;
-   length_u_charusemodule = 0 ;
-   length_u_cursubroutine = 0 ;
-   length_u_modulename = 0 ;
-   length_n_name = 0 ;
-   length_c_namevar = 0 ;
-   length_c_namepointedvar = 0 ;
-   length_o_nom = 0 ;
-   length_o_module = 0 ;
-   length_a_nomvar = 0 ;
-   length_a_subroutine = 0 ;
-   length_a_module = 0 ;
-   length_t_usemodule = 0 ;
-   length_t_cursubroutine = 0 ;
-   length_curfilename = 0 ;
-   length_nomfileoutput = 0 ;
-   length_motparse = 0 ;
-   length_mainfile = 0 ;
-   length_nomdir = 0 ;
-   length_commondirout = 0 ;
-   length_commondirin = 0 ;
-   length_filetoparse = 0 ;
-   length_curbuf = 0 ;
-   length_toprintglob = 0 ;
-   length_tmpvargridname = 0 ;
-   length_ligne_Subloop = 0 ;
-   length_lvargridname_toamr = 0 ;
-   length_toprint_utilagrif = 0 ;
-   length_toprinttmp_utilchar = 0 ;
-   length_ligne_writedecl = 0 ;
-   length_newname_toamr = 0 ;
-   length_newname_writedecl = 0 ;
-   length_ligne_toamr = 0 ;
-   length_tmpligne_writedecl = 0 ;
-   value_char_size = 0 ;
-   value_char_size1 = 0 ;
-   value_char_size2 = 0 ;
-   value_char_size3 = 0 ;
-   inallocate = 0;
-   infixed = 1;
-   infree  = 0;
-
-   checkexistcommon=1;
-   todebug=0;
-   onlyfixedgrids=0;
-   fixedgrids=0;
-   InAgrifParentDef = 0;
-   IndicenbmaillesX=0;
-   IndicenbmaillesY=0;
-   IndicenbmaillesZ=0;
-   created_dimensionlist = 1;
-   indicemaxtabvars = 0;   /* current indice in the table tabvars             */
-   SubloopScalar = 0;
-   todebug = 0;
-   todebugfree = 0;
-   retour77 = 1 ;
-   mark = 0 ;
-   shouldincludempif = 0 ;
-   Read_val_max();
-/******************************************************************************/
-/*  2-  Program arguments                                                     */
-/******************************************************************************/
-
-   if ((yyin=fopen(argv[1],"r"))==NULL)
-   {
-      printf("the file %s doesn't exist \n",argv[1]);
-      exit(0);
-   }
-
-   i=2;
-   while (i<argc)
-   {
-      if (!strcasecmp(argv[i],"-incdir"))
-      {
-         strcpy(nomdir,argv[i+1]);
-         i++;
-      }
-      else if (!strcasecmp(argv[i],"-comdirin")) /* input directory           */
-      {
-         strcpy(commondirin,argv[i+1]);
-         i++;
-      }
-      else if (!strcasecmp(argv[i],"-comdirout")) /* output directory         */
-      {
-         strcpy(commondirout,argv[i+1]);
-         i++;
-      }
-      else if (!strcasecmp(argv[i],"-convfile")) /* file to parse             */
-      {
-         strcpy(filetoparse,argv[i+1]);
-         i++;
-         lengthmainfile = strlen(filetoparse);
-         if (!strcasecmp(&filetoparse[lengthmainfile-4],".f90"))
-         {
-         infixed = 0;
-         infree = 1;
-         }
-         else
-         {
-         infixed = 1;
-         infree = 0;
-         }
-      }
-      else if (!strcasecmp(argv[i],"-free")) /* file to parse        */
-      {
-         stylegiven = 1;
-         infreegiven  = 1 ;
-         infixedgiven = 0;
-      }   
-      else if (!strcasecmp(argv[i],"-fixed")) /* file to parse        */
-      {
-         stylegiven = 1;
-         infreegiven  = 0;
-         infixedgiven = 1;
-      }         
-      else if (!strcasecmp(argv[i],"-SubloopScalar")) /* file to parse        */
-      {
-         SubloopScalar = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-SubloopScalar1")) /* file to parse       */
-      {
-         SubloopScalar = 2 ;
-      }
-      else if (!strcasecmp(argv[i],"-todebug")) /* file to parse       */
-      {
-         todebug = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-mark")) /* file to parse       */
-      {
-         mark = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-todebugfree")) /* file to parse       */
-      {
-         todebugfree = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-rm"))
-      {
-         checkexistcommon=0;
-      }
-      else
-      {
-         printf("Unkwon option : %s\n",argv[i]);
-         exit(0);
-      }
-      i++;
-   }
-
-   if (stylegiven == 1) 
-   {
-   infree = infreegiven;
-   infixed = infixedgiven;   
-   }
-   Save_Length(nomdir,34);
-   Save_Length(commondirout,35);
-   Save_Length(commondirin,36);
-   Save_Length(filetoparse,37);
-
-/******************************************************************************/
-/*  3-  Parsing of the  conv file <name>.in                                   */
-/******************************************************************************/
-
-   if ((yyin=fopen(argv[1],"r"))==NULL)
-   {
-       printf("the file %s doesn't exist \n",argv[1]);
-       exit(0);
-   }
-   strcpy(mainfile,argv[1]);
-   Save_Length(mainfile,33);
-
-   if ( strstr(filetoparse,".f90") ||
-        strstr(filetoparse,".F90") ) retour77 = 0;
-
-   yyparse();
-
-/******************************************************************************/
-/*  4-  Preparation of the file parsing                                       */
-/******************************************************************************/
-   if ((yyin=fopen(filetoparse,"r"))==NULL) /* Is the file to parse exist ?   */
-   {
-      printf("the file %s doesn't exist \n",filetoparse);
-      exit(0);
-   }
-   /* mainfile : the name of the file to parse                                */
-   strcpy(mainfile,filetoparse);
-   /*                                                                         */
-   if ((dependglobaloutput=fopen(".dependglobal_agrif","r"))!=NULL)
-   {
-      fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars);
-      fclose(dependglobaloutput);
-   }
-   Readthedependavailablefile();
-   /* Read the .dependnbxnby file which contains indices of nbmaillsX,        */
-   /*    nbmailleY and nbmailleZ                                              */
-   Readthedependnbxnbyfile();
-   Read_Subroutine_For_Alloc();
-/******************************************************************************/
-/*  5-  Parsing of the input file (2 times)                                   */
-/******************************************************************************/
-   /* Record all variable in list                                             */
-   firstpass = 1;
-   processfortran(filetoparse);
-   /*                                                                         */
-   CompleteThelistvarindoloop();
-   /* Read list of module used                                                */
-   RecordUseModulesVariables();
-   /* Read list of module used in module used                                 */
-   RecordUseModulesUseModulesVariables();
-   /* Save variables are considered as globals ones                           */
-   Update_List_Global_Var_From_List_Save_Var();
-   /* Update all lists                                                        */
-   ListUpdate();
-   /*                                                                         */
-   Clean_List_Global_Var();
-   /* Indice tabvars identification                                           */
-   IndiceTabvarsIdentification();
-   /* Update all lists                                                        */
-   ListUpdate();
-   /* The allocation subroutine is necessary ????                             */
-   New_Allocate_Subroutine_Is_Necessary();
-   /* The allocation subroutine is necessary for common list                  */
-   New_Allocate_Subroutine_For_Common_Is_Necessary();
-   /* Sort List_SubroutineArgument_Var                                        */
-   Sort_List_SubroutineArgument_Var();
-   /* Clean all lists                                                         */
-   ListClean();
-   /* Update Indice of List_UsedInSubroutine_Var from module used             */
-   List_UsedInSubroutine_Var_Update_From_Module_Used();
-   /* Update List_SubroutineWhereAgrifUsed                                    */
-   UpdateList_SubroutineWhereAgrifUsed();
-   /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
-   UpdateList_UsedInSubroutine_With_dimension();;
-   /*                                                                         */
-   ModifyThelistvarindoloop();
-   /*                                                                         */
-   UpdateListDeclarationWithDimensionList();
-   /*                                                                         */
-   GiveTypeOfVariables();
-   Affiche();
-   /* Build new subroutines                                                   */
-   firstpass = 0;
-   processfortran(filetoparse);
-
-   newvar = (listvar *)NULL;
-/*newvar = List_Global_Var; */
-   while ( newvar )
-   {
-      printf("++++ %s %d %s %s %s\n",
-      newvar->var->v_nomvar,
-      newvar->var->v_nbdim,
-      newvar->var->v_subroutinename,
-      newvar->var->v_modulename,
-      newvar->var->v_typevar
-             );
-      newvar = newvar->suiv;
-   }
-/******************************************************************************/
-/*  6-  Write informations in output files                                    */
-/******************************************************************************/
-
-   /* Write the .dependglobal_agrif file which contain the max indice         */
-   /*    of the tabvars table                                                 */
-   dependglobaloutput = fopen(".dependglobal_agrif","w");
-   fprintf(dependglobaloutput,"%d\n",indicemaxtabvars);
-   fclose(dependglobaloutput);
-   /* Write the list of available indice                                      */
-   Writethedependavailablefile();
-   /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
-   /*    nbmailleY and nbmailleZ                                              */
-   Writethedependnbxnbyfile();
-   /* Write the .depend<namefile> file which contain general informations     */
-   /*    about variable of this file                                          */
-   parcours = List_NameOfModule;
-   while( parcours )
-   {
-      Writethedependlistofmoduleused(parcours->o_nom);
-      WritedependParameterList(parcours->o_nom);
-      Writethedependfile(parcours->o_nom,List_Global_Var);
-      parcours=parcours->suiv;
-   }
-   parcours = List_NameOfCommon;
-   while( parcours )
-   {
-      Writethedependfile(parcours->o_nom,List_Common_Var);
-      parcours=parcours->suiv;
-   }
-   Write_Subroutine_For_Alloc();
-/******************************************************************************/
-/*  7-  Create files in AGRIF_INC directory                                   */
-/******************************************************************************/
-   creefichieramr(NameTamponfile);
-
-   Write_val_max();
-
-   if ( todebug == 1 ) printf("Out of CONV \n");
-   return 0;
-}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h	(revision 6808)
@@ -33,10 +33,10 @@
 /* version 1.7                                                                */
 /******************************************************************************/
-#define LONGNOM 8000
-
-#define LONG_C 3000
-#define LONG_4C 4000
-#define LONG_4M 4000
-#define LONG_40M 4000000
+#define LONG_VNAME 80		// Max length for a variable name
+#define LONG_FNAME 1000		// Max length for a file name
+#define LONG_C     200
+#define LONG_M     1500
+
+#define NB_CAT_VARIABLES 5
 
 /******************************************************************************/
@@ -46,6 +46,6 @@
 typedef struct
 {
-   char first[LONG_C];
-   char last[LONG_C];
+   char first[LONG_M];
+   char last[LONG_M];
 } typedim ;                /* fortran dimension as 'ndeb:nfin'                */
 
@@ -58,18 +58,18 @@
 typedef struct variable
 {
-   char v_typevar[LONG_C];
-   char v_nomvar[LONG_C] ;
-   char v_oldname[LONG_C] ;
-   char v_dimchar[LONG_C];
-   char v_modulename[LONG_C];
-   char v_commonname[LONG_C];
-   char v_vallengspec[LONG_C];
-   char v_nameinttypename[LONG_C];
-   char v_commoninfile[LONG_C];
-   char v_subroutinename[LONG_C];
+   char v_typevar[LONG_VNAME];
+   char v_nomvar[LONG_VNAME] ;
+   char v_oldname[LONG_VNAME] ;
+   char v_dimchar[LONG_VNAME];
+   char v_modulename[LONG_VNAME];
+   char v_commonname[LONG_VNAME];
+   char v_vallengspec[LONG_VNAME];
+   char v_nameinttypename[LONG_VNAME];
+   char v_commoninfile[LONG_FNAME];
+   char v_subroutinename[LONG_VNAME];
    char v_precision[LONG_C];
-   char v_initialvalue[LONG_4C];
-   char v_IntentSpec[LONG_C];
-   char v_readedlistdimension[LONG_C];
+   char v_initialvalue[LONG_M];
+   char v_IntentSpec[LONG_M];
+   char v_readedlistdimension[LONG_M];
    int  v_nbdim;
    int  v_common;
@@ -77,4 +77,5 @@
    int  v_module;
    int  v_save;
+   int  v_catvar;
    int  v_VariableIsParameter;
    int  v_PublicDeclare;
@@ -110,8 +111,8 @@
 typedef struct listusemodule
 {
-   char u_usemodule[LONG_C];
-   char u_charusemodule[LONG_C];
-   char u_cursubroutine[LONG_C];
-   char u_modulename[LONG_C];
+   char u_usemodule[LONG_VNAME];
+   char u_charusemodule[LONG_VNAME];
+   char u_cursubroutine[LONG_VNAME];
+   char u_modulename[LONG_VNAME];
    int  u_firstuse;
    struct listusemodule * suiv;
@@ -120,6 +121,6 @@
 typedef struct listparameter
 {
-   char p_name[LONG_C];
-   char p_modulename[LONG_C];
+   char p_name[LONG_M];
+   char p_modulename[LONG_M];
    struct listparameter * suiv;
 } listparameter ;           /* list of names                                  */
@@ -127,5 +128,5 @@
 typedef struct listname
 {
-   char n_name[LONG_C];
+   char n_name[LONG_VNAME];
    struct  listname* suiv;
 } listname ;            /* list of names                                  */
@@ -133,6 +134,6 @@
 typedef struct listcouple
 {
-   char c_namevar[LONG_C];
-   char c_namepointedvar[LONG_C];
+   char c_namevar[LONG_VNAME];
+   char c_namepointedvar[LONG_VNAME];
    struct listcouple * suiv;
 } listcouple;              /* list of names                                   */
@@ -142,6 +143,6 @@
 {
    char o_nom[LONG_C];
-   char o_module[LONG_C];
-   char o_subroutinename[LONG_C];
+   char o_module[LONG_VNAME];
+   char o_subroutinename[LONG_M];
    int  o_val;
    listcouple *couple;
@@ -153,6 +154,6 @@
 {
    char a_nomvar[LONG_C];
-   char a_subroutine[LONG_C];
-   char a_module[LONG_C];
+   char a_subroutine[LONG_VNAME];
+   char a_module[LONG_VNAME];
    struct listallocate * suiv;
 } listallocate ;
@@ -161,6 +162,6 @@
 typedef struct listvarpointtovar
 {
-   char t_usemodule[LONG_C];
-   char t_cursubroutine[LONG_C];
+   char t_usemodule[LONG_VNAME];
+   char t_cursubroutine[LONG_VNAME];
    listcouple *t_couple;
    struct  listvarpointtovar* suiv;
@@ -209,4 +210,5 @@
  listnom *List_Subroutine_For_Alloc;
  listnom *listofmodules;
+ listnom *listofkind;
  listnom *List_NameOfModule;
  listnom *List_NameOfCommon;
@@ -220,4 +222,5 @@
  listindice *Listofavailableindices;
                            /* List of available indices in the tabvars table  */
+ listindice **Listofavailableindices_glob;
 
  listdim *curdim;
@@ -229,6 +232,6 @@
 
  int positioninblock;
- char commonvar[LONG_C];
- char commonblockname[LONG_C];
+ char commonvar[LONG_VNAME];
+ char commonblockname[LONG_VNAME];
 
 /******************************************************************************/
@@ -239,14 +242,14 @@
  int sameagrifargument;
  int InAgrifParentDef;
- char sameagrifname[LONG_C];
+ char sameagrifname[LONG_VNAME];
 /******************************************************************************/
 /****************   *** VAR DEF Variables ***   *******************************/
 /******************************************************************************/
- int indicemaxtabvars;     /* Number of variables in the model i.e. last      */
+ int indicemaxtabvars[NB_CAT_VARIABLES];     /* Number of variables in the model i.e. last      */
                            /*    indice used in  the tabvars table            */
  int PublicDeclare;        /* Variable has been declared as PUBLIC */
  int PrivateDeclare;       /* Variable has been declared as PRIVATE */
  int ExternalDeclare;      /* Variable has been declared as EXTERNAL */
- char InitialValueGiven[LONG_C];  
+ int InitialValueGiven;    /* An initial value has been given */
  int Allocatabledeclare;
  int Targetdeclare;
@@ -255,24 +258,21 @@
  int pointerdeclare;
  int optionaldeclare;
- int VarType;
- int VarTypepar;
+ int inside_type_declare;
  int VariableIsParameter;
  int dimsgiven;
  int shouldincludempif;
  int c_star;
- char DeclType[LONG_C];
- char nameinttypename[LONG_C];
- char nameinttypenameback[LONG_C]; 
+ char DeclType[LONG_VNAME];
+ char nameinttypename[LONG_VNAME];
+ char nameinttypenameback[LONG_VNAME];
  int GlobalDeclaration;
  int GlobalDeclarationType;
- char InitValue[LONG_4C];
- char IntentSpec[LONG_C];
+ char InitValue[LONG_M];
+ char IntentSpec[LONG_M];
  char NamePrecision[LONG_C];
- char CharacterSize[LONG_C];
- char curmodulename[LONG_C];
- char vallengspec[LONG_C];
- char subroutinename[LONG_C];
+ char CharacterSize[LONG_VNAME];
+ char vallengspec[LONG_VNAME];
  int isrecursive;
- char previoussubroutinename[LONG_C];
+ int is_result_present;
 
 /******************************************************************************/
@@ -283,10 +283,8 @@
  int onlyfixedgrids;       /* = 1 if onlyfixedgrids is true                   */
  int todebug;
- int mark;
- int todebugfree;
  int fixedgrids;           /* = 1 if fixedgrids is true                       */
- char nbmaillesX[LONG_C]; /* number of cells in the x direction              */
- char nbmaillesY[LONG_C]; /* number of cells in the y direction              */
- char nbmaillesZ[LONG_C]; /* number of cells in the z direction              */
+ char nbmaillesX[LONG_VNAME];	// number of cells in the x direction
+ char nbmaillesY[LONG_VNAME];	// number of cells in the y direction
+ char nbmaillesZ[LONG_VNAME];	// number of cells in the z direction
  int IndicenbmaillesX;
  int IndicenbmaillesY;
@@ -297,9 +295,7 @@
  int aftercontainsdeclare; /* Signale si l'on vient d'un contains ou non */
  int retour77;
- int colnum;
  int callagrifinitgrids;
  int callmpiinit;
  int firstpass;
- int couldaddvariable;
  int pointedvar;
  int NbMailleXDefined;
@@ -309,7 +305,6 @@
                            /*    only                                         */
                            /*    scalar and not table u(1,1,1) in place of u  */
- int checkexistcommon;
+ int inprogramdeclare;
  int insubroutinedeclare;
- int ininterfacedeclare;
  int inmoduledeclare;
  int dimsempty;
@@ -317,32 +312,26 @@
  int incontainssubroutine;
 
- char meetagrifinitgrids[LONG_C];
- char mpiinitvar[LONG_C];
- char *NameTamponfile;
- char toprintglob[LONG_4C];
- char tmpvargridname[LONG_4C];
- char EmptyChar[2];        /* An empty char */
- char curfilename[LONG_C];
- char nomfileoutput[LONG_C];
- char curbuf[LONG_40M];
- char motparse[LONG_4C];
- char motparse1[LONG_4C];
- char charusemodule[LONG_C];
- char subofagrifinitgrids[LONG_C];
- char curfile[LONG_C];
- char mainfile[LONG_C];
- char nomdir[LONG_C];
- char commondirout[LONG_C];
- char commondirin[LONG_C];
- char filetoparse[LONG_C];
-
- FILE *fortranout;          /* Output File                                    */
- FILE *fortranin;           /* Input File                                     */
- FILE *oldfortranout;
+ char meetagrifinitgrids[LONG_M];
+ char mpiinitvar[LONG_M];
+ char toprintglob[LONG_M];
+ char tmpvargridname[LONG_M];
+ char dependfilename[LONG_FNAME];
+ char charusemodule[LONG_VNAME];
+ char subofagrifinitgrids[LONG_M];
+ char curmodulename[LONG_VNAME];
+ char subroutinename[LONG_VNAME];
+ char cur_filename[LONG_FNAME];		// Name of the current parsed Fortran file
+ char config_file[LONG_FNAME];		// Name of conv configuration file (ex: amr.in)
+ char work_dir[LONG_FNAME];			// Work directory         (default: './')
+ char include_dir[LONG_FNAME];		// Include directory      (default: './AGRIF_INC')
+ char output_dir[LONG_FNAME];		// output directory       (default: './AGRIF_MODELFILES')
+ char input_dir[LONG_FNAME];		// source input directory (default: './')
+
+ FILE *fortran_out;          /* Output File                                    */
+ FILE *fortran_in;           /* Input File                                     */
+ FILE *oldfortran_out;
  FILE *subloop;
  FILE *module_declar;
- FILE *module_declar_type;
  FILE *allocationagrif;
- FILE *paramout;
 
  long int pos_cur;         /* current position in the output file             */
@@ -359,5 +348,4 @@
  long int pos_cursave;     /* current position in the output file             */
  long int pos_curdimension;/* current position in the output file             */
- long int pos_curinit;     /* current position in the output file             */
  long int pos_curinclude;  /* final position of a line in file                */
  long int pos_end;         /* final position of a line in file                */
@@ -365,80 +353,23 @@
                            /* final position of a line in file                */
 
-/* v_oldname = v_nomvar; */
-/* commonvar = v_nomvar; */
-/* commonblockname = v_commonname;*/
-/* sameagrifname = v_nomvar ; */
-/* DeclType = v_typevar; */
-/* nameinttypename = v_nameinttypename; */
-/* IntentSpec = v_IntentSpec; */
-/* NamePrecision = v_precision; */
-/* CharacterSize = v_dimchar; */
-/* curmodulename = v_modulename; */
-/* vallengspec = v_vallengspec; */
-/* subroutinename = v_subroutinename; */
-/* meetagrifinitgrids = v_subroutinename; */
-/* nbmaillesX = v_nomvar; */
-/* nbmaillesY = v_nomvar; */
-/* nbmaillesZ = v_nomvar; */
-/* mpiinitvar = v_nomvar; */
-/* EmptyChar = 2; */
-/* motparse1 = motparse;*/
-/* charusemodule = p_modulename; */
-/* subofagrifinitgrids = v_subroutinename; */
-/* curfile = mainfile; */
-/* InitValue = v_initialvalue; */
-
-/* p_name;???????? */
-/* p_modulename; ?????????????*/
-
- int length_last;
- int length_first;
- int length_v_typevar;
- int length_v_nomvar;
- int length_v_dimchar;
- int length_v_modulename;
- int length_v_commonname;
- int length_v_vallengspec;
- int length_v_nameinttypename;
- int length_v_commoninfile;
- int length_v_subroutinename;
- int length_v_precision;
- int length_v_IntentSpec;
- int length_v_initialvalue;
- int length_v_readedlistdimension;
- int length_u_usemodule;
- int length_u_charusemodule;
- int length_u_cursubroutine;
- int length_u_modulename;
- int length_n_name;
- int length_c_namevar;
- int length_c_namepointedvar;
- int length_o_nom;
- int length_o_module;
- int length_a_nomvar;
- int length_a_subroutine;
- int length_a_module;
- int length_t_usemodule;
- int length_t_cursubroutine;
- int length_curfilename;
- int length_nomfileoutput;
- int length_motparse;
- int length_mainfile;
- int length_nomdir;
- int length_commondirout;
- int length_commondirin;
- int length_filetoparse;
- int length_curbuf;
- int length_toprintglob;
- int length_tmpvargridname;
- int length_ligne_Subloop;
- int length_lvargridname_toamr;
- int length_toprint_utilagrif;
- int length_toprinttmp_utilchar;
- int length_ligne_writedecl;
- int length_newname_toamr;
- int length_newname_writedecl;
- int length_ligne_toamr;
- int length_tmpligne_writedecl;
+size_t length_last;
+size_t length_first;
+size_t length_v_vallengspec;
+size_t length_v_commoninfile;
+size_t length_v_precision;
+size_t length_v_IntentSpec;
+size_t length_v_initialvalue;
+size_t length_v_readedlistdimension;
+size_t length_a_nomvar;
+size_t length_toprintglob;
+size_t length_tmpvargridname;
+size_t length_ligne_Subloop;
+size_t length_toprint_utilagrif;
+size_t length_toprinttmp_utilchar;
+size_t length_ligne_writedecl;
+size_t length_newname_toamr;
+size_t length_newname_writedecl;
+size_t length_ligne_toamr;
+size_t length_tmpligne_writedecl;
  int value_char_size;
  int value_char_size1;
@@ -446,5 +377,5 @@
  int value_char_size3;
 
- 
+
  int inallocate;
  int infixed;
@@ -453,12 +384,15 @@
 /*********** Declaration of externals subroutines *****************************/
 /***************************************************** ************************/
+extern char *fortran_text;
 /******************************************************************************/
 /*********** convert.y ********************************************************/
 /******************************************************************************/
 extern int main(int argc,char *argv[]);
+extern int convert_error(const char *s);
 /******************************************************************************/
 /*********** fortran.y ********************************************************/
 /******************************************************************************/
-extern void processfortran(char *fichier_entree);
+extern void process_fortran(const char *input_file);
+extern int fortran_error(const char *s);
 /******************************************************************************/
 /*********** dependfile.c *****************************************************/
@@ -466,17 +400,15 @@
 extern void Writethedependnbxnbyfile();
 extern void Readthedependnbxnbyfile();
-extern void Writethedependlistofmoduleused(char *NameTampon );
-extern void Readthedependlistofmoduleused(char *NameTampon);
-extern void WritedependParameterList(char *NameTampon );
-extern listparameter *ReaddependParameterList(char *NameTampon,
-                                                        listparameter *listout);
-extern void Writethedependfile(char *NameTampon, listvar *input );
-extern listvar *Readthedependfile( char *NameTampon , listvar *listout);
+extern void Writethedependlistofmoduleused(const char *NameTampon );
+extern void Readthedependlistofmoduleused(const char *NameTampon);
+extern void WritedependParameterList(const char *NameTampon );
+extern listparameter *ReaddependParameterList(const char *NameTampon, listparameter *listout);
+extern void Writethedependfile(const char *NameTampon, listvar *input );
+extern listvar *Readthedependfile(const char *NameTampon , listvar *listout);
 extern void Write_Subroutine_For_Alloc();
 extern void Read_Subroutine_For_Alloc();
 extern void Writethedependavailablefile();
 extern void Readthedependavailablefile();
-extern int Did_filetoparse_readed(char *NameTampon);
-extern int Did_module_common_treaded(char *NameTampon);
+extern int is_dependfile_created(const char *NameTampon);
 extern void Write_val_max();
 extern void Read_val_max();
@@ -485,23 +417,23 @@
 /******************************************************************************/
 extern void Add_Common_var_1();
-extern listnom *Addtolistnom(char *nom, listnom *listin,int value);
-extern listname *Addtolistname(char *nom,listname *input);
-extern int ModuleIsDefineInInputFile(char *name);
-extern void Addmoduletothelisttmp(char *name);
-extern void Add_NameOfModule_1(char *nom);
-extern void Add_NameOfCommon_1(char *nom,char *cursubroutinename);
-extern void Add_CouplePointed_Var_1(char *namemodule,listcouple *couple);
-extern void Add_Include_1(char *name);
+extern listnom  *Addtolistnom(const char *nom, listnom *listin, int value);
+extern listname *Addtolistname(const char *nom, listname *input);
+extern int ModuleIsDefineInInputFile(const char *name);
+extern void Addmoduletothelisttmp(const char *name);
+extern void Add_NameOfModule_1(const char *nom);
+extern void Add_NameOfCommon_1(const char *nom, const char *cursubroutinename);
+extern void Add_CouplePointed_Var_1(const char *namemodule, listcouple *couple);
+extern void Add_Include_1(const char *name);
 extern void Add_ImplicitNoneSubroutine_1();
-extern void WriteIncludeDeclaration();
-extern void Add_Save_Var_1 (char *name,listdim *d);
+extern void WriteIncludeDeclaration(FILE* tofile);
+extern void Add_Save_Var_1 (const char *name,listdim *d);
 extern void Add_Save_Var_dcl_1 (listvar *var);
 /******************************************************************************/
 /*********** SubLoopCreation.c ************************************************/
 /******************************************************************************/
-extern void writeheadnewsub_0();
-extern void WriteVariablelist_subloop(FILE *outputfile,char *ligne);
-extern void WriteVariablelist_subloop_Call(FILE *outputfile,char *ligne);
-extern void WriteVariablelist_subloop_Def(FILE *outputfile,char *ligne);
+extern void WriteBeginof_SubLoop();
+extern void WriteVariablelist_subloop(char *ligne);
+extern void WriteVariablelist_subloop_Call(char **ligne, size_t line_length);
+extern void WriteVariablelist_subloop_Def(char *ligne);
 extern void WriteHeadofSubroutineLoop();
 extern void closeandcallsubloopandincludeit_0(int suborfun);
@@ -510,82 +442,70 @@
 /*********** toamr.c **********************************************************/
 /******************************************************************************/
-extern char *variablenameroottabvars (variable * var);
-extern char *variablenametabvars (variable * var, int iorindice);
-extern char *variablecurgridtabvars (variable * var,int ParentOrCurgrid);
-extern void WARNING_CharSize(variable *var);
-extern char *vargridnametabvars (variable * var,int iorindice);
-extern char *vargridcurgridtabvars (variable * var,int ParentOrCurgrid);
-extern char *vargridcurgridtabvarswithoutAgrif_Gr (variable * var);
-extern char *vargridparam (variable * v, int whichone);
+extern void WARNING_CharSize(const variable *var);
+extern const char * tabvarsname(const variable *var);
+extern const char * variablecurgridtabvars(int which_grid);
+extern const char * vargridnametabvars(const variable *var, int iorindice);
+extern const char * vargridcurgridtabvars(const variable *var, int which_grid);
+extern const char * vargridcurgridtabvarswithoutAgrif_Gr(const variable *var);
+extern const char * vargridparam(const variable *var);
 extern void write_probdimagrif_file();
 extern void write_keysagrif_file();
 extern void write_modtypeagrif_file();
-extern void write_createvarnameagrif_file(variable *v,FILE *createvarname,
-                                                                int *InitEmpty);
+extern void write_createvarnameagrif_file(variable *v,FILE *createvarname,int *InitEmpty);
+extern void write_initialisationsagrif_file(variable *v,FILE *initproc,int *VarnameEmpty);
 extern void write_Setnumberofcells_file();
 extern void write_Getnumberofcells_file();
-extern void write_initialisationsagrif_file(variable *v,FILE *initproc,
-                                                             int *VarnameEmpty);
 extern void Write_Alloc_Agrif_Files();
 extern int IndiceInlist(int indic, listindice *listin);
 extern void write_allocation_Common_0();
 extern void write_allocation_Global_0();
-extern void creefichieramr (char *NameTampon);
+extern void creefichieramr();
 /******************************************************************************/
 /*********** UtilAgrif.c ******************************************************/
 /******************************************************************************/
-extern int Vartonumber(char *tokname);
-extern int Agrif_in_Tok_NAME(char *tokname);
-extern void ModifyTheVariableName_0(char *ident,int lengthname);
-extern void Add_SubroutineWhereAgrifUsed_1(char *sub,char *mod);
+extern int Vartonumber(const char *tokname);
+extern int Agrif_in_Tok_NAME(const char *tokname);
+extern void ModifyTheVariableName_0(const char *ident,int lengthname);
+extern void Add_SubroutineWhereAgrifUsed_1(const char *sub, const char *mod);
 extern void AddUseAgrifUtil_0(FILE *fileout);
 extern void AddUseAgrifUtilBeforeCall_0(FILE *fileout);
-extern void NotifyAgrifFunction_0(char *ident);
-extern void ModifyTheAgrifFunction_0(char *ident);
-extern void AgriffunctionModify_0(char *ident,int whichone);
-extern void Instanciation_0(char *ident);
+extern void NotifyAgrifFunction_0(const char *ident);
+extern void ModifyTheAgrifFunction_0(const char *ident);
+extern void AgriffunctionModify_0(const char *ident,int whichone);
+extern void Instanciation_0(const char *ident);
 /******************************************************************************/
 /*********** UtilCharacter.c **************************************************/
 /******************************************************************************/
-extern void FindAndChangeNameToTabvars(char name[LONG_C],char toprint[LONG_4C],
+extern void FindAndChangeNameToTabvars(const char name[LONG_M],char toprint[LONG_M],
                                              listvar * listtosee, int whichone);
-extern char *ChangeTheInitalvaluebyTabvarsName(char *nom,listvar *listtoread,
-                                                                  int whichone);
-extern int IsVariableReal(char *nom);
-extern void IsVarInUseFile(char *nom);
-extern listnom *DecomposeTheNameinlistnom(char *nom, listnom * listout);
-extern void DecomposeTheName(char *nom);
-extern void convert2lower(char *name);
-extern int convert2int(char *name);
+extern const char *ChangeTheInitalvaluebyTabvarsName(const char *nom,listvar *listtoread);
+extern int IsVariableReal(const char *nom);
+extern void IsVarInUseFile(const char *nom);
+extern listnom *DecomposeTheNameinlistnom(const char *nom, listnom * listout);
+extern void DecomposeTheName(const char *nom);
+extern void convert2lower(char *lowername, const char* inputname);
+extern int convert2int(const char *name);
 /******************************************************************************/
 /*********** UtilFile.c *******************************************************/
 /******************************************************************************/
-extern FILE * associate (char *filename);
-extern FILE * associateaplus (char *filename);
+extern FILE * open_for_write (const char *filename);
+extern FILE * open_for_append (const char *filename);
 extern long int setposcur();
 extern long int setposcurname(FILE *fileout);
-extern long int setposcurinoldfortranout();
-extern void copyuse_0(char *namemodule);
-extern void copyuseonly_0(char *namemodule);
+extern void copyuse_0(const char *namemodule);
+extern void copyuseonly_0(const char *namemodule);
 /******************************************************************************/
 /*********** UtilFortran.c ****************************************************/
 /******************************************************************************/
-extern void initdimprob(int dimprobmod, char * nx, char * ny,char* nz);
-extern int Variableshouldberemove(char *nom);
+extern void initdimprob(int dimprobmod, const char *nx, const char *ny, const char *nz);
+extern int Variableshouldberemoved(const char *nom);
 extern int variableisglobal(listvar *curvar, listvar *listin);
 extern int VariableIsInListCommon(listvar *curvar,listvar *listin);
 extern int VariableIsInList(listvar *curvar,listvar *listin);
-extern void variableisglobalinmodule(listcouple *listin, char *module,
+extern void variableisglobalinmodule(listcouple *listin, const char *module,
                                                                  FILE *fileout,long int oldposcuruse);
-extern void Remove_Word_Contains_0();
-extern void Remove_Word_end_module_0(int modulenamelength);
-extern void Write_Word_Contains_0();
 extern void Write_Word_end_module_0();
-extern void Add_Subroutine_For_Alloc(char *nom);
-extern void Write_Alloc_Subroutine_0();
-extern void Write_Alloc_Subroutine_For_End_0();
-extern void Write_GlobalParameter_Declaration_0();
-extern void Write_GlobalType_Declaration_0();
-extern void Write_NotGridDepend_Declaration_0();
+extern void Add_Subroutine_For_Alloc(const char *nom);
+extern void Write_Closing_Module();
 extern int IsTabvarsUseInArgument_0();
 extern int ImplicitNoneInSubroutine();
@@ -593,29 +513,31 @@
 extern void Add_Pointer_Var_1(char *nom);
 extern int varispointer_0(char *ident);
-extern int VariableIsNotFunction(char *ident);
+extern int VariableIsFunction(const char *ident);
 extern int varistyped_0(char *ident);
+extern void dump_var(const variable* var);
 /******************************************************************************/
 /*********** UtilListe.c ******************************************************/
 /******************************************************************************/
 extern void Init_Variable(variable *var);
-extern listvar * AddListvarToListvar(listvar *l,listvar *glob,
-                                                            int ValueFirstpass);
-extern void CreateAndFillin_Curvar(char *type,variable *curvar);
-extern void duplicatelistvar(listvar *orig);
+extern listvar * AddListvarToListvar(listvar *l,listvar *glob, int ValueFirstpass);
+extern void CreateAndFillin_Curvar(const char *type, variable *curvar);
+// extern void duplicatelistvar(listvar *orig);
 extern listdim * insertdim(listdim *lin,typedim nom);
 extern void change_dim_char(listdim *lin,listvar * l);
-extern int num_dims(listdim *d);
-extern variable * createvar(char *nom,listdim *d);
+extern int get_num_dims(const listdim *d);
+extern variable * createvar(const char *nom, listdim *d);
 extern listvar * insertvar(listvar *lin,variable *v);
-extern listvar *settype(char *nom,listvar *lin);
+extern listvar * settype(const char *nom,listvar *lin);
 extern void printliste(listvar * lin);
 extern int IsinListe(listvar *lin,char *nom);
 extern listname *Insertname(listname *lin,char *nom,int sens);
 extern listname *concat_listname(listname *l1, listname *l2);
-extern void *createstringfromlistname(char *ligne, listname *lin);
+extern void createstringfromlistname(char *ligne, listname *lin);
 extern void printname(listname * lin);
 extern void removeglobfromlist(listname **lin);
 extern void writelistpublic(listname *lin);
 extern void Init_List_Data_Var();
+extern void  addprecision_derivedfromkind(variable *curvar);
+extern int get_cat_var(variable *var);
 /******************************************************************************/
 /*********** UtilNotGridDep.c *************************************************/
@@ -626,7 +548,6 @@
 /*********** WorkWithAllocatelist.c *******************************************/
 /******************************************************************************/
-extern void Add_Allocate_Var_1(char *nom,char *nommodule);
-extern int IsVarAllocatable_0(char *ident);
-extern int varisallocatable_0(char *ident);
+extern void Add_Allocate_Var_1(const char *nom, const char *nommodule);
+extern int IsVarAllocatable_0(const char *ident);
 /******************************************************************************/
 /*********** WorkWithglobliste.c **********************************************/
@@ -643,5 +564,5 @@
 /*********** WorkWithlistmoduleinfile.c ***************************************/
 /******************************************************************************/
-extern void Save_Length(char *nom, int whichone);
+extern void Save_Length(const char *nom, int whichone);
 extern void Save_Length_int(int val, int whichone);
 /******************************************************************************/
@@ -651,14 +572,14 @@
 extern void  RecordUseModulesUseModulesVariables();
 extern void Add_NameOfModuleUsed_1(char *name);
-extern void Addmoduletothelist(char *name);
-extern void WriteUsemoduleDeclaration(char *cursubroutinename);
+extern void Addmoduletothelist(const char *name);
+extern void WriteUsemoduleDeclaration(const char *cursubroutinename);
 /******************************************************************************/
 /*********** WorkWithlistvarindoloop.c ****************************************/
 /******************************************************************************/
-extern void Add_UsedInSubroutine_Var_1 (char *ident);
+extern void Add_UsedInSubroutine_Var_1 (const char *ident);
 extern void ajoutevarindoloop_definedimension (char *name);
 extern void  ModifyThelistvarindoloop();
 extern void  CompleteThelistvarindoloop();
-extern void CopyRecord(variable *var1,variable *var2);
+extern void Merge_Variables(variable *var1,variable *var2);
 extern void Update_List_Subroutine_Var(listvar *list_to_modify);
 extern void Update_List_Global_Var_From_List_Save_Var();
@@ -669,10 +590,11 @@
 extern int LookingForVariableInList(listvar *listin,variable *var);
 extern int LookingForVariableInListGlobal(listvar *listin,variable *var);
-extern int LookingForVariableInListName(listvar *listin,char *var);
+extern int LookingForVariableInListName(listvar *listin,const char *var);
 extern int LookingForVariableInListGlob(listvar *listin,variable *var);
-extern int LookingForVariableInListParamGlob(listparameter *listin,
-                                                                 variable *var);
+extern int LookingForVariableInListParamGlob(listparameter *listin, variable *var);
+extern variable *get_variable_in_list_from_name(listvar *listin, const char *name);
 extern void UpdateListDeclarationWithDimensionList();
 extern void Clean_List_UsedInSubroutine_Var();
+extern void Clean_List_ModuleUsed_Var();
 extern void Clean_List_SubroutineDeclaration_Var();
 extern void Clean_List_Global_Var();
@@ -692,6 +614,7 @@
 extern void UpdateList_SubroutineWhereAgrifUsed();
 extern void UpdateList_UsedInSubroutine_With_dimension();
-extern void Affiche();
+extern void Affiche(listvar *parcours);
 extern int SubInList_ContainsSubroutine();
+extern void update_indicemaxtabvars(variable *var,listindice **Listofindices);
 /******************************************************************************/
 /*********** WorkWithParameterlist.c ******************************************/
@@ -704,25 +627,22 @@
 /******************************************************************************/
 extern void Add_SubroutineArgument_Var_1(listvar *listtoadd);
-extern void Add_FunctionType_Var_1(char *nom);
-extern void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd);
+extern void Add_FunctionType_Var_1(const char *nom);
+// extern void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd);
 /******************************************************************************/
 /*********** Writedeclarations.c **********************************************/
 /******************************************************************************/
-extern void WriteBeginDeclaration(variable *v,char ligne[LONG_4C],int visibility);
-extern void WriteScalarDeclaration(variable *v,char ligne[LONG_4C]);
-extern void WriteTableDeclaration(variable * v,char ligne[LONG_4C],int tmpok);
-extern void writevardeclaration (listvar * var_record, FILE *fileout,
-                                                                     int value,int visibility);
-extern void WriteLocalParamDeclaration();
-extern void WriteFunctionDeclaration(int value);
+extern void WriteBeginDeclaration(variable *v,char ligne[LONG_M],int visibility);
+extern void WriteScalarDeclaration(variable *v,char ligne[LONG_M]);
+extern void WriteTableDeclaration(variable * v,char ligne[LONG_M],int tmpok);
+extern void WriteVarDeclaration( variable *v, FILE *fileout, int value, int visibility );
+extern void WriteLocalParamDeclaration(FILE* tofile);
+extern void WriteFunctionDeclaration(FILE* tofile, int value);
 extern void WriteSubroutineDeclaration(int value);
 extern void WriteArgumentDeclaration_beforecall();
-extern void WriteArgumentDeclaration_Sort();
-extern listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout,
-                                       variable *var , char commonname[LONG_C],
-                           listnom *neededparameter, char name_common[LONG_C]);
-extern void writesub_loopdeclaration_scalar (listvar * deb_common,
-                                                                 FILE *fileout);
-extern void writesub_loopdeclaration_tab (listvar * deb_common, FILE *fileout);
+extern void WriteArgumentDeclaration_Sort(FILE* tofile);
+extern listnom * writedeclarationintoamr(listvar *deb_common, FILE *fileout, variable *var,
+						const char *commonname, listnom *neededparameter, const char *name_common);
+extern void writesub_loopdeclaration_scalar(listvar *deb_common, FILE *fileout);
+extern void writesub_loopdeclaration_tab(listvar *deb_common, FILE *fileout);
 extern void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl);
 extern void ReWriteDataStatement_0(FILE * filout);
@@ -730,17 +650,13 @@
 /*********** WriteInFile.c ****************************************************/
 /******************************************************************************/
-extern void tofich_reste (FILE * filout, char *s,int returnlineornot);
-extern void tofich (FILE * filout, char *s, int returnlineornot);
+extern void tofich_reste (FILE * filout, const char *s, int do_returnline);
+extern void tofich (FILE * filout, const char *s, int do_returnline);
 extern void tofich_blanc (FILE * filout, int size);
-extern void tofich_line (FILE * filout, int size, int long position);
-extern void RemoveWordSET_0(FILE * filout, long int position,
-                                                         long int sizetoremove);
-extern void RemoveWordCUR_0(FILE * filout, long int position,
-                                                         long int sizetoremove);
+extern void RemoveWordSET_0(FILE * filout, long int position, int sizetoremove);
+extern void RemoveWordCUR_0(FILE * filout, int sizetoremove);
 
 /******************************************************************************/
 /*********** WorkWithlistofcoupled.c **********************************************/
-/******************************************************************************/                                                        
-extern int variscoupled_0(char *ident) ;
-extern char * getcoupledname_0(char *ident);
-extern void ModifyTheVariableNamecoupled_0(char *ident, char* coupledident);
+/******************************************************************************/
+extern int variscoupled_0(const char *ident) ;
+extern const char * getcoupledname_0(const char *ident);
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c	(revision 6808)
@@ -74,7 +74,6 @@
   int out;
 
-  /* We are looking for all the variable of the current filetoparse file      */
-  /*    in the List_Global_Var                                                */
-  parcours =List_Global_Var;
+  // We look in 'List_Global_Var' for all the variables of the current file to parse
+  parcours = List_Global_Var;
   out = 0;
   while (parcours && out == 0 )
@@ -96,5 +95,7 @@
   {
      NbMailleXDefined = 1;
-     dependfileoutput = fopen(".dependnbxnby","w");
+     sprintf(dependfilename, "%s/.dependnbxnby", work_dir);
+     dependfileoutput = fopen(dependfilename, "w");
+
      fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars);
      IndicenbmaillesX = parcours->var->v_indicetabvars;
@@ -169,13 +170,14 @@
 void Readthedependnbxnbyfile()
 {
-  FILE *dependfileoutput;
-
-  if ((dependfileoutput = fopen(".dependnbxnby","r"))!=NULL)
-  {
-     fscanf(dependfileoutput,"%d\n",&IndicenbmaillesX);
-     if ( dimprob > 1 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesY);
-     if ( dimprob > 2 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesZ);
-     fclose(dependfileoutput);
-  }
+    FILE *dependfileoutput;
+
+    sprintf(dependfilename, "%s/.dependnbxnby", work_dir);
+    if ((dependfileoutput = fopen(dependfilename, "r"))!=NULL)
+    {
+        fscanf(dependfileoutput,"%d\n",&IndicenbmaillesX);
+        if ( dimprob > 1 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesY);
+        if ( dimprob > 2 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesZ);
+        fclose(dependfileoutput);
+    }
 }
 
@@ -192,27 +194,102 @@
 /*                                                                            */
 /******************************************************************************/
-void Writethedependlistofmoduleused(char *NameTampon )
+void Writethedependlistofmoduleused(const char *NameTampon )
+{
+    FILE *dependfileoutput;
+    listusemodule *parcours;
+    char lowername[LONG_VNAME];
+
+    if ( ! List_NameOfModuleUsed ) return;
+
+    convert2lower(lowername, NameTampon);
+    sprintf(dependfilename, "%s/.depend_use%s", work_dir, lowername);
+    dependfileoutput = fopen(dependfilename, "w");
+
+    parcours = List_NameOfModuleUsed;
+    while (parcours)
+    {
+    if ( !strcasecmp(lowername,parcours->u_modulename) &&
+         !strcasecmp(parcours->u_cursubroutine,"") )
+    {
+        // We look in 'List_NameOfModuleUsed' for all the variables of the current file to parse
+        fprintf(dependfileoutput,"%s\n",parcours->u_usemodule);
+    }
+    parcours = parcours->suiv;
+    }
+    fclose(dependfileoutput);
+}
+
+/******************************************************************************/
+/*                    Readthedependlistofmoduleused                           */
+/******************************************************************************/
+/* This subroutine is used to create the .dependuse<module>                   */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependuse<name>                                             */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+void Readthedependlistofmoduleused(const char *NameTampon)
 {
   FILE *dependfileoutput;
   listusemodule *parcours;
-  char ligne[LONG_C];
-
-
-  if ( List_NameOfModuleUsed )
-  {
-     convert2lower(NameTampon);
-     sprintf(ligne,".dependuse%s",NameTampon);
-     dependfileoutput = fopen(ligne,"w");
-     /*                                                                       */
-     parcours = List_NameOfModuleUsed;
+  char lowername[LONG_VNAME];
+
+  tmpuselocallist = (listusemodule *)NULL;
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_use%s", work_dir, lowername);
+
+  if ((dependfileoutput = fopen(dependfilename, "r"))!=NULL)
+  {
+    /* if the file exist we should verify that this file has changed          */
+      while (!feof(dependfileoutput))
+      {
+         parcours=(listusemodule *)calloc(1,sizeof(listusemodule));
+         fscanf(dependfileoutput,"%s\n",parcours->u_usemodule);
+
+         parcours->suiv = tmpuselocallist;
+         tmpuselocallist = parcours;
+
+         parcours = NULL;
+      }
+      fclose(dependfileoutput);
+  }
+}
+
+
+/******************************************************************************/
+/*                        WritedependParameterList                            */
+/******************************************************************************/
+/* This subroutine is used to create the .dependparameter<name>               */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependparameter<name>                                       */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+void WritedependParameterList(const char *NameTampon )
+{
+  FILE *dependfileoutput;
+  listvar *parcours;
+  char lowername[LONG_VNAME];
+
+  if ( List_GlobalParameter_Var )
+  {
+     convert2lower(lowername, NameTampon);
+     sprintf(dependfilename, "%s/.depend_paramater_%s", work_dir, lowername);
+
+     dependfileoutput = fopen(dependfilename, "w");
+     parcours = List_GlobalParameter_Var;
      while (parcours)
      {
-        if ( !strcasecmp(NameTampon,parcours->u_modulename) &&
-             !strcasecmp(parcours->u_cursubroutine,"")
-           )
-        {
-           /* We are looking for all the variable of the current              */
-           /*    filetoparse file in the List_Global_Var                      */
-           fprintf(dependfileoutput,"%s\n",parcours->u_usemodule);
+        if ( !strcasecmp(lowername, parcours->var->v_modulename) )
+        {
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_modulename);
         }
         parcours = parcours->suiv;
@@ -222,11 +299,12 @@
 }
 
-/******************************************************************************/
-/*                    Readthedependlistofmoduleused                           */
-/******************************************************************************/
-/* This subroutine is used to create the .dependuse<module>                   */
-/******************************************************************************/
-/*                                                                            */
-/*               .dependuse<name>                                             */
+
+/******************************************************************************/
+/*                         ReaddependParameterList                            */
+/******************************************************************************/
+/* This subroutine is used to create the .dependparameter<name>               */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependparameter<name>                                       */
 /*                                                                            */
 /*               mod1                                                         */
@@ -234,104 +312,19 @@
 /*                                                                            */
 /******************************************************************************/
-void Readthedependlistofmoduleused(char *NameTampon)
+listparameter *ReaddependParameterList(const char *NameTampon,listparameter *listout)
 {
   FILE *dependfileoutput;
-  listusemodule *parcours;
-  char ligne[LONG_C];
-
-  convert2lower(NameTampon);
-  sprintf(ligne,".dependuse%s",NameTampon);
-
-  tmpuselocallist = (listusemodule *)NULL;
-  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
-  {
-  }
-  else
+  listparameter *parcours;
+  char lowername[LONG_VNAME];
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_paramater_%s", work_dir, lowername);
+
+  if ((dependfileoutput = fopen(dependfilename,"r"))!=NULL)
   {
     /* if the file exist we should verify that this file has changed          */
       while (!feof(dependfileoutput))
       {
-         parcours=(listusemodule *)malloc(sizeof(listusemodule));
-         fscanf(dependfileoutput,"%s\n",parcours->u_usemodule);
-
-         parcours->suiv = tmpuselocallist;
-         tmpuselocallist = parcours;
-
-         parcours = NULL;
-      }
-      fclose(dependfileoutput);
-  }
-}
-
-
-/******************************************************************************/
-/*                        WritedependParameterList                            */
-/******************************************************************************/
-/* This subroutine is used to create the .dependparameter<name>               */
-/******************************************************************************/
-/*                                                                            */
-/*               .dependparameter<name>                                       */
-/*                                                                            */
-/*               mod1                                                         */
-/*               mod2                                                         */
-/*                                                                            */
-/******************************************************************************/
-void WritedependParameterList(char *NameTampon )
-{
-  FILE *dependfileoutput;
-  listvar *parcours;
-  char ligne[LONG_C];
-
-  if ( List_GlobalParameter_Var )
-  {
-     convert2lower(NameTampon);
-     sprintf(ligne,".dependparameter%s",NameTampon);
-     dependfileoutput = fopen(ligne,"w");
-     /*                                                                       */
-     parcours = List_GlobalParameter_Var;
-     while (parcours)
-     {
-        if ( !strcasecmp(NameTampon,parcours->var->v_modulename) )
-        {
-           fprintf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
-           fprintf(dependfileoutput,"%s\n",parcours->var->v_modulename);
-        }
-        parcours = parcours->suiv;
-     }
-     fclose(dependfileoutput);
-  }
-}
-
-
-/******************************************************************************/
-/*                         ReaddependParameterList                            */
-/******************************************************************************/
-/* This subroutine is used to create the .dependparameter<name>               */
-/******************************************************************************/
-/*                                                                            */
-/*               .dependparameter<name>                                       */
-/*                                                                            */
-/*               mod1                                                         */
-/*               mod2                                                         */
-/*                                                                            */
-/******************************************************************************/
-listparameter *ReaddependParameterList(char *NameTampon,listparameter *listout)
-{
-  FILE *dependfileoutput;
-  listparameter *parcours;
-  char ligne[LONG_C];
-
-  convert2lower(NameTampon);
-  sprintf(ligne,".dependparameter%s",NameTampon);
-
-  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
-  {
-  }
-  else
-  {
-    /* if the file exist we should verify that this file has changed          */
-      while (!feof(dependfileoutput))
-      {
-         parcours=(listparameter *)malloc(sizeof(listparameter));
+         parcours=(listparameter *)calloc(1,sizeof(listparameter));
          fscanf(dependfileoutput,"%s\n",parcours->p_name);
          fscanf(dependfileoutput,"%s\n",parcours->p_modulename);
@@ -367,22 +360,22 @@
 /*                                                                            */
 /******************************************************************************/
-void Writethedependfile(char *NameTampon, listvar *input )
+void Writethedependfile(const char *NameTampon, listvar *input )
 {
   FILE *dependfileoutput;
   listvar *parcours;
   listdim *dims;
-  char ligne[LONG_C];
-  char listdimension[LONG_C];
-  char curname[LONG_C];
+  char ligne[LONG_M];
+  char listdimension[LONG_M];
+  char curname[LONG_M];
+  char lowername[LONG_VNAME];
   int out;
 
   if ( input )
   {
-  convert2lower(NameTampon);
-
-  sprintf(ligne,".depend%s",NameTampon);
-  dependfileoutput = fopen(ligne,"w");
-  /* We are looking for all the variable of the current filetoparse file      */
-  /*    in the input                                                          */
+    convert2lower(lowername, NameTampon);
+    sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername);
+
+  dependfileoutput = fopen(dependfilename,"w");
+  // We look in 'input' for all the variables of the current file to parse
   parcours =input;
   out = 0;
@@ -390,6 +383,6 @@
   while (parcours && out == 0 )
   {
-     if ( !strcasecmp(parcours->var->v_modulename,NameTampon) ||
-          !strcasecmp(parcours->var->v_commonname,NameTampon) )
+     if ( !strcasecmp(parcours->var->v_modulename, lowername) ||
+          !strcasecmp(parcours->var->v_commonname, lowername) )
      {
         /*                                                                    */
@@ -402,8 +395,10 @@
            /********** TYPEVAR ************************************************/
            fprintf(dependfileoutput,"%s\n",parcours->var->v_typevar);
+           /********** CATVAR ************************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_catvar);
            /********** NOMVAR *************************************************/
            fprintf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
            /********** DIMCHAR ************************************************/
-           if ( strcasecmp(parcours->var->v_dimchar,"") )
+           if ( strcasecmp(parcours->var->v_dimchar, "") )
            {
               fprintf(dependfileoutput,"%s\n",parcours->var->v_dimchar);
@@ -479,5 +474,5 @@
            /********** PRIVATE *****************************************/
            fprintf(dependfileoutput,"%d\n",parcours->var->v_PrivateDeclare);
-              
+
            /********** INDICETABVARS ******************************************/
            fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars);
@@ -497,4 +492,5 @@
                  dims = dims->suiv;
               }
+              Save_Length(listdimension,15);
               fprintf(dependfileoutput,"%s\n",listdimension);
            }
@@ -525,19 +521,20 @@
 /*                                                                            */
 /******************************************************************************/
-listvar *Readthedependfile( char *NameTampon , listvar *listout)
-{
-  char ligne[LONG_C];
+listvar *Readthedependfile(const char *NameTampon , listvar *listout)
+{
   FILE *dependfileoutput;
   listvar *parcours0;
   listvar *parcours;
   listvar *parcoursprec;
-  char nothing[LONG_C];
-  int i;
+  char nothing[LONG_M];
+  char lowername[LONG_VNAME];
+  size_t i;
 
   parcoursprec = (listvar *)NULL;
 
-  convert2lower(NameTampon);
-  sprintf(ligne,".depend%s",NameTampon);
-  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername);
+
+  if ((dependfileoutput = fopen(dependfilename, "r"))==NULL)
   {
     /* if the file doesn't exist it means that it is the first time           */
@@ -549,6 +546,6 @@
       while (!feof(dependfileoutput))
       {
-         parcours=(listvar *)malloc(sizeof(listvar));
-         parcours->var=(variable *)malloc(sizeof(variable));
+         parcours=(listvar *)calloc(1,sizeof(listvar));
+         parcours->var=(variable *)calloc(1,sizeof(variable));
          /*                                                                   */
          Init_Variable(parcours->var);
@@ -556,4 +553,6 @@
            /********** TYPEVAR ************************************************/
          fscanf(dependfileoutput,"%s\n",parcours->var->v_typevar);
+           /********** CATVAR ************************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_catvar);
            /********** NOMVAR *************************************************/
          fscanf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
@@ -578,12 +577,10 @@
            /********** MODULENAME *********************************************/
          fscanf(dependfileoutput,"%s\n",parcours->var->v_modulename);
-         
-         printf("MODULENAME = %s %s\n",parcours->var->v_nomvar,parcours->var->v_modulename);
-         
+
          if ( !strcasecmp(parcours->var->v_modulename,"T") )
          {
             strcpy(parcours->var->v_modulename,"");
          }
-         
+
 
            /********** NBDIM **************************************************/
@@ -595,10 +592,9 @@
          if ( parcours->var->v_allocatable == 1 )
          {
-            Add_Allocate_Var_1(parcours->var->v_nomvar,
-                               parcours->var->v_commonname);
+            Add_Allocate_Var_1(parcours->var->v_nomvar, parcours->var->v_commonname);
          }
            /********** TARGET ********************************************/
          fscanf(dependfileoutput,"%d\n",&parcours->var->v_target);
-         
+
            /********** POINTERDECLARE *****************************************/
          fscanf(dependfileoutput,"%d\n",&parcours->var->v_pointerdeclare);
@@ -627,5 +623,5 @@
            /********** PRIVATE *****************************************/
          fscanf(dependfileoutput,"%d\n",&parcours->var->v_PrivateDeclare);
-         
+
            /********** INDICETABVARS ******************************************/
          fscanf(dependfileoutput,"%d\n",&parcours->var->v_indicetabvars);
@@ -692,5 +688,7 @@
    if ( List_Subroutine_For_Alloc )
    {
-      if ((dependfileoutput=fopen(".dependAllocAgrif","w"))!=NULL)
+      sprintf(dependfilename, "%s/.dependAllocAgrif", work_dir);
+
+      if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL)
       {
          parcours = List_Subroutine_For_Alloc;
@@ -707,33 +705,34 @@
 void Read_Subroutine_For_Alloc()
 {
-  FILE *dependfileoutput;
-  listnom *parcours;
-  listnom *ref;
-
-  ref = (listnom *)NULL;
-  if ((dependfileoutput=fopen(".dependAllocAgrif","r"))!=NULL)
-  {
-     List_Subroutine_For_Alloc = (listnom *)NULL;
-     while (!feof(dependfileoutput))
-     {
-        parcours=(listnom *)malloc(sizeof(listnom));
-        strcpy(parcours->o_nom,"");
-
-        fscanf(dependfileoutput,"%s\n",&parcours->o_nom);
-        parcours->suiv = NULL;
-
-        if ( !List_Subroutine_For_Alloc )
-        {
-           List_Subroutine_For_Alloc = parcours;
-           ref = parcours;
-        }
-        else
-        {
-            ref->suiv = parcours;
+    FILE *dependfileoutput;
+    listnom *parcours;
+    listnom *ref;
+
+    ref = (listnom*) NULL;
+    sprintf(dependfilename, "%s/.dependAllocAgrif", work_dir);
+
+    if ( (dependfileoutput=fopen(dependfilename, "r")) != NULL )
+    {
+        List_Subroutine_For_Alloc = (listnom*) NULL;
+        while ( !feof(dependfileoutput) )
+        {
+            parcours = (listnom*) calloc(1,sizeof(listnom));
+            strcpy(parcours->o_nom,"");
+
+            fscanf(dependfileoutput,"%s\n",parcours->o_nom);
+            parcours->suiv = NULL;
+
+            if ( !List_Subroutine_For_Alloc )
+            {
+                List_Subroutine_For_Alloc = parcours;
+            }
+            else
+            {
+                ref->suiv = parcours;
+            }
             ref = parcours;
         }
-     }
-     fclose(dependfileoutput);
-  }
+        fclose(dependfileoutput);
+    }
 }
 
@@ -756,21 +755,27 @@
 void Writethedependavailablefile()
 {
-  FILE *dependfileoutput;
-  listindice *parcours;
-
-  if ((dependfileoutput=fopen(".dependavailable","w"))!=NULL)
-  {
-     /* We are looking for all the indices of the Listofavailableindices      */
-     parcours = Listofavailableindices;
-     while (parcours)
-     {
-        if ( parcours->i_indice != 0 )
-        {
-           fprintf(dependfileoutput,"%d\n",parcours->i_indice);
-        }
-        parcours = parcours->suiv;
-     }
-     fclose(dependfileoutput);
-  }
+    FILE *dependfileoutput;
+    listindice *parcours;
+    int i;
+
+    sprintf(dependfilename, "%s/.dependavailable", work_dir);
+
+    if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL)
+    {
+        /* We are looking for all the indices of the Listofavailableindices      */
+        for (i=0;i<NB_CAT_VARIABLES;i++)
+        {
+            parcours = Listofavailableindices_glob[i];
+            while (parcours)
+            {
+                if ( parcours->i_indice != 0 )
+                {
+                    fprintf(dependfileoutput,"%d %d\n",i,parcours->i_indice);
+                }
+                parcours = parcours->suiv;
+            }
+        }
+        fclose(dependfileoutput);
+    }
 }
 
@@ -795,17 +800,20 @@
   FILE *dependfileoutput;
   listindice *parcours;
-
-  if ((dependfileoutput=fopen(".dependavailable","r"))!=NULL)
+  int current_cat;
+
+  sprintf(dependfilename, "%s/.dependavailable", work_dir);
+
+  if ((dependfileoutput=fopen(dependfilename, "r"))!=NULL)
   {
      /* We are looking for all the indices of the Listofavailableindices      */
-     Listofavailableindices = (listindice *)NULL;
+     Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
      while (!feof(dependfileoutput))
      {
-        parcours=(listindice *)malloc(sizeof(listindice));
-        fscanf(dependfileoutput,"%d\n",&parcours->i_indice);
+        parcours=(listindice *)calloc(1,sizeof(listindice));
+        fscanf(dependfileoutput,"%d %d\n",&current_cat,&parcours->i_indice);
         if ( parcours->i_indice != 0 && parcours->i_indice < 10000000 )
         {
-           parcours -> suiv = Listofavailableindices;
-           Listofavailableindices = parcours;
+           parcours -> suiv = Listofavailableindices_glob[current_cat];
+           Listofavailableindices_glob[current_cat] = parcours;
         }
         else
@@ -820,5 +828,5 @@
 
 /******************************************************************************/
-/*                      Did_filetoparse_readed                                */
+/*                       is_dependfile_created                                */
 /******************************************************************************/
 /* This subroutine is used to know if the .depend<NameTampon> exist           */
@@ -827,188 +835,80 @@
 /*                                                                            */
 /******************************************************************************/
-int Did_filetoparse_readed(char *NameTampon)
+int is_dependfile_created(const char *NameTampon)
 {
   FILE *dependfileoutput;
-  char ligne[LONG_C];
-  int out;
-
-  convert2lower(NameTampon);
-  sprintf(ligne,".depend%s",NameTampon);
-  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
-  {
-      out = 0;
+  char lowername[LONG_VNAME];
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername);
+
+  dependfileoutput = fopen(dependfilename, "r");
+
+  if ( (dependfileoutput = fopen(dependfilename, "r")) != NULL )
+  {
+    fclose(dependfileoutput);
+    return 1;
   }
   else
-  {
-      out = 1;
-      fclose(dependfileoutput);
-  }
-  return out;
-}
-
-
-/******************************************************************************/
-/*                      Did_module_common_treaded                             */
-/******************************************************************************/
-/* This subroutine is used to know if the .depend<NameTampon> exist           */
-/*    it means if the file has been ever parsed                               */
-/******************************************************************************/
-/*                                                                            */
-/******************************************************************************/
-int Did_module_common_treaded(char *NameTampon)
-{
-  FILE *dependfileoutput;
-  char ligne[LONG_C];
-  int out;
-
-  convert2lower(NameTampon);
-  sprintf(ligne,".depend%s",NameTampon);
-  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
-  {
-      out = 0;
-  }
-  else
-  {
-      out = 1;
-      fclose(dependfileoutput);
-  }
-  return out;
-}
-
-
+    return 0;
+}
 
 void Write_val_max()
 {
-  FILE *dependfileoutput;
-
-  if ((dependfileoutput=fopen(".dependvalmax","w"))!=NULL)
-  {
-     fprintf(dependfileoutput,"length_last\n");
-     fprintf(dependfileoutput,"%d\n",length_last);
-     fprintf(dependfileoutput,"length_first\n");
-     fprintf(dependfileoutput,"%d\n",length_first);
-     fprintf(dependfileoutput,"length_v_typevar\n");
-     fprintf(dependfileoutput,"%d\n",length_v_typevar);
-     fprintf(dependfileoutput,"length_v_nomvar\n");
-     fprintf(dependfileoutput,"%d\n",length_v_nomvar);
-     fprintf(dependfileoutput,"length_v_dimchar\n");
-     fprintf(dependfileoutput,"%d\n",length_v_dimchar);
-     fprintf(dependfileoutput,"length_v_modulename\n");
-     fprintf(dependfileoutput,"%d\n",length_v_modulename);
-     fprintf(dependfileoutput,"length_v_commonname\n");
-     fprintf(dependfileoutput,"%d\n",length_v_commonname);
-     fprintf(dependfileoutput,"length_v_vallengspec\n");
-     fprintf(dependfileoutput,"%d\n",length_v_vallengspec);
-     fprintf(dependfileoutput,"length_v_nameinttypename\n");
-     fprintf(dependfileoutput,"%d\n",length_v_nameinttypename);
-     fprintf(dependfileoutput,"length_v_commoninfile\n");
-     fprintf(dependfileoutput,"%d\n",length_v_commoninfile);
-     fprintf(dependfileoutput,"length_v_subroutinename\n");
-     fprintf(dependfileoutput,"%d\n",length_v_subroutinename);
-     fprintf(dependfileoutput,"length_v_precision\n");
-     fprintf(dependfileoutput,"%d\n",length_v_precision);
-     fprintf(dependfileoutput,"length_v_IntentSpec\n");
-     fprintf(dependfileoutput,"%d\n",length_v_IntentSpec);
-     fprintf(dependfileoutput,"length_v_initialvalue\n");
-     fprintf(dependfileoutput,"%d\n",length_v_initialvalue);
-     fprintf(dependfileoutput,"length_v_readedlistdimension\n");
-     fprintf(dependfileoutput,"%d\n",length_v_readedlistdimension);
-     fprintf(dependfileoutput,"length_u_usemodule\n");
-     fprintf(dependfileoutput,"%d\n",length_u_usemodule);
-     fprintf(dependfileoutput,"length_u_charusemodule\n");
-     fprintf(dependfileoutput,"%d\n",length_u_charusemodule);
-     fprintf(dependfileoutput,"length_u_cursubroutine\n");
-     fprintf(dependfileoutput,"%d\n",length_u_cursubroutine);
-     fprintf(dependfileoutput,"length_u_modulename\n");
-     fprintf(dependfileoutput,"%d\n",length_u_modulename);
-     fprintf(dependfileoutput,"length_n_name\n");
-     fprintf(dependfileoutput,"%d\n",length_n_name);
-     fprintf(dependfileoutput,"length_c_namevar\n");
-     fprintf(dependfileoutput,"%d\n",length_c_namevar);
-     fprintf(dependfileoutput,"length_c_namepointedvar\n");
-     fprintf(dependfileoutput,"%d\n",length_c_namepointedvar);
-     fprintf(dependfileoutput,"length_o_nom\n");
-     fprintf(dependfileoutput,"%d\n",length_o_nom);
-     fprintf(dependfileoutput,"length_o_module\n");
-     fprintf(dependfileoutput,"%d\n",length_o_module);
-     fprintf(dependfileoutput,"length_a_nomvar\n");
-     fprintf(dependfileoutput,"%d\n",length_a_nomvar);
-     fprintf(dependfileoutput,"length_a_subroutine\n");
-     fprintf(dependfileoutput,"%d\n",length_a_subroutine);
-     fprintf(dependfileoutput,"length_a_module\n");
-     fprintf(dependfileoutput,"%d\n",length_a_module);
-     fprintf(dependfileoutput,"length_usemodule\n");
-     fprintf(dependfileoutput,"%d\n",length_t_usemodule);
-     fprintf(dependfileoutput,"length_cursubroutine\n");
-     fprintf(dependfileoutput,"%d\n",length_t_cursubroutine);
-     fprintf(dependfileoutput,"length_curfilename\n");
-     fprintf(dependfileoutput,"%d\n",length_curfilename);
-     fprintf(dependfileoutput,"length_nomfileoutput\n");
-     fprintf(dependfileoutput,"%d\n",length_nomfileoutput);
-     fprintf(dependfileoutput,"length_motparse\n");
-     fprintf(dependfileoutput,"%d\n",length_motparse);
-     fprintf(dependfileoutput,"length_mainfile\n");
-     fprintf(dependfileoutput,"%d\n",length_mainfile);
-     fprintf(dependfileoutput,"length_nomdir\n");
-     fprintf(dependfileoutput,"%d\n",length_nomdir);
-     fprintf(dependfileoutput,"length_commondirout\n");
-     fprintf(dependfileoutput,"%d\n",length_commondirout);
-     fprintf(dependfileoutput,"length_commondirin\n");
-     fprintf(dependfileoutput,"%d\n",length_commondirin);
-     fprintf(dependfileoutput,"length_filetoparse\n");
-     fprintf(dependfileoutput,"%d\n",length_filetoparse);
-     fprintf(dependfileoutput,"length_curbuf\n");
-     fprintf(dependfileoutput,"%d\n",length_curbuf);
-     fprintf(dependfileoutput,"length_toprintglob\n");
-     fprintf(dependfileoutput,"%d\n",length_toprintglob);
-     fprintf(dependfileoutput,"Size_char0d\n");
-     fprintf(dependfileoutput,"%d\n",value_char_size);
-     fprintf(dependfileoutput,"Size_char1d\n");
-     fprintf(dependfileoutput,"%d\n",value_char_size1);
-     fprintf(dependfileoutput,"Size_char2d\n");
-     fprintf(dependfileoutput,"%d\n",value_char_size2);
-     fprintf(dependfileoutput,"Size_char3d\n");
-     fprintf(dependfileoutput,"%d\n",value_char_size3);
-     fprintf(dependfileoutput,"length_tmpvargridname\n");
-     fprintf(dependfileoutput,"%d\n",length_tmpvargridname);
-     fprintf(dependfileoutput,"length_ligne_Subloop\n");
-     fprintf(dependfileoutput,"%d\n",length_ligne_Subloop);
-     fprintf(dependfileoutput,"length_lvargridname_toamr\n");
-     fprintf(dependfileoutput,"%d\n",length_lvargridname_toamr);
-     fprintf(dependfileoutput,"length_toprint_toamr\n");
-     fprintf(dependfileoutput,"%d\n",length_toprint_utilagrif);
-     fprintf(dependfileoutput,"length_toprinttmp_utilchar\n");
-     fprintf(dependfileoutput,"%d\n",length_toprinttmp_utilchar);
-     fprintf(dependfileoutput,"length_ligne_writedecl\n");
-     fprintf(dependfileoutput,"%d\n",length_ligne_writedecl);
-     fprintf(dependfileoutput,"length_newname_toamr\n");
-     fprintf(dependfileoutput,"%d\n",length_newname_toamr);
-     fprintf(dependfileoutput,"length_newname_writedecl\n");
-     fprintf(dependfileoutput,"%d\n",length_newname_writedecl);
-     fprintf(dependfileoutput,"length_ligne_toamr\n");
-     fprintf(dependfileoutput,"%d\n",length_ligne_toamr);
-     fprintf(dependfileoutput,"length_tmpligne_writedecl\n");
-     fprintf(dependfileoutput,"%d\n",length_tmpligne_writedecl);
-/*     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);*/
-
-     fclose(dependfileoutput);
-  }
+    FILE *dependfileoutput;
+
+    sprintf(dependfilename, "%s/.dependvalmax", work_dir);
+
+    if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL)
+    {
+        fprintf(dependfileoutput,"length_last\n");
+        fprintf(dependfileoutput,"%lu\n", length_last);
+        fprintf(dependfileoutput,"length_first\n");
+        fprintf(dependfileoutput,"%lu\n", length_first);
+        fprintf(dependfileoutput,"length_v_vallengspec\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_vallengspec);
+        fprintf(dependfileoutput,"length_v_commoninfile\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_commoninfile);
+        fprintf(dependfileoutput,"length_v_precision\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_precision);
+        fprintf(dependfileoutput,"length_v_IntentSpec\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_IntentSpec);
+        fprintf(dependfileoutput,"length_v_initialvalue\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_initialvalue);
+        fprintf(dependfileoutput,"length_v_readedlistdimension\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_readedlistdimension);
+        fprintf(dependfileoutput,"length_a_nomvar\n");
+        fprintf(dependfileoutput,"%lu\n", length_a_nomvar);
+        fprintf(dependfileoutput,"length_toprintglob\n");
+        fprintf(dependfileoutput,"%lu\n", length_toprintglob);
+        fprintf(dependfileoutput,"Size_char0d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size);
+        fprintf(dependfileoutput,"Size_char1d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size1);
+        fprintf(dependfileoutput,"Size_char2d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size2);
+        fprintf(dependfileoutput,"Size_char3d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size3);
+        fprintf(dependfileoutput,"length_tmpvargridname\n");
+        fprintf(dependfileoutput,"%lu\n", length_tmpvargridname);
+        fprintf(dependfileoutput,"length_ligne_Subloop\n");
+        fprintf(dependfileoutput,"%lu\n", length_ligne_Subloop);
+        fprintf(dependfileoutput,"length_toprint_toamr\n");
+        fprintf(dependfileoutput,"%lu\n", length_toprint_utilagrif);
+        fprintf(dependfileoutput,"length_toprinttmp_utilchar\n");
+        fprintf(dependfileoutput,"%lu\n", length_toprinttmp_utilchar);
+        fprintf(dependfileoutput,"length_ligne_writedecl\n");
+        fprintf(dependfileoutput,"%lu\n", length_ligne_writedecl);
+        fprintf(dependfileoutput,"length_newname_toamr\n");
+        fprintf(dependfileoutput,"%lu\n", length_newname_toamr);
+        fprintf(dependfileoutput,"length_newname_writedecl\n");
+        fprintf(dependfileoutput,"%lu\n", length_newname_writedecl);
+        fprintf(dependfileoutput,"length_ligne_toamr\n");
+        fprintf(dependfileoutput,"%lu\n", length_ligne_toamr);
+        fprintf(dependfileoutput,"length_tmpligne_writedecl\n");
+        fprintf(dependfileoutput,"%lu\n", length_tmpligne_writedecl);
+
+        fclose(dependfileoutput);
+    }
 }
 
@@ -1016,135 +916,59 @@
 void Read_val_max()
 {
-  char nothing[LONG_C];
-  FILE *dependfileoutput;
-
-  if ((dependfileoutput=fopen(".dependvalmax","r"))!=NULL)
-  {
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_last);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_first);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_typevar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_nomvar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_dimchar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_modulename);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_commonname);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_vallengspec);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_nameinttypename);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_commoninfile);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_subroutinename);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_precision);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_IntentSpec);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_initialvalue);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_readedlistdimension);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_u_usemodule);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_u_charusemodule);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_u_cursubroutine);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_u_modulename);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_n_name);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_c_namevar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_c_namepointedvar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_o_nom);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_o_module);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_a_nomvar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_a_subroutine);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_a_module);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_t_usemodule);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_t_cursubroutine);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_curfilename);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_nomfileoutput);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_motparse);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_mainfile);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_nomdir);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_commondirout);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_commondirin);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_filetoparse);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_curbuf);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_toprintglob);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&value_char_size);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&value_char_size1);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&value_char_size2);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&value_char_size3);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_tmpvargridname);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_ligne_Subloop);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_lvargridname_toamr);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_toprint_utilagrif);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_toprinttmp_utilchar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_ligne_writedecl);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_newname_toamr);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_newname_writedecl);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_ligne_toamr);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_tmpligne_writedecl);
-/*     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);*/
-
-     fclose(dependfileoutput);
-  }
-}
+    char nothing[LONG_M];
+    FILE *dependfileoutput;
+
+    sprintf(dependfilename, "%s/.dependvalmax", work_dir);
+
+    if ((dependfileoutput=fopen(".dependvalmax","r"))!=NULL)
+    {
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_last);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_first);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_vallengspec);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_commoninfile);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_precision);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_IntentSpec);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_initialvalue);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_readedlistdimension);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_a_nomvar);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_toprintglob);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size);
+       fscanf(dependfileoutput,"%s\n", nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size1);
+       fscanf(dependfileoutput,"%s\n", nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size2);
+       fscanf(dependfileoutput,"%s\n", nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size3);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_tmpvargridname);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_ligne_Subloop);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_toprint_utilagrif);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_toprinttmp_utilchar);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_ligne_writedecl);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_newname_toamr);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_newname_writedecl);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_ligne_toamr);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_tmpligne_writedecl);
+
+       fclose(dependfileoutput);
+    }
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c	(revision 6808)
@@ -1,23 +1,20 @@
-/* A Bison parser, made by GNU Bison 2.3.  */
-
-/* Skeleton implementation for Bison's Yacc-like parsers in C
-
-   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
-   Free Software Foundation, Inc.
-
-   This program is free software; you can redistribute it and/or modify
+/* A Bison parser, made by GNU Bison 2.7.  */
+
+/* Bison implementation for Yacc-like parsers in C
+   
+      Copyright (C) 1984, 1989-1990, 2000-2012 Free Software Foundation, Inc.
+   
+   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, or (at your option)
-   any later version.
-
+   the Free Software Foundation, either version 3 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., 51 Franklin Street, Fifth Floor,
-   Boston, MA 02110-1301, USA.  */
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
 
 /* As a special exception, you may create a larger work that contains
@@ -30,5 +27,5 @@
    Bison output files to be licensed under the GNU General Public
    License without this special exception.
-
+   
    This special exception was added by the Free Software Foundation in
    version 2.2 of Bison.  */
@@ -48,5 +45,4 @@
 
 /* Bison version.  */
-#define YYBISON_VERSION "2.3"
 
 /* Skeleton name.  */
@@ -56,371 +52,22 @@
 #define YYPURE 0
 
-/* Using locations.  */
-#define YYLSP_NEEDED 0
+/* Push parsers.  */
+#define YYPUSH 0
+
+/* Pull parsers.  */
+#define YYPULL 1
+
 
 /* Substitute the variable and function names.  */
-#define yyparse fortranparse
-#define yylex   fortranlex
-#define yyerror fortranerror
-#define yylval  fortranlval
-#define yychar  fortranchar
-#define yydebug fortrandebug
-#define yynerrs fortrannerrs
-
-
-/* Tokens.  */
-#ifndef YYTOKENTYPE
-# define YYTOKENTYPE
-   /* Put the tokens into the symbol table, so that GDB and other debuggers
-      know about them.  */
-   enum yytokentype {
-     TOK_BINARY_OP = 258,
-     TOK_NEQV = 259,
-     TOK_EQV = 260,
-     TOK_XOR = 261,
-     TOK_OR = 262,
-     TOK_AND = 263,
-     TOK_NOT = 264,
-     TOK_NE = 265,
-     TOK_EQ = 266,
-     TOK_GE = 267,
-     TOK_LE = 268,
-     TOK_GT = 269,
-     TOK_LT = 270,
-     TOK_UNARY_OP = 271,
-     TOK_DSLASH = 272,
-     TOK_SLASH = 273,
-     TOK_DASTER = 274,
-     TOK_SEP = 275,
-     TOK_SEMICOLON = 276,
-     TOK_NEXTLINE = 277,
-     TOK_PARAMETER = 278,
-     TOK_RESULT = 279,
-     TOK_ONLY = 280,
-     TOK_INCLUDE = 281,
-     TOK_SUBROUTINE = 282,
-     TOK_PROGRAM = 283,
-     TOK_FUNCTION = 284,
-     TOK_OMP = 285,
-     TOK_DOLLAR = 286,
-     TOK_FORMAT = 287,
-     TOK_MAX = 288,
-     TOK_TANH = 289,
-     TOK_WHERE = 290,
-     TOK_ELSEWHERE = 291,
-     TOK_ENDWHERE = 292,
-     TOK_MAXVAL = 293,
-     TOK_TRIM = 294,
-     TOK_SUM = 295,
-     TOK_SQRT = 296,
-     TOK_CASE = 297,
-     TOK_SELECTCASE = 298,
-     TOK_FILE = 299,
-     TOK_END = 300,
-     TOK_ERR = 301,
-     TOK_DONOTTREAT = 302,
-     TOK_ENDDONOTTREAT = 303,
-     TOK_EXIST = 304,
-     TOK_MIN = 305,
-     TOK_FLOAT = 306,
-     TOK_EXP = 307,
-     TOK_COS = 308,
-     TOK_COSH = 309,
-     TOK_ACOS = 310,
-     TOK_NINT = 311,
-     TOK_CYCLE = 312,
-     TOK_SIN = 313,
-     TOK_SINH = 314,
-     TOK_ASIN = 315,
-     TOK_EQUIVALENCE = 316,
-     TOK_BACKSPACE = 317,
-     TOK_LOG = 318,
-     TOK_TAN = 319,
-     TOK_ATAN = 320,
-     TOK_RECURSIVE = 321,
-     TOK_ABS = 322,
-     TOK_MOD = 323,
-     TOK_SIGN = 324,
-     TOK_MINLOC = 325,
-     TOK_MAXLOC = 326,
-     TOK_EXIT = 327,
-     TOK_MINVAL = 328,
-     TOK_PUBLIC = 329,
-     TOK_PRIVATE = 330,
-     TOK_ALLOCATABLE = 331,
-     TOK_RETURN = 332,
-     TOK_THEN = 333,
-     TOK_ELSEIF = 334,
-     TOK_ELSE = 335,
-     TOK_ENDIF = 336,
-     TOK_PRINT = 337,
-     TOK_PLAINGOTO = 338,
-     TOK_CONSTRUCTID = 339,
-     TOK_LOGICALIF = 340,
-     TOK_PLAINDO = 341,
-     TOK_CONTAINS = 342,
-     TOK_ENDDO = 343,
-     TOK_MODULE = 344,
-     TOK_ENDMODULE = 345,
-     TOK_DOWHILE = 346,
-     TOK_ALLOCATE = 347,
-     TOK_OPEN = 348,
-     TOK_CLOSE = 349,
-     TOK_INQUIRE = 350,
-     TOK_WRITE = 351,
-     TOK_READ = 352,
-     TOK_REWIND = 353,
-     TOK_DEALLOCATE = 354,
-     TOK_NULLIFY = 355,
-     TOK_FIN = 356,
-     TOK_DEBUT = 357,
-     TOK_DIMENSION = 358,
-     TOK_ENDSELECT = 359,
-     TOK_EXTERNAL = 360,
-     TOK_INTENT = 361,
-     TOK_INTRINSIC = 362,
-     TOK_NAMELIST = 363,
-     TOK_CASEDEFAULT = 364,
-     TOK_OPTIONAL = 365,
-     TOK_POINTER = 366,
-     TOK_CONTINUE = 367,
-     TOK_SAVE = 368,
-     TOK_TARGET = 369,
-     TOK_QUOTE = 370,
-     TOK_IMPLICIT = 371,
-     TOK_NONE = 372,
-     TOK_CALL = 373,
-     TOK_STAT = 374,
-     TOK_POINT_TO = 375,
-     TOK_COMMON = 376,
-     TOK_GLOBAL = 377,
-     TOK_INTERFACE = 378,
-     TOK_ENDINTERFACE = 379,
-     TOK_LEFTAB = 380,
-     TOK_RIGHTAB = 381,
-     TOK_PAUSE = 382,
-     TOK_PROCEDURE = 383,
-     TOK_STOP = 384,
-     TOK_NAMEEQ = 385,
-     TOK_REAL8 = 386,
-     TOK_OUT = 387,
-     TOK_INOUT = 388,
-     TOK_IN = 389,
-     TOK_USE = 390,
-     TOK_TRUE = 391,
-     TOK_FALSE = 392,
-     TOK_LABEL = 393,
-     TOK_TYPE = 394,
-     TOK_TYPEPAR = 395,
-     TOK_ENDTYPE = 396,
-     TOK_REAL = 397,
-     TOK_INTEGER = 398,
-     TOK_LOGICAL = 399,
-     TOK_DOUBLEPRECISION = 400,
-     TOK_DOUBLEREAL = 401,
-     TOK_ENDSUBROUTINE = 402,
-     TOK_ENDFUNCTION = 403,
-     TOK_ENDPROGRAM = 404,
-     TOK_ENDUNIT = 405,
-     TOK_CHARACTER = 406,
-     TOK_CHAR_CONSTANT = 407,
-     TOK_CHAR_CUT = 408,
-     TOK_DATA = 409,
-     TOK_CHAR_INT = 410,
-     TOK_CHAR_MESSAGE = 411,
-     TOK_CSTREAL = 412,
-     TOK_CSTREALDP = 413,
-     TOK_CSTREALQP = 414,
-     TOK_SFREAL = 415,
-     TOK_COMPLEX = 416,
-     TOK_DOUBLECOMPLEX = 417,
-     TOK_NAME = 418,
-     TOK_NAME_CHAR = 419,
-     TOK_PROBTYPE = 420,
-     TOK_INTERPTYPE = 421,
-     TOK_VARTYPE = 422,
-     TOK_BC = 423,
-     TOK_OP = 424,
-     TOK_CSTINT = 425,
-     TOK_COMMENT = 426,
-     TOK_FILENAME = 427
-   };
-#endif
-/* Tokens.  */
-#define TOK_BINARY_OP 258
-#define TOK_NEQV 259
-#define TOK_EQV 260
-#define TOK_XOR 261
-#define TOK_OR 262
-#define TOK_AND 263
-#define TOK_NOT 264
-#define TOK_NE 265
-#define TOK_EQ 266
-#define TOK_GE 267
-#define TOK_LE 268
-#define TOK_GT 269
-#define TOK_LT 270
-#define TOK_UNARY_OP 271
-#define TOK_DSLASH 272
-#define TOK_SLASH 273
-#define TOK_DASTER 274
-#define TOK_SEP 275
-#define TOK_SEMICOLON 276
-#define TOK_NEXTLINE 277
-#define TOK_PARAMETER 278
-#define TOK_RESULT 279
-#define TOK_ONLY 280
-#define TOK_INCLUDE 281
-#define TOK_SUBROUTINE 282
-#define TOK_PROGRAM 283
-#define TOK_FUNCTION 284
-#define TOK_OMP 285
-#define TOK_DOLLAR 286
-#define TOK_FORMAT 287
-#define TOK_MAX 288
-#define TOK_TANH 289
-#define TOK_WHERE 290
-#define TOK_ELSEWHERE 291
-#define TOK_ENDWHERE 292
-#define TOK_MAXVAL 293
-#define TOK_TRIM 294
-#define TOK_SUM 295
-#define TOK_SQRT 296
-#define TOK_CASE 297
-#define TOK_SELECTCASE 298
-#define TOK_FILE 299
-#define TOK_END 300
-#define TOK_ERR 301
-#define TOK_DONOTTREAT 302
-#define TOK_ENDDONOTTREAT 303
-#define TOK_EXIST 304
-#define TOK_MIN 305
-#define TOK_FLOAT 306
-#define TOK_EXP 307
-#define TOK_COS 308
-#define TOK_COSH 309
-#define TOK_ACOS 310
-#define TOK_NINT 311
-#define TOK_CYCLE 312
-#define TOK_SIN 313
-#define TOK_SINH 314
-#define TOK_ASIN 315
-#define TOK_EQUIVALENCE 316
-#define TOK_BACKSPACE 317
-#define TOK_LOG 318
-#define TOK_TAN 319
-#define TOK_ATAN 320
-#define TOK_RECURSIVE 321
-#define TOK_ABS 322
-#define TOK_MOD 323
-#define TOK_SIGN 324
-#define TOK_MINLOC 325
-#define TOK_MAXLOC 326
-#define TOK_EXIT 327
-#define TOK_MINVAL 328
-#define TOK_PUBLIC 329
-#define TOK_PRIVATE 330
-#define TOK_ALLOCATABLE 331
-#define TOK_RETURN 332
-#define TOK_THEN 333
-#define TOK_ELSEIF 334
-#define TOK_ELSE 335
-#define TOK_ENDIF 336
-#define TOK_PRINT 337
-#define TOK_PLAINGOTO 338
-#define TOK_CONSTRUCTID 339
-#define TOK_LOGICALIF 340
-#define TOK_PLAINDO 341
-#define TOK_CONTAINS 342
-#define TOK_ENDDO 343
-#define TOK_MODULE 344
-#define TOK_ENDMODULE 345
-#define TOK_DOWHILE 346
-#define TOK_ALLOCATE 347
-#define TOK_OPEN 348
-#define TOK_CLOSE 349
-#define TOK_INQUIRE 350
-#define TOK_WRITE 351
-#define TOK_READ 352
-#define TOK_REWIND 353
-#define TOK_DEALLOCATE 354
-#define TOK_NULLIFY 355
-#define TOK_FIN 356
-#define TOK_DEBUT 357
-#define TOK_DIMENSION 358
-#define TOK_ENDSELECT 359
-#define TOK_EXTERNAL 360
-#define TOK_INTENT 361
-#define TOK_INTRINSIC 362
-#define TOK_NAMELIST 363
-#define TOK_CASEDEFAULT 364
-#define TOK_OPTIONAL 365
-#define TOK_POINTER 366
-#define TOK_CONTINUE 367
-#define TOK_SAVE 368
-#define TOK_TARGET 369
-#define TOK_QUOTE 370
-#define TOK_IMPLICIT 371
-#define TOK_NONE 372
-#define TOK_CALL 373
-#define TOK_STAT 374
-#define TOK_POINT_TO 375
-#define TOK_COMMON 376
-#define TOK_GLOBAL 377
-#define TOK_INTERFACE 378
-#define TOK_ENDINTERFACE 379
-#define TOK_LEFTAB 380
-#define TOK_RIGHTAB 381
-#define TOK_PAUSE 382
-#define TOK_PROCEDURE 383
-#define TOK_STOP 384
-#define TOK_NAMEEQ 385
-#define TOK_REAL8 386
-#define TOK_OUT 387
-#define TOK_INOUT 388
-#define TOK_IN 389
-#define TOK_USE 390
-#define TOK_TRUE 391
-#define TOK_FALSE 392
-#define TOK_LABEL 393
-#define TOK_TYPE 394
-#define TOK_TYPEPAR 395
-#define TOK_ENDTYPE 396
-#define TOK_REAL 397
-#define TOK_INTEGER 398
-#define TOK_LOGICAL 399
-#define TOK_DOUBLEPRECISION 400
-#define TOK_DOUBLEREAL 401
-#define TOK_ENDSUBROUTINE 402
-#define TOK_ENDFUNCTION 403
-#define TOK_ENDPROGRAM 404
-#define TOK_ENDUNIT 405
-#define TOK_CHARACTER 406
-#define TOK_CHAR_CONSTANT 407
-#define TOK_CHAR_CUT 408
-#define TOK_DATA 409
-#define TOK_CHAR_INT 410
-#define TOK_CHAR_MESSAGE 411
-#define TOK_CSTREAL 412
-#define TOK_CSTREALDP 413
-#define TOK_CSTREALQP 414
-#define TOK_SFREAL 415
-#define TOK_COMPLEX 416
-#define TOK_DOUBLECOMPLEX 417
-#define TOK_NAME 418
-#define TOK_NAME_CHAR 419
-#define TOK_PROBTYPE 420
-#define TOK_INTERPTYPE 421
-#define TOK_VARTYPE 422
-#define TOK_BC 423
-#define TOK_OP 424
-#define TOK_CSTINT 425
-#define TOK_COMMENT 426
-#define TOK_FILENAME 427
-
-
-
+#define yyparse         fortran_parse
+#define yylex           fortran_lex
+#define yyerror         fortran_error
+#define yylval          fortran_lval
+#define yychar          fortran_char
+#define yydebug         fortran_debug
+#define yynerrs         fortran_nerrs
 
 /* Copy the first part of user declarations.  */
+/* Line 371 of yacc.c  */
 #line 36 "fortran.y"
 
@@ -430,25 +77,36 @@
 #include <string.h>
 #include "decl.h"
-extern int line_num_fortran;
-extern int line_num_fortran_common;
-char *tmp;
-char c_selectorname[LONG_C];
-char ligne[LONG_C];
-char truename[LONGNOM];
-char identcopy[LONG_C];
+
+extern int line_num_input;
+extern char *fortran_text;
+
+char c_selectorname[LONG_M];
+char ligne[LONG_M];
+char truename[LONG_VNAME];
+char identcopy[LONG_VNAME];
 int c_selectorgiven=0;
-int incom;
 listvar *curlistvar;
 typedim c_selectordim;
 listcouple *coupletmp;
-listdim *parcoursdim;
 int removeline=0;
 listvar *test;
 
-
-/* Enabling traces.  */
-#ifndef YYDEBUG
-# define YYDEBUG 0
-#endif
+int fortran_error(const char *s)
+{
+    printf("%s line %d, file %s motclef = |%s|\n", s, line_num_input, cur_filename, fortran_text);
+    exit(1);
+}
+
+
+/* Line 371 of yacc.c  */
+#line 104 "fortran.tab.c"
+
+# ifndef YY_NULL
+#  if defined __cplusplus && 201103L <= __cplusplus
+#   define YY_NULL nullptr
+#  else
+#   define YY_NULL 0
+#  endif
+# endif
 
 /* Enabling verbose error messages.  */
@@ -460,38 +118,221 @@
 #endif
 
-/* Enabling the token table.  */
-#ifndef YYTOKEN_TABLE
-# define YYTOKEN_TABLE 0
+
+/* Enabling traces.  */
+#ifndef YYDEBUG
+# define YYDEBUG 1
 #endif
+#if YYDEBUG
+extern int fortran_debug;
+#endif
+
+/* Tokens.  */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+   /* Put the tokens into the symbol table, so that GDB and other debuggers
+      know about them.  */
+   enum yytokentype {
+     TOK_NEQV = 258,
+     TOK_EQV = 259,
+     TOK_XOR = 260,
+     TOK_OR = 261,
+     TOK_AND = 262,
+     TOK_NOT = 263,
+     TOK_NE = 264,
+     TOK_EQ = 265,
+     TOK_GE = 266,
+     TOK_LE = 267,
+     TOK_GT = 268,
+     TOK_LT = 269,
+     TOK_DSLASH = 270,
+     TOK_SLASH = 271,
+     TOK_DASTER = 272,
+     TOK_SEMICOLON = 273,
+     TOK_PARAMETER = 274,
+     TOK_RESULT = 275,
+     TOK_ONLY = 276,
+     TOK_INCLUDE = 277,
+     TOK_SUBROUTINE = 278,
+     TOK_PROGRAM = 279,
+     TOK_FUNCTION = 280,
+     TOK_FORMAT = 281,
+     TOK_MAX = 282,
+     TOK_TANH = 283,
+     TOK_WHERE = 284,
+     TOK_ELSEWHEREPAR = 285,
+     TOK_ELSEWHERE = 286,
+     TOK_ENDWHERE = 287,
+     TOK_MAXVAL = 288,
+     TOK_TRIM = 289,
+     TOK_NULL_PTR = 290,
+     TOK_SUM = 291,
+     TOK_SQRT = 292,
+     TOK_CASE = 293,
+     TOK_SELECTCASE = 294,
+     TOK_FILE = 295,
+     TOK_UNIT = 296,
+     TOK_FMT = 297,
+     TOK_NML = 298,
+     TOK_END = 299,
+     TOK_EOR = 300,
+     TOK_ERR = 301,
+     TOK_EXIST = 302,
+     TOK_MIN = 303,
+     TOK_FLOAT = 304,
+     TOK_EXP = 305,
+     TOK_COS = 306,
+     TOK_COSH = 307,
+     TOK_ACOS = 308,
+     TOK_NINT = 309,
+     TOK_CYCLE = 310,
+     TOK_SIN = 311,
+     TOK_SINH = 312,
+     TOK_ASIN = 313,
+     TOK_EQUIVALENCE = 314,
+     TOK_BACKSPACE = 315,
+     TOK_LOG = 316,
+     TOK_TAN = 317,
+     TOK_ATAN = 318,
+     TOK_RECURSIVE = 319,
+     TOK_ABS = 320,
+     TOK_MOD = 321,
+     TOK_SIGN = 322,
+     TOK_MINLOC = 323,
+     TOK_MAXLOC = 324,
+     TOK_EXIT = 325,
+     TOK_MINVAL = 326,
+     TOK_PUBLIC = 327,
+     TOK_PRIVATE = 328,
+     TOK_ALLOCATABLE = 329,
+     TOK_RETURN = 330,
+     TOK_THEN = 331,
+     TOK_ELSEIF = 332,
+     TOK_ELSE = 333,
+     TOK_ENDIF = 334,
+     TOK_PRINT = 335,
+     TOK_PLAINGOTO = 336,
+     TOK_LOGICALIF = 337,
+     TOK_PLAINDO = 338,
+     TOK_CONTAINS = 339,
+     TOK_ENDDO = 340,
+     TOK_MODULE = 341,
+     TOK_ENDMODULE = 342,
+     TOK_WHILE = 343,
+     TOK_CONCURRENT = 344,
+     TOK_ALLOCATE = 345,
+     TOK_OPEN = 346,
+     TOK_CLOSE = 347,
+     TOK_INQUIRE = 348,
+     TOK_WRITE = 349,
+     TOK_FLUSH = 350,
+     TOK_READ = 351,
+     TOK_REWIND = 352,
+     TOK_DEALLOCATE = 353,
+     TOK_NULLIFY = 354,
+     TOK_DIMENSION = 355,
+     TOK_ENDSELECT = 356,
+     TOK_EXTERNAL = 357,
+     TOK_INTENT = 358,
+     TOK_INTRINSIC = 359,
+     TOK_NAMELIST = 360,
+     TOK_DEFAULT = 361,
+     TOK_OPTIONAL = 362,
+     TOK_POINTER = 363,
+     TOK_CONTINUE = 364,
+     TOK_SAVE = 365,
+     TOK_TARGET = 366,
+     TOK_IMPLICIT = 367,
+     TOK_NONE = 368,
+     TOK_CALL = 369,
+     TOK_STAT = 370,
+     TOK_POINT_TO = 371,
+     TOK_COMMON = 372,
+     TOK_GLOBAL = 373,
+     TOK_LEFTAB = 374,
+     TOK_RIGHTAB = 375,
+     TOK_PAUSE = 376,
+     TOK_PROCEDURE = 377,
+     TOK_STOP = 378,
+     TOK_REAL8 = 379,
+     TOK_FOURDOTS = 380,
+     TOK_HEXA = 381,
+     TOK_ASSIGNTYPE = 382,
+     TOK_OUT = 383,
+     TOK_INOUT = 384,
+     TOK_IN = 385,
+     TOK_USE = 386,
+     TOK_TRUE = 387,
+     TOK_FALSE = 388,
+     TOK_LABEL = 389,
+     TOK_TYPE = 390,
+     TOK_TYPEPAR = 391,
+     TOK_ENDTYPE = 392,
+     TOK_REAL = 393,
+     TOK_INTEGER = 394,
+     TOK_LOGICAL = 395,
+     TOK_DOUBLEPRECISION = 396,
+     TOK_ENDSUBROUTINE = 397,
+     TOK_ENDFUNCTION = 398,
+     TOK_ENDPROGRAM = 399,
+     TOK_ENDUNIT = 400,
+     TOK_CHARACTER = 401,
+     TOK_CHAR_CONSTANT = 402,
+     TOK_CHAR_CUT = 403,
+     TOK_DATA = 404,
+     TOK_CHAR_MESSAGE = 405,
+     TOK_CSTREAL = 406,
+     TOK_COMPLEX = 407,
+     TOK_DOUBLECOMPLEX = 408,
+     TOK_NAME = 409,
+     TOK_CSTINT = 410
+   };
+#endif
+
 
 #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
 typedef union YYSTYPE
-#line 59 "fortran.y"
 {
-       char      nac[LONG_C];
-       char      na[LONGNOM];
-       listdim  *d;
-       listvar  *l;
-       listnom  *ln;
-       listcouple  *lc;
-       listname *lnn;
-       typedim   dim1;
-       variable *v;
-       }
-/* Line 193 of yacc.c.  */
-#line 483 "fortran.tab.c"
-	YYSTYPE;
+/* Line 387 of yacc.c  */
+#line 65 "fortran.y"
+
+    char        na[LONG_M];
+    listdim     *d;
+    listvar     *l;
+    listcouple  *lc;
+    listname    *lnn;
+    typedim     dim1;
+    variable    *v;
+
+
+/* Line 387 of yacc.c  */
+#line 310 "fortran.tab.c"
+} YYSTYPE;
+# define YYSTYPE_IS_TRIVIAL 1
 # define yystype YYSTYPE /* obsolescent; will be withdrawn */
 # define YYSTYPE_IS_DECLARED 1
-# define YYSTYPE_IS_TRIVIAL 1
 #endif
 
+extern YYSTYPE fortran_lval;
+
+#ifdef YYPARSE_PARAM
+#if defined __STDC__ || defined __cplusplus
+int fortran_parse (void *YYPARSE_PARAM);
+#else
+int fortran_parse ();
+#endif
+#else /* ! YYPARSE_PARAM */
+#if defined __STDC__ || defined __cplusplus
+int fortran_parse (void);
+#else
+int fortran_parse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
 
 
 /* Copy the second part of user declarations.  */
 
-
-/* Line 216 of yacc.c.  */
-#line 496 "fortran.tab.c"
+/* Line 390 of yacc.c  */
+#line 338 "fortran.tab.c"
 
 #ifdef short
@@ -546,9 +387,9 @@
 #  if ENABLE_NLS
 #   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
-#   define YY_(msgid) dgettext ("bison-runtime", msgid)
+#   define YY_(Msgid) dgettext ("bison-runtime", Msgid)
 #  endif
 # endif
 # ifndef YY_
-#  define YY_(msgid) msgid
+#  define YY_(Msgid) Msgid
 # endif
 #endif
@@ -556,24 +397,24 @@
 /* Suppress unused-variable warnings by "using" E.  */
 #if ! defined lint || defined __GNUC__
-# define YYUSE(e) ((void) (e))
+# define YYUSE(E) ((void) (E))
 #else
-# define YYUSE(e) /* empty */
+# define YYUSE(E) /* empty */
 #endif
 
 /* Identity function, used to suppress warnings about constant conditions.  */
 #ifndef lint
-# define YYID(n) (n)
+# define YYID(N) (N)
 #else
 #if (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 static int
-YYID (int i)
+YYID (int yyi)
 #else
 static int
-YYID (i)
-    int i;
+YYID (yyi)
+    int yyi;
 #endif
 {
-  return i;
+  return yyi;
 }
 #endif
@@ -596,9 +437,10 @@
 #   else
 #    define YYSTACK_ALLOC alloca
-#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+#    if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 #     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-#     ifndef _STDLIB_H
-#      define _STDLIB_H 1
+      /* Use EXIT_SUCCESS as a witness for stdlib.h.  */
+#     ifndef EXIT_SUCCESS
+#      define EXIT_SUCCESS 0
 #     endif
 #    endif
@@ -623,15 +465,15 @@
 #   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
 #  endif
-#  if (defined __cplusplus && ! defined _STDLIB_H \
+#  if (defined __cplusplus && ! defined EXIT_SUCCESS \
        && ! ((defined YYMALLOC || defined malloc) \
 	     && (defined YYFREE || defined free)))
 #   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-#   ifndef _STDLIB_H
-#    define _STDLIB_H 1
+#   ifndef EXIT_SUCCESS
+#    define EXIT_SUCCESS 0
 #   endif
 #  endif
 #  ifndef YYMALLOC
 #   define YYMALLOC malloc
-#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+#   if ! defined malloc && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
@@ -640,5 +482,5 @@
 #  ifndef YYFREE
 #   define YYFREE free
-#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+#   if ! defined free && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 void free (void *); /* INFRINGES ON USER NAME SPACE */
@@ -656,7 +498,7 @@
 union yyalloc
 {
-  yytype_int16 yyss;
-  YYSTYPE yyvs;
-  };
+  yytype_int16 yyss_alloc;
+  YYSTYPE yyvs_alloc;
+};
 
 /* The size of the maximum gap between one aligned stack and the next.  */
@@ -669,21 +511,5 @@
       + YYSTACK_GAP_MAXIMUM)
 
-/* Copy COUNT objects from FROM to TO.  The source and destination do
-   not overlap.  */
-# ifndef YYCOPY
-#  if defined __GNUC__ && 1 < __GNUC__
-#   define YYCOPY(To, From, Count) \
-      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
-#  else
-#   define YYCOPY(To, From, Count)		\
-      do					\
-	{					\
-	  YYSIZE_T yyi;				\
-	  for (yyi = 0; yyi < (Count); yyi++)	\
-	    (To)[yyi] = (From)[yyi];		\
-	}					\
-      while (YYID (0))
-#  endif
-# endif
+# define YYCOPY_NEEDED 1
 
 /* Relocate STACK from its old location to the new one.  The
@@ -692,10 +518,10 @@
    stack.  Advance YYPTR to a properly aligned location for the next
    stack.  */
-# define YYSTACK_RELOCATE(Stack)					\
+# define YYSTACK_RELOCATE(Stack_alloc, Stack)				\
     do									\
       {									\
 	YYSIZE_T yynewbytes;						\
-	YYCOPY (&yyptr->Stack, Stack, yysize);				\
-	Stack = &yyptr->Stack;						\
+	YYCOPY (&yyptr->Stack_alloc, Stack, yysize);			\
+	Stack = &yyptr->Stack_alloc;					\
 	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
 	yyptr += yynewbytes / sizeof (*yyptr);				\
@@ -705,21 +531,41 @@
 #endif
 
+#if defined YYCOPY_NEEDED && YYCOPY_NEEDED
+/* Copy COUNT objects from SRC to DST.  The source and destination do
+   not overlap.  */
+# ifndef YYCOPY
+#  if defined __GNUC__ && 1 < __GNUC__
+#   define YYCOPY(Dst, Src, Count) \
+      __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src)))
+#  else
+#   define YYCOPY(Dst, Src, Count)              \
+      do                                        \
+        {                                       \
+          YYSIZE_T yyi;                         \
+          for (yyi = 0; yyi < (Count); yyi++)   \
+            (Dst)[yyi] = (Src)[yyi];            \
+        }                                       \
+      while (YYID (0))
+#  endif
+# endif
+#endif /* !YYCOPY_NEEDED */
+
 /* YYFINAL -- State number of the termination state.  */
 #define YYFINAL  2
 /* YYLAST -- Last index in YYTABLE.  */
-#define YYLAST   6070
+#define YYLAST   6268
 
 /* YYNTOKENS -- Number of terminals.  */
-#define YYNTOKENS  190
+#define YYNTOKENS  169
 /* YYNNTS -- Number of nonterminals.  */
-#define YYNNTS  184
+#define YYNNTS  206
 /* YYNRULES -- Number of rules.  */
-#define YYNRULES  555
+#define YYNRULES  597
 /* YYNRULES -- Number of states.  */
-#define YYNSTATES  982
+#define YYNSTATES  1051
 
 /* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
 #define YYUNDEFTOK  2
-#define YYMAXUTOK   427
+#define YYMAXUTOK   410
 
 #define YYTRANSLATE(YYX)						\
@@ -730,13 +576,13 @@
 {
        0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-     187,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     166,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,   183,     2,     2,     2,   189,     2,     2,
-     179,   180,    23,    21,     3,    22,     2,   188,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,   168,     2,     2,
+     162,   163,    21,    19,     3,    20,     2,   167,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     4,     2,
-     185,     5,   186,     2,     2,     2,     2,     2,     2,     2,
+     164,     5,   165,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,   181,     2,   182,     2,   184,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
@@ -756,5 +602,5 @@
        2,     2,     2,     2,     2,     2,     1,     2,     6,     7,
        8,     9,    10,    11,    12,    13,    14,    15,    16,    17,
-      18,    19,    20,    24,    25,    26,    27,    28,    29,    30,
+      18,    22,    23,    24,    25,    26,    27,    28,    29,    30,
       31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
       41,    42,    43,    44,    45,    46,    47,    48,    49,    50,
@@ -770,6 +616,5 @@
      141,   142,   143,   144,   145,   146,   147,   148,   149,   150,
      151,   152,   153,   154,   155,   156,   157,   158,   159,   160,
-     161,   162,   163,   164,   165,   166,   167,   168,   169,   170,
-     171,   172,   173,   174,   175,   176,   177,   178
+     161
 };
 
@@ -779,60 +624,64 @@
 static const yytype_uint16 yyprhs[] =
 {
-       0,     0,     3,     4,     7,    10,    13,    15,    19,    23,
-      25,    29,    32,    35,    39,    43,    46,    49,    52,    54,
-      56,    58,    60,    61,    62,    65,    66,    68,    69,    70,
-      72,    73,    78,    81,    88,    93,    96,    98,    99,   101,
-     103,   104,   107,   111,   112,   115,   119,   121,   125,   127,
-     129,   132,   137,   140,   143,   148,   151,   153,   155,   157,
-     159,   161,   163,   165,   167,   169,   171,   176,   180,   184,
-     187,   191,   192,   194,   196,   198,   200,   202,   204,   206,
-     208,   210,   212,   214,   216,   218,   220,   222,   224,   226,
-     228,   230,   232,   234,   236,   238,   240,   242,   244,   248,
-     252,   258,   260,   264,   268,   271,   276,   278,   282,   283,
-     286,   289,   293,   295,   297,   299,   304,   311,   316,   318,
-     322,   325,   329,   335,   339,   341,   342,   345,   347,   352,
-     356,   359,   363,   367,   371,   375,   376,   378,   381,   384,
-     388,   394,   398,   399,   402,   405,   407,   413,   419,   422,
-     426,   429,   433,   435,   439,   442,   446,   452,   454,   457,
-     459,   463,   466,   468,   472,   473,   475,   477,   481,   485,
-     488,   490,   494,   497,   500,   501,   508,   516,   517,   520,
-     523,   527,   531,   533,   534,   537,   542,   546,   550,   555,
-     558,   560,   562,   564,   566,   568,   570,   572,   574,   575,
-     578,   580,   584,   585,   588,   592,   594,   598,   601,   605,
-     607,   609,   611,   613,   614,   618,   619,   622,   627,   629,
-     633,   635,   637,   639,   642,   644,   649,   651,   653,   655,
-     657,   659,   661,   663,   665,   667,   669,   670,   674,   676,
-     680,   682,   684,   687,   690,   694,   696,   698,   700,   704,
-     706,   708,   712,   716,   721,   726,   730,   735,   740,   744,
-     749,   754,   759,   764,   769,   774,   779,   784,   789,   794,
-     799,   804,   809,   813,   818,   823,   828,   833,   835,   839,
-     841,   843,   845,   848,   851,   854,   856,   858,   861,   864,
-     867,   870,   873,   876,   879,   882,   885,   888,   891,   895,
-     898,   902,   905,   908,   911,   914,   917,   920,   923,   924,
-     926,   929,   932,   935,   937,   939,   941,   943,   944,   946,
-     949,   954,   960,   965,   969,   973,   975,   978,   980,   984,
-     986,   988,   992,   998,  1003,  1007,  1010,  1013,  1015,  1017,
-    1019,  1021,  1023,  1025,  1027,  1029,  1032,  1035,  1037,  1040,
-    1042,  1044,  1045,  1047,  1053,  1054,  1056,  1058,  1060,  1061,
-    1065,  1069,  1070,  1076,  1079,  1084,  1091,  1098,  1100,  1102,
-    1104,  1108,  1112,  1114,  1118,  1122,  1124,  1126,  1132,  1138,
-    1143,  1145,  1148,  1151,  1154,  1157,  1159,  1162,  1168,  1170,
-    1172,  1175,  1181,  1183,  1186,  1190,  1195,  1197,  1199,  1201,
-    1203,  1205,  1207,  1209,  1211,  1215,  1219,  1223,  1226,  1229,
-    1230,  1236,  1244,  1245,  1248,  1250,  1252,  1253,  1255,  1257,
-    1259,  1261,  1264,  1266,  1268,  1270,  1276,  1282,  1285,  1288,
-    1291,  1294,  1296,  1297,  1302,  1309,  1311,  1315,  1318,  1321,
-    1324,  1325,  1329,  1330,  1332,  1335,  1337,  1339,  1343,  1345,
-    1348,  1350,  1352,  1355,  1358,  1361,  1365,  1368,  1370,  1371,
-    1373,  1376,  1379,  1380,  1383,  1387,  1391,  1395,  1399,  1401,
-    1405,  1407,  1409,  1413,  1415,  1417,  1419,  1423,  1426,  1431,
-    1436,  1439,  1442,  1444,  1446,  1448,  1450,  1452,  1454,  1456,
-    1458,  1460,  1464,  1466,  1468,  1472,  1476,  1480,  1484,  1487,
-    1491,  1494,  1497,  1500,  1503,  1507,  1509,  1511,  1513,  1515,
-    1519,  1520,  1522,  1525,  1530,  1533,  1536,  1542,  1543,  1545,
-    1548,  1550,  1552,  1554,  1558,  1562,  1566,  1570,  1574,  1578,
-    1580,  1582,  1584,  1588,  1594,  1600,  1606,  1612,  1620,  1622,
-    1631,  1634,  1636,  1638,  1642,  1644,  1646,  1648,  1653,  1655,
-    1659,  1660,  1665,  1667,  1671,  1675
+       0,     0,     3,     4,     7,     9,    11,    14,    16,    19,
+      21,    25,    28,    31,    33,    37,    41,    44,    47,    51,
+      53,    54,    55,    57,    58,    61,    66,    69,    75,    78,
+      80,    83,    85,    87,    88,    91,    95,    96,    99,   103,
+     105,   109,   111,   113,   116,   121,   124,   127,   132,   135,
+     137,   139,   141,   143,   145,   147,   149,   151,   153,   158,
+     162,   166,   169,   172,   173,   175,   177,   179,   181,   183,
+     185,   187,   189,   191,   193,   195,   197,   199,   201,   203,
+     205,   207,   209,   211,   213,   215,   217,   219,   221,   223,
+     225,   229,   233,   239,   241,   245,   249,   252,   257,   259,
+     263,   264,   266,   269,   273,   275,   277,   280,   282,   286,
+     291,   296,   305,   307,   311,   314,   318,   324,   328,   330,
+     331,   334,   336,   341,   345,   348,   352,   356,   360,   364,
+     365,   367,   370,   374,   380,   384,   386,   392,   398,   401,
+     405,   408,   412,   414,   416,   420,   424,   427,   431,   437,
+     439,   442,   444,   448,   451,   453,   457,   458,   460,   462,
+     466,   470,   473,   475,   479,   482,   485,   491,   498,   499,
+     502,   505,   509,   513,   514,   517,   522,   526,   530,   535,
+     538,   540,   542,   544,   546,   548,   550,   552,   553,   556,
+     558,   562,   563,   566,   570,   572,   576,   579,   583,   585,
+     587,   589,   591,   593,   594,   598,   599,   601,   605,   607,
+     611,   613,   615,   617,   620,   622,   627,   629,   631,   633,
+     635,   637,   639,   641,   643,   645,   647,   648,   652,   654,
+     658,   660,   662,   665,   668,   672,   674,   676,   678,   680,
+     682,   686,   690,   694,   699,   704,   708,   713,   718,   722,
+     727,   732,   737,   742,   747,   752,   757,   762,   767,   772,
+     777,   782,   787,   791,   796,   800,   805,   810,   812,   816,
+     818,   820,   822,   825,   828,   831,   833,   835,   838,   841,
+     844,   847,   850,   853,   856,   859,   862,   866,   870,   873,
+     876,   879,   882,   885,   888,   891,   894,   897,   900,   901,
+     903,   906,   909,   912,   914,   916,   918,   920,   921,   923,
+     926,   931,   937,   942,   947,   951,   953,   956,   958,   962,
+     964,   966,   970,   976,   981,   985,   988,   991,   993,   995,
+     997,   999,  1001,  1003,  1005,  1007,  1010,  1013,  1015,  1018,
+    1020,  1022,  1023,  1025,  1031,  1032,  1034,  1036,  1038,  1039,
+    1042,  1045,  1051,  1054,  1059,  1066,  1073,  1075,  1077,  1081,
+    1085,  1087,  1091,  1095,  1097,  1099,  1101,  1103,  1105,  1107,
+    1109,  1111,  1113,  1116,  1118,  1120,  1123,  1126,  1129,  1133,
+    1136,  1142,  1148,  1151,  1154,  1157,  1160,  1162,  1167,  1169,
+    1172,  1175,  1178,  1181,  1183,  1185,  1187,  1189,  1195,  1202,
+    1203,  1207,  1208,  1213,  1214,  1219,  1224,  1226,  1228,  1230,
+    1232,  1234,  1238,  1243,  1245,  1248,  1250,  1253,  1254,  1255,
+    1258,  1262,  1264,  1269,  1271,  1273,  1278,  1281,  1287,  1291,
+    1295,  1297,  1302,  1305,  1312,  1321,  1327,  1331,  1333,  1335,
+    1337,  1339,  1341,  1344,  1351,  1352,  1354,  1357,  1361,  1362,
+    1364,  1367,  1371,  1379,  1385,  1391,  1398,  1400,  1403,  1405,
+    1408,  1414,  1419,  1420,  1422,  1425,  1429,  1436,  1441,  1444,
+    1448,  1450,  1453,  1457,  1459,  1461,  1465,  1467,  1470,  1473,
+    1477,  1479,  1481,  1483,  1485,  1487,  1489,  1491,  1493,  1495,
+    1496,  1501,  1509,  1511,  1515,  1518,  1521,  1524,  1525,  1529,
+    1530,  1532,  1535,  1538,  1540,  1542,  1546,  1548,  1551,  1553,
+    1555,  1556,  1558,  1561,  1564,  1565,  1568,  1572,  1576,  1580,
+    1582,  1586,  1588,  1590,  1594,  1596,  1598,  1600,  1604,  1610,
+    1615,  1618,  1621,  1622,  1624,  1626,  1628,  1630,  1632,  1634,
+    1636,  1638,  1640,  1644,  1646,  1648,  1652,  1656,  1660,  1664,
+    1667,  1671,  1674,  1677,  1680,  1683,  1686,  1689,  1692,  1696,
+    1698,  1700,  1702,  1704,  1708,  1711,  1716,  1719,  1722,  1728,
+    1729,  1731,  1734,  1736,  1738,  1740,  1742,  1746,  1750,  1754,
+    1758,  1762,  1766,  1772,  1778,  1784,  1790,  1798,  1807,  1810,
+    1812,  1816,  1818,  1820,  1824,  1825,  1830,  1832
 };
 
@@ -840,172 +689,188 @@
 static const yytype_int16 yyrhs[] =
 {
-     191,     0,    -1,    -1,   191,   192,    -1,   187,   198,    -1,
-     199,   193,    -1,   177,    -1,   197,   200,   205,    -1,     1,
-     205,   201,    -1,   194,    -1,   193,    27,   194,    -1,   203,
-     196,    -1,   212,   196,    -1,   206,   207,   196,    -1,   315,
-     200,   205,    -1,   195,   196,    -1,   298,     4,    -1,   198,
-     200,    -1,    53,    -1,    54,    -1,    36,    -1,    37,    -1,
-      -1,    -1,   144,   201,    -1,    -1,   177,    -1,    -1,    -1,
-      72,    -1,    -1,   202,    33,   204,   208,    -1,    34,   204,
-      -1,   202,    35,   204,   208,    30,   209,    -1,   202,    35,
-     204,   208,    -1,    95,   169,    -1,   169,    -1,    -1,    32,
-      -1,   158,    -1,    -1,   179,   180,    -1,   179,   210,   180,
-      -1,    -1,   179,   180,    -1,   179,   210,   180,    -1,   211,
-      -1,   210,     3,   211,    -1,   169,    -1,    23,    -1,   257,
-     222,    -1,   145,   213,   221,   324,    -1,   147,   324,    -1,
-     117,   216,    -1,   224,   179,   249,   180,    -1,   224,   249,
-      -1,   243,    -1,   228,    -1,   253,    -1,   239,    -1,   241,
-      -1,   240,    -1,   308,    -1,   251,    -1,   237,    -1,   234,
-      -1,    68,   179,   280,   180,    -1,   111,   221,   242,    -1,
-     113,   221,   215,    -1,    67,   217,    -1,   225,   226,   187,
-      -1,    -1,   275,    -1,    46,    -1,    40,    -1,    44,    -1,
-      56,    -1,    79,    -1,    45,    -1,    47,    -1,    62,    -1,
-      57,    -1,    58,    -1,    59,    -1,    60,    -1,    61,    -1,
-      64,    -1,    65,    -1,    66,    -1,    69,    -1,    70,    -1,
-      71,    -1,    74,    -1,    75,    -1,    76,    -1,    77,    -1,
-     169,    -1,   214,    -1,   215,     3,   214,    -1,   179,   220,
-     180,    -1,   216,     3,   179,   220,   180,    -1,   218,    -1,
-     217,     3,   218,    -1,   179,   219,   180,    -1,   298,   276,
-      -1,   219,     3,   298,   276,    -1,   280,    -1,   220,     3,
-     280,    -1,    -1,     4,     4,    -1,   255,   256,    -1,   223,
-     204,   208,    -1,    35,    -1,    29,    -1,   160,    -1,   169,
-      24,   227,    24,    -1,   226,   248,   169,    24,   227,    24,
-      -1,   231,    24,   227,    24,    -1,   232,    -1,   232,     3,
-     227,    -1,   229,   230,    -1,   229,   247,   230,    -1,   228,
-     248,   247,   248,   230,    -1,   228,     3,   230,    -1,   119,
-      -1,    -1,   169,   276,    -1,   169,    -1,   169,   179,   280,
-     180,    -1,   231,     3,   231,    -1,   233,   299,    -1,   232,
-      21,   232,    -1,   232,    22,   232,    -1,   232,    23,   232,
-      -1,   232,   188,   232,    -1,    -1,   284,    -1,   235,   236,
-      -1,   114,   298,    -1,   114,   247,   298,    -1,   235,   248,
-     247,   248,   298,    -1,   235,     3,   298,    -1,    -1,   129,
-     324,    -1,   130,   324,    -1,   109,    -1,   238,   248,   169,
-     276,   264,    -1,   239,     3,   169,   276,   264,    -1,    81,
-     187,    -1,    81,   221,   242,    -1,    80,   187,    -1,    80,
-     221,   242,    -1,   169,    -1,   242,     3,   169,    -1,   244,
-     245,    -1,   244,   247,   245,    -1,   243,   248,   247,   248,
-     245,    -1,   127,    -1,   128,   127,    -1,   246,    -1,   245,
-       3,   246,    -1,   169,   276,    -1,    20,    -1,    24,   169,
-      24,    -1,    -1,     3,    -1,   250,    -1,   249,     3,   250,
-      -1,   169,     5,   280,    -1,   134,   252,    -1,   169,    -1,
-     252,     3,   169,    -1,   122,   123,    -1,   122,   137,    -1,
-      -1,   271,   254,   169,   276,   264,   305,    -1,   255,     3,
-     254,   169,   276,   264,   305,    -1,    -1,   262,   266,    -1,
-     261,   259,    -1,   263,    23,   176,    -1,   258,   268,   180,
-      -1,   146,    -1,    -1,    23,   176,    -1,    23,   179,   260,
-     180,    -1,   179,   260,   180,    -1,   169,   269,   270,    -1,
-     169,     5,   269,   270,    -1,   269,   270,    -1,   157,    -1,
-     263,    -1,   149,    -1,   148,    -1,   167,    -1,   151,    -1,
-     168,    -1,   150,    -1,    -1,    23,   265,    -1,   280,    -1,
-     179,    23,   180,    -1,    -1,    23,   267,    -1,   179,   268,
-     180,    -1,   280,    -1,   179,    23,   180,    -1,   169,   269,
-      -1,   169,     5,   269,    -1,   169,    -1,   176,    -1,   280,
-      -1,    23,    -1,    -1,     3,   169,   269,    -1,    -1,     4,
-       4,    -1,     3,   272,     4,     4,    -1,   273,    -1,   272,
-       3,   273,    -1,    29,    -1,   275,    -1,    82,    -1,   109,
-     276,    -1,   111,    -1,   112,   179,   274,   180,    -1,   113,
-      -1,   116,    -1,   117,    -1,   119,    -1,   120,    -1,   140,
-      -1,   138,    -1,   139,    -1,    80,    -1,    81,    -1,    -1,
-     179,   277,   180,    -1,   278,    -1,   277,     3,   278,    -1,
-     279,    -1,     4,    -1,   280,     4,    -1,     4,   280,    -1,
-     280,     4,   279,    -1,    23,    -1,   280,    -1,   283,    -1,
-     179,   280,   180,    -1,   307,    -1,   281,    -1,    46,   282,
-     180,    -1,    39,   282,   180,    -1,    40,   179,   282,   180,
-      -1,    44,   179,   282,   180,    -1,    56,   282,   180,    -1,
-      79,   179,   282,   180,    -1,    45,   179,   280,   180,    -1,
-      47,   280,   180,    -1,   148,   179,   282,   180,    -1,    62,
-     179,   280,   180,    -1,    57,   179,   280,   180,    -1,    58,
-     179,   280,   180,    -1,    59,   179,   280,   180,    -1,    60,
-     179,   280,   180,    -1,    61,   179,   280,   180,    -1,    64,
-     179,   280,   180,    -1,    65,   179,   280,   180,    -1,    66,
-     179,   280,   180,    -1,    69,   179,   280,   180,    -1,    70,
-     179,   280,   180,    -1,    71,   179,   280,   180,    -1,    73,
-     280,   180,    -1,    74,   179,   282,   180,    -1,    75,   179,
-     282,   180,    -1,    76,   179,   282,   180,    -1,    77,   179,
-     282,   180,    -1,   280,    -1,   282,     3,   280,    -1,   288,
-      -1,   299,    -1,   293,    -1,   280,   285,    -1,   284,   280,
-      -1,    12,   280,    -1,    21,    -1,    22,    -1,    21,   280,
-      -1,    22,   280,    -1,    23,   280,    -1,    25,   280,    -1,
-      14,   280,    -1,     8,   280,    -1,    17,   280,    -1,   186,
-     280,    -1,    18,   280,    -1,   185,   280,    -1,    15,   280,
-      -1,   186,     5,   280,    -1,    16,   280,    -1,   185,     5,
-     280,    -1,    13,   280,    -1,     7,   280,    -1,     9,   280,
-      -1,    10,   280,    -1,    11,   280,    -1,    24,   286,    -1,
-       5,   287,    -1,    -1,   280,    -1,     5,   280,    -1,    24,
-     280,    -1,     5,   280,    -1,   280,    -1,   298,    -1,   292,
-      -1,   290,    -1,    -1,   291,    -1,   291,   302,    -1,   292,
-     179,   294,   180,    -1,   292,   179,   294,   180,   302,    -1,
-     298,   179,   294,   180,    -1,   288,   189,   288,    -1,   131,
-     360,   132,    -1,   289,    -1,   289,   295,    -1,   296,    -1,
-     295,     3,   296,    -1,   280,    -1,   297,    -1,   280,     4,
-     280,    -1,   280,     4,   280,     4,   280,    -1,     4,   280,
-       4,   280,    -1,     4,     4,   280,    -1,     4,   280,    -1,
-     280,     4,    -1,     4,    -1,   169,    -1,   142,    -1,   143,
-      -1,   176,    -1,   163,    -1,   164,    -1,   165,    -1,   299,
-     169,    -1,   300,   301,    -1,   158,    -1,   300,   158,    -1,
-     162,    -1,   159,    -1,    -1,   302,    -1,   179,   303,     4,
-     303,   180,    -1,    -1,   280,    -1,   187,    -1,   280,    -1,
-      -1,   306,     5,   280,    -1,   306,   126,   280,    -1,    -1,
-     179,   283,     3,   283,   180,    -1,   309,   310,    -1,   309,
-     310,     3,   311,    -1,   309,   310,     3,    31,     4,   187,
-      -1,   309,   310,     3,    31,     4,   313,    -1,   141,    -1,
-     169,    -1,   312,    -1,   311,     3,   312,    -1,   169,   126,
-     169,    -1,   314,    -1,   313,     3,   314,    -1,   169,   126,
-     169,    -1,   169,    -1,   328,    -1,    98,   179,   366,   370,
-     180,    -1,   105,   179,   369,   370,   180,    -1,   106,   179,
-     371,   180,    -1,   317,    -1,   318,   324,    -1,   316,   324,
-      -1,   319,   324,    -1,    96,   324,    -1,   321,    -1,   372,
-     328,    -1,    41,   179,   280,   180,   304,    -1,    42,    -1,
-      43,    -1,   372,    84,    -1,    85,   179,   280,   180,    84,
-      -1,    86,    -1,    87,   324,    -1,    48,   320,   180,    -1,
-      49,   179,   280,   180,    -1,   115,    -1,   110,    -1,    93,
-      -1,   153,    -1,   156,    -1,   155,    -1,   154,    -1,   280,
-      -1,   320,     3,   280,    -1,   320,     4,   280,    -1,   326,
-     323,   322,    -1,   327,   280,    -1,    94,   325,    -1,    -1,
-     373,     5,   280,     3,   280,    -1,   373,     5,   280,     3,
-     280,     3,   280,    -1,    -1,   176,   248,    -1,   187,    -1,
-     169,    -1,    -1,   169,    -1,    92,    -1,    97,    -1,   118,
-      -1,   330,   332,    -1,   365,    -1,   341,    -1,   333,    -1,
-      98,   179,   366,   370,   180,    -1,   105,   179,   369,   370,
-     180,    -1,    78,   303,    -1,    83,   304,    -1,    63,   304,
-      -1,   340,   304,    -1,   331,    -1,    -1,   298,   329,   276,
-     276,    -1,   330,   189,   298,   329,   276,   276,    -1,   176,
-      -1,   331,     3,   176,    -1,     5,   280,    -1,   126,   280,
-      -1,   336,   334,    -1,    -1,   179,   335,   180,    -1,    -1,
-     338,    -1,   337,   169,    -1,   124,    -1,   339,    -1,   338,
-       3,   339,    -1,   280,    -1,    23,   364,    -1,   133,    -1,
-     135,    -1,   349,   345,    -1,   351,   343,    -1,   352,   345,
-      -1,   352,   345,   360,    -1,   104,   346,    -1,    38,    -1,
-      -1,   356,    -1,   345,   342,    -1,   350,   344,    -1,    -1,
-       3,   356,    -1,   179,   347,   180,    -1,   179,   353,   180,
-      -1,   179,   298,   180,    -1,   179,   176,   180,    -1,   176,
-      -1,   179,   283,   180,    -1,   169,    -1,   348,    -1,   347,
-       3,   348,    -1,   353,    -1,    23,    -1,    25,    -1,   298,
-     280,   276,    -1,   298,   280,    -1,   298,   280,   189,   330,
-      -1,   298,   179,   297,   180,    -1,   298,    23,    -1,   298,
-      25,    -1,    99,    -1,   100,    -1,   354,    -1,    23,    -1,
-     103,    -1,   101,    -1,    88,    -1,   102,    -1,   354,    -1,
-     179,   353,   180,    -1,   288,    -1,   299,    -1,   353,   355,
-     353,    -1,   353,    23,   353,    -1,   353,    24,   353,    -1,
-     353,    25,   353,    -1,   355,   353,    -1,   353,    20,   353,
-      -1,    50,   280,    -1,    55,   280,    -1,    52,   280,    -1,
-      51,   280,    -1,   169,     5,   280,    -1,   281,    -1,    21,
-      -1,    22,    -1,   358,    -1,   356,     3,   358,    -1,    -1,
-     288,    -1,   357,   359,    -1,   179,   356,   180,   359,    -1,
-     281,   359,    -1,   299,   359,    -1,   179,   356,     3,   363,
-     180,    -1,    -1,   285,    -1,   359,   285,    -1,   283,    -1,
-     362,    -1,   361,    -1,   283,     3,   280,    -1,   283,     3,
-     362,    -1,   362,     3,   280,    -1,   362,     3,   362,    -1,
-     361,     3,   280,    -1,   361,     3,   362,    -1,   283,    -1,
-     281,    -1,   307,    -1,   179,   280,   180,    -1,   179,   283,
-       3,   363,   180,    -1,   179,   362,     3,   363,   180,    -1,
-     179,   361,     3,   363,   180,    -1,   169,     5,   280,     3,
-     280,    -1,   169,     5,   280,     3,   280,     3,   280,    -1,
-     176,    -1,    89,   179,   280,     3,   280,   180,     3,   280,
-      -1,    89,   364,    -1,   367,    -1,   330,    -1,   366,     3,
-     367,    -1,   298,    -1,   292,    -1,   368,    -1,   298,   179,
-     295,   180,    -1,   367,    -1,   369,     3,   367,    -1,    -1,
-       3,   125,     5,   298,    -1,   298,    -1,   371,     3,   298,
-      -1,    91,   280,   180,    -1,   298,    -1
+     170,     0,    -1,    -1,   170,   171,    -1,   172,    -1,   173,
+      -1,   140,   173,    -1,     1,    -1,   166,   175,    -1,    24,
+      -1,   172,   166,   175,    -1,   172,    24,    -1,   172,   140,
+      -1,   174,    -1,   173,    24,   166,    -1,   173,    24,   174,
+      -1,   178,   175,    -1,   186,   175,    -1,    28,   181,   175,
+      -1,   282,    -1,    -1,    -1,    70,    -1,    -1,    26,   183,
+      -1,   176,    29,   180,   182,    -1,    30,   180,    -1,   176,
+      31,   180,   182,   177,    -1,    92,   160,    -1,   161,    -1,
+     179,   161,    -1,   160,    -1,   153,    -1,    -1,   162,   163,
+      -1,   162,   184,   163,    -1,    -1,   162,   163,    -1,   162,
+     184,   163,    -1,   185,    -1,   184,     3,   185,    -1,   160,
+      -1,    21,    -1,   228,   196,    -1,   141,   187,   195,   336,
+      -1,   143,   336,    -1,   114,   190,    -1,   198,   162,   221,
+     163,    -1,   198,   221,    -1,   215,    -1,   203,    -1,   225,
+      -1,   211,    -1,   213,    -1,   212,    -1,   276,    -1,   223,
+      -1,   209,    -1,    66,   162,   249,   163,    -1,   108,   195,
+     214,    -1,   110,   195,   189,    -1,    65,   191,    -1,   199,
+     166,    -1,    -1,   244,    -1,    42,    -1,    34,    -1,    39,
+      -1,    54,    -1,    77,    -1,    40,    -1,    43,    -1,    60,
+      -1,    55,    -1,    56,    -1,    57,    -1,    58,    -1,    59,
+      -1,    62,    -1,    63,    -1,    64,    -1,    67,    -1,    68,
+      -1,    69,    -1,    72,    -1,    73,    -1,    74,    -1,    75,
+      -1,   160,    -1,   188,    -1,   189,     3,   188,    -1,   162,
+     194,   163,    -1,   190,     3,   162,   194,   163,    -1,   192,
+      -1,   191,     3,   192,    -1,   162,   193,   163,    -1,   267,
+     245,    -1,   193,     3,   267,   245,    -1,   249,    -1,   194,
+       3,   249,    -1,    -1,   131,    -1,   226,   227,    -1,   197,
+     180,   182,    -1,    31,    -1,    25,    -1,   155,   200,    -1,
+     201,    -1,   200,   220,   201,    -1,   160,    22,   202,    22,
+      -1,   206,    22,   202,    22,    -1,   162,   257,     3,   368,
+     163,    22,   202,    22,    -1,   207,    -1,   207,     3,   202,
+      -1,   204,   205,    -1,   204,   219,   205,    -1,   203,   220,
+     219,   220,   205,    -1,   203,     3,   205,    -1,   116,    -1,
+      -1,   160,   245,    -1,   160,    -1,   160,   162,   249,   163,
+      -1,   206,     3,   206,    -1,   208,   268,    -1,   207,    19,
+     207,    -1,   207,    20,   207,    -1,   207,    21,   207,    -1,
+     207,   167,   207,    -1,    -1,   253,    -1,   111,   267,    -1,
+     111,   219,   267,    -1,   209,   220,   219,   220,   267,    -1,
+     209,     3,   267,    -1,   106,    -1,   210,   220,   160,   245,
+     233,    -1,   211,     3,   160,   245,   233,    -1,    79,   166,
+      -1,    79,   195,   214,    -1,    78,   166,    -1,    78,   195,
+     214,    -1,   160,    -1,   133,    -1,   214,     3,   160,    -1,
+     214,     3,   133,    -1,   216,   217,    -1,   216,   219,   217,
+      -1,   215,   220,   219,   220,   217,    -1,   123,    -1,   124,
+     123,    -1,   218,    -1,   217,     3,   218,    -1,   160,   245,
+      -1,    18,    -1,    22,   160,    22,    -1,    -1,     3,    -1,
+     222,    -1,   221,     3,   222,    -1,   160,     5,   249,    -1,
+     128,   224,    -1,   160,    -1,   224,     3,   160,    -1,   118,
+     119,    -1,   118,   130,    -1,   240,   160,   245,   233,   274,
+      -1,   226,     3,   160,   245,   233,   274,    -1,    -1,   232,
+     235,    -1,   231,   229,    -1,   232,    21,   161,    -1,   142,
+     237,   163,    -1,    -1,    21,   161,    -1,    21,   162,   230,
+     163,    -1,   162,   230,   163,    -1,   160,   238,   239,    -1,
+     160,     5,   238,   239,    -1,   238,   239,    -1,   152,    -1,
+     145,    -1,   146,    -1,   144,    -1,   158,    -1,   159,    -1,
+     147,    -1,    -1,    21,   234,    -1,   249,    -1,   162,    21,
+     163,    -1,    -1,    21,   236,    -1,   162,   237,   163,    -1,
+     249,    -1,   162,    21,   163,    -1,   160,   238,    -1,   160,
+       5,   238,    -1,   160,    -1,   161,    -1,   133,    -1,   249,
+      -1,    21,    -1,    -1,     3,   160,   238,    -1,    -1,   131,
+      -1,     3,   241,   131,    -1,   242,    -1,   241,     3,   242,
+      -1,    25,    -1,   244,    -1,    80,    -1,   106,   245,    -1,
+     108,    -1,   109,   162,   243,   163,    -1,   110,    -1,   113,
+      -1,   114,    -1,   116,    -1,   117,    -1,   136,    -1,   134,
+      -1,   135,    -1,    78,    -1,    79,    -1,    -1,   162,   246,
+     163,    -1,   247,    -1,   246,     3,   247,    -1,   248,    -1,
+       4,    -1,   249,     4,    -1,     4,   249,    -1,   249,     4,
+     248,    -1,    21,    -1,   249,    -1,   252,    -1,   275,    -1,
+     250,    -1,   162,   249,   163,    -1,    42,   251,   163,    -1,
+      33,   251,   163,    -1,    34,   162,   251,   163,    -1,    39,
+     162,   251,   163,    -1,    54,   251,   163,    -1,    77,   162,
+     251,   163,    -1,    40,   162,   249,   163,    -1,    43,   249,
+     163,    -1,   144,   162,   251,   163,    -1,    60,   162,   249,
+     163,    -1,    55,   162,   249,   163,    -1,    56,   162,   249,
+     163,    -1,    57,   162,   249,   163,    -1,    58,   162,   249,
+     163,    -1,    59,   162,   249,   163,    -1,    62,   162,   249,
+     163,    -1,    63,   162,   249,   163,    -1,    64,   162,   249,
+     163,    -1,    67,   162,   249,   163,    -1,    68,   162,   249,
+     163,    -1,    69,   162,   249,   163,    -1,    71,   249,   163,
+      -1,    72,   162,   251,   163,    -1,    73,   251,   163,    -1,
+      74,   162,   251,   163,    -1,    75,   162,   251,   163,    -1,
+     249,    -1,   251,     3,   249,    -1,   257,    -1,   268,    -1,
+     262,    -1,   249,   254,    -1,   253,   249,    -1,    11,   249,
+      -1,    19,    -1,    20,    -1,    19,   249,    -1,    20,   249,
+      -1,    21,   249,    -1,    23,   249,    -1,    13,   249,    -1,
+       7,   249,    -1,    16,   249,    -1,   165,   249,    -1,   164,
+     249,    -1,   165,     5,   249,    -1,   164,     5,   249,    -1,
+      17,   249,    -1,    14,   249,    -1,    15,   249,    -1,    12,
+     249,    -1,     6,   249,    -1,     8,   249,    -1,     9,   249,
+      -1,    10,   249,    -1,    22,   255,    -1,     5,   256,    -1,
+      -1,   249,    -1,     5,   249,    -1,    22,   249,    -1,     5,
+     249,    -1,   249,    -1,   267,    -1,   261,    -1,   259,    -1,
+      -1,   260,    -1,   260,   271,    -1,   261,   162,   263,   163,
+      -1,   261,   162,   263,   163,   271,    -1,   267,   162,   263,
+     163,    -1,   257,   168,   356,   257,    -1,   125,   366,   126,
+      -1,   258,    -1,   258,   264,    -1,   265,    -1,   264,     3,
+     265,    -1,   249,    -1,   266,    -1,   249,     4,   249,    -1,
+     249,     4,   249,     4,   249,    -1,     4,   249,     4,   249,
+      -1,     4,     4,   249,    -1,     4,   249,    -1,   249,     4,
+      -1,     4,    -1,   160,    -1,   138,    -1,   139,    -1,    41,
+      -1,   161,    -1,   157,    -1,   132,    -1,   268,   160,    -1,
+     269,   270,    -1,   153,    -1,   269,   153,    -1,   156,    -1,
+     154,    -1,    -1,   271,    -1,   162,   272,     4,   272,   163,
+      -1,    -1,   249,    -1,   166,    -1,   249,    -1,    -1,     5,
+     249,    -1,   122,   249,    -1,   162,   252,     3,   252,   163,
+      -1,   277,   160,    -1,   277,   160,     3,   278,    -1,   277,
+     160,     3,    27,     4,   166,    -1,   277,   160,     3,    27,
+       4,   280,    -1,   137,    -1,   279,    -1,   278,     3,   279,
+      -1,   160,   122,   160,    -1,   281,    -1,   280,     3,   281,
+      -1,   160,   122,   160,    -1,   160,    -1,   283,    -1,   331,
+      -1,   284,    -1,   300,    -1,   320,    -1,   310,    -1,   287,
+      -1,   115,    -1,   338,   340,    -1,   369,    -1,   341,    -1,
+     357,   352,    -1,   359,   350,    -1,   100,   352,    -1,   100,
+     352,   366,    -1,   103,   353,    -1,    96,   162,   370,   373,
+     163,    -1,   104,   162,   372,   373,   163,    -1,    76,   272,
+      -1,    81,   273,    -1,    61,   273,    -1,   348,   273,    -1,
+     339,    -1,   105,   162,   374,   163,    -1,   333,    -1,   334,
+     336,    -1,   332,   336,    -1,   335,   336,    -1,    93,   336,
+      -1,   319,    -1,   286,    -1,    90,    -1,   249,    -1,    35,
+     162,   294,   163,   293,    -1,   291,   172,   288,   289,   290,
+     297,    -1,    -1,   288,   292,   172,    -1,    -1,   289,   295,
+     172,   288,    -1,    -1,   290,   296,   172,   288,    -1,    35,
+     162,   294,   163,    -1,   293,    -1,   286,    -1,   287,    -1,
+     285,    -1,   249,    -1,    36,   294,   163,    -1,    36,   294,
+     163,   160,    -1,    37,    -1,    37,   160,    -1,    38,    -1,
+      38,   160,    -1,    -1,    -1,   299,   282,    -1,   299,   282,
+     172,    -1,   301,    -1,   302,   172,   307,   308,    -1,   303,
+      -1,   304,    -1,   160,     4,    89,   179,    -1,    89,   179,
+      -1,   160,     4,    89,   179,   305,    -1,    89,   179,   305,
+      -1,   160,     4,    89,    -1,    89,    -1,   160,     4,    89,
+     305,    -1,    89,   305,    -1,   220,   306,     5,   249,     3,
+     249,    -1,   220,   306,     5,   249,     3,   249,     3,   249,
+      -1,   220,    94,   162,   249,   163,    -1,   220,    95,   298,
+      -1,   267,    -1,   299,    -1,   309,    -1,   330,    -1,    91,
+      -1,    91,   160,    -1,   315,   172,   299,   311,   313,   318,
+      -1,    -1,   312,    -1,   311,   312,    -1,   316,   172,   299,
+      -1,    -1,   314,    -1,   313,   312,    -1,   317,   172,   299,
+      -1,   160,     4,    88,   162,   249,   163,    82,    -1,    88,
+     162,   249,   163,    82,    -1,    83,   162,   249,   163,    82,
+      -1,    83,   162,   249,   163,    82,   160,    -1,    84,    -1,
+      84,   160,    -1,    85,    -1,    85,   160,    -1,    88,   162,
+     249,   163,   284,    -1,   323,   172,   321,   325,    -1,    -1,
+     322,    -1,   321,   322,    -1,   324,   172,   299,    -1,   160,
+       4,    45,   162,   249,   163,    -1,    45,   162,   249,   163,
+      -1,    44,   326,    -1,    44,   326,   160,    -1,   107,    -1,
+     107,   160,    -1,   162,   327,   163,    -1,   112,    -1,   328,
+      -1,   327,     3,   328,    -1,   329,    -1,   329,     4,    -1,
+       4,   329,    -1,   329,     4,   329,    -1,   249,    -1,   115,
+      -1,    32,    -1,   148,    -1,   151,    -1,   150,    -1,   149,
+      -1,   166,    -1,   160,    -1,    -1,   267,   337,   245,   245,
+      -1,   338,   168,   356,   267,   337,   245,   245,    -1,   161,
+      -1,   339,     3,   161,    -1,     5,   249,    -1,   122,   249,
+      -1,   344,   342,    -1,    -1,   162,   343,   163,    -1,    -1,
+     346,    -1,   345,   101,    -1,   345,   160,    -1,   120,    -1,
+     347,    -1,   346,     3,   347,    -1,   249,    -1,    21,   161,
+      -1,   127,    -1,   129,    -1,    -1,   363,    -1,   352,   349,
+      -1,   358,   351,    -1,    -1,     3,   363,    -1,   162,   354,
+     163,    -1,   162,   267,   163,    -1,   162,   161,   163,    -1,
+     161,    -1,   162,   252,   163,    -1,   160,    -1,   355,    -1,
+     354,     3,   355,    -1,   360,    -1,    21,    -1,    23,    -1,
+     267,   249,   245,    -1,   267,   249,   168,   356,   338,    -1,
+     267,   162,   266,   163,    -1,   267,    21,    -1,   267,    23,
+      -1,    -1,    97,    -1,    98,    -1,   101,    -1,   361,    -1,
+      21,    -1,   102,    -1,    99,    -1,    86,    -1,   361,    -1,
+     162,   360,   163,    -1,   257,    -1,   268,    -1,   360,   362,
+     360,    -1,   360,    21,   360,    -1,   360,    22,   360,    -1,
+     360,    23,   360,    -1,   362,   360,    -1,   360,    18,   360,
+      -1,    46,   249,    -1,    47,   249,    -1,    49,   249,    -1,
+      48,   249,    -1,    53,   249,    -1,    52,   249,    -1,    50,
+     249,    -1,   160,     5,   249,    -1,   250,    -1,    19,    -1,
+      20,    -1,   364,    -1,   363,     3,   364,    -1,   257,   365,
+      -1,   162,   363,   163,   365,    -1,   250,   365,    -1,   268,
+     365,    -1,   162,   363,     3,   368,   163,    -1,    -1,   254,
+      -1,   365,   254,    -1,   275,    -1,   250,    -1,   252,    -1,
+     367,    -1,   252,     3,   249,    -1,   252,     3,   367,    -1,
+     367,     3,   249,    -1,   367,     3,   367,    -1,   366,     3,
+     249,    -1,   366,     3,   367,    -1,   162,   252,     3,   368,
+     163,    -1,   162,   366,     3,   368,   163,    -1,   162,   367,
+       3,   368,   163,    -1,   160,     5,   249,     3,   249,    -1,
+     160,     5,   249,     3,   249,     3,   249,    -1,    87,   162,
+     249,     3,   249,   163,     3,   249,    -1,    87,   161,    -1,
+     371,    -1,   370,     3,   371,    -1,   257,    -1,   371,    -1,
+     372,     3,   371,    -1,    -1,     3,   121,     5,   257,    -1,
+     267,    -1,   374,     3,   267,    -1
 };
 
@@ -1013,144 +878,153 @@
 static const yytype_uint16 yyrline[] =
 {
-       0,   336,   336,   337,   339,   340,   341,   342,   343,   346,
-     347,   349,   350,   351,   360,   361,   363,   365,   367,   374,
-     379,   380,   382,   384,   385,   387,   388,   394,   397,   398,
-     401,   402,   430,   448,   481,   515,   532,   539,   541,   545,
-     550,   553,   556,   561,   562,   563,   571,   582,   594,   595,
-     597,   605,   613,   619,   620,   635,   648,   649,   655,   656,
-     693,   706,   707,   708,   709,   710,   711,   712,   713,   714,
-     715,   734,   735,   741,   742,   743,   744,   745,   746,   747,
-     748,   749,   750,   751,   752,   753,   754,   755,   756,   757,
-     758,   759,   760,   761,   762,   763,   764,   766,   767,   769,
-     770,   772,   773,   775,   777,   778,   780,   781,   783,   784,
-     786,   870,   907,   913,   918,   923,   937,   951,   966,   973,
-     982,   983,   984,   985,   987,   992,   993,   998,  1002,  1007,
-    1012,  1014,  1016,  1018,  1020,  1024,  1025,  1028,  1030,  1031,
-    1032,  1033,  1035,  1037,  1042,  1047,  1053,  1069,  1086,  1087,
-    1089,  1093,  1098,  1102,  1107,  1113,  1124,  1136,  1141,  1147,
-    1152,  1156,  1166,  1175,  1185,  1186,  1188,  1192,  1197,  1220,
-    1222,  1223,  1225,  1235,  1237,  1239,  1272,  1307,  1309,  1311,
-    1315,  1320,  1326,  1334,  1335,  1337,  1338,  1340,  1341,  1342,
-    1344,  1349,  1351,  1356,  1360,  1363,  1369,  1371,  1377,  1378,
-    1380,  1381,  1383,  1384,  1385,  1387,  1388,  1390,  1391,  1400,
-    1404,  1409,  1411,  1414,  1415,  1417,  1418,  1419,  1421,  1422,
-    1424,  1428,  1429,  1431,  1436,  1438,  1440,  1441,  1442,  1443,
-    1449,  1452,  1453,  1454,  1456,  1458,  1461,  1466,  1470,  1472,
-    1476,  1481,  1485,  1490,  1495,  1503,  1504,  1506,  1507,  1509,
-    1511,  1515,  1517,  1519,  1521,  1523,  1525,  1527,  1529,  1531,
-    1533,  1535,  1537,  1539,  1541,  1543,  1545,  1547,  1549,  1551,
-    1553,  1555,  1557,  1559,  1561,  1563,  1565,  1568,  1569,  1573,
-    1574,  1576,  1578,  1580,  1582,  1585,  1586,  1588,  1590,  1592,
-    1594,  1596,  1598,  1600,  1602,  1604,  1606,  1608,  1610,  1612,
-    1614,  1616,  1618,  1620,  1622,  1624,  1626,  1628,  1631,  1632,
-    1634,  1636,  1639,  1641,  1645,  1650,  1655,  1661,  1673,  1678,
-    1680,  1683,  1687,  1697,  1703,  1706,  1707,  1710,  1711,  1714,
-    1715,  1717,  1719,  1722,  1724,  1725,  1726,  1727,  1729,  1787,
-    1789,  1790,  1791,  1792,  1793,  1794,  1796,  1798,  1800,  1801,
-    1803,  1806,  1807,  1809,  1812,  1813,  1815,  1816,  1818,  1819,
-    1827,  1836,  1838,  1841,  1861,  1895,  1915,  1966,  1974,  1977,
-    1981,  1991,  2002,  2006,  2016,  2028,  2037,  2038,  2044,  2050,
-    2051,  2101,  2119,  2139,  2158,  2203,  2204,  2205,  2206,  2207,
-    2208,  2209,  2210,  2211,  2212,  2213,  2214,  2215,  2216,  2260,
-    2270,  2279,  2288,  2297,  2298,  2299,  2301,  2302,  2303,  2305,
-    2306,  2307,  2308,  2309,  2311,  2312,  2314,  2315,  2317,  2319,
-    2326,  2327,  2328,  2329,  2330,  2331,  2337,  2343,  2344,  2345,
-    2346,  2347,  2349,  2350,  2360,  2362,  2363,  2365,  2366,  2368,
-    2396,  2397,  2399,  2400,  2402,  2432,  2434,  2435,  2438,  2452,
-    2455,  2456,  2459,  2460,  2461,  2462,  2463,  2464,  2476,  2477,
-    2479,  2480,  2485,  2486,  2488,  2489,  2491,  2492,  2493,  2494,
-    2495,  2497,  2498,  2500,  2501,  2502,  2503,  2504,  2505,  2506,
-    2507,  2508,  2510,  2511,  2513,  2514,  2517,  2518,  2519,  2522,
-    2525,  2526,  2528,  2529,  2530,  2531,  2532,  2533,  2534,  2535,
-    2536,  2537,  2538,  2539,  2540,  2541,  2543,  2544,  2546,  2547,
-    2549,  2550,  2552,  2553,  2554,  2555,  2556,  2558,  2559,  2560,
-    2562,  2563,  2564,  2566,  2568,  2570,  2572,  2574,  2576,  2578,
-    2579,  2581,  2583,  2585,  2587,  2589,  2593,  2596,  2603,  2605,
-    2606,  2608,  2609,  2610,  2612,  2614,  2615,  2617,  2624,  2625,
-    2627,  2628,  2630,  2631,  2639,  2641
+       0,   313,   313,   314,   316,   317,   318,   319,   322,   323,
+     324,   325,   326,   329,   330,   331,   334,   335,   336,   344,
+     347,   350,   351,   354,   355,   358,   366,   375,   392,   411,
+     412,   415,   417,   419,   420,   421,   423,   424,   425,   427,
+     439,   451,   452,   454,   455,   456,   457,   458,   475,   492,
+     493,   498,   499,   536,   549,   550,   551,   552,   553,   554,
+     555,   556,   557,   570,   571,   578,   579,   580,   581,   582,
+     583,   584,   585,   586,   587,   588,   589,   590,   591,   592,
+     593,   594,   595,   596,   597,   598,   599,   600,   601,   604,
+     605,   608,   609,   612,   613,   615,   618,   619,   622,   623,
+     625,   626,   629,   695,   710,   712,   716,   719,   720,   723,
+     729,   734,   748,   749,   752,   753,   754,   755,   758,   760,
+     761,   764,   765,   766,   769,   770,   771,   772,   773,   775,
+     776,   779,   780,   781,   782,   785,   792,   802,   814,   815,
+     818,   819,   822,   823,   824,   825,   828,   834,   842,   852,
+     853,   856,   857,   860,   868,   874,   881,   882,   885,   886,
+     889,   905,   908,   909,   912,   921,   923,   945,   970,   972,
+     973,   974,   975,   977,   978,   979,   980,   983,   984,   985,
+     987,   990,   991,   992,   993,   994,   995,   997,   998,  1001,
+    1002,  1004,  1005,  1006,  1008,  1009,  1012,  1013,  1023,  1024,
+    1025,  1028,  1029,  1031,  1032,  1034,  1035,  1036,  1038,  1039,
+    1042,  1043,  1044,  1045,  1046,  1047,  1049,  1050,  1051,  1052,
+    1053,  1056,  1057,  1058,  1061,  1062,  1064,  1065,  1073,  1079,
+    1086,  1087,  1088,  1089,  1090,  1093,  1094,  1096,  1097,  1098,
+    1099,  1103,  1104,  1105,  1106,  1107,  1108,  1109,  1110,  1111,
+    1112,  1113,  1114,  1115,  1116,  1117,  1118,  1119,  1120,  1121,
+    1122,  1123,  1124,  1125,  1126,  1127,  1128,  1130,  1131,  1133,
+    1134,  1135,  1136,  1137,  1138,  1140,  1141,  1145,  1146,  1147,
+    1148,  1149,  1150,  1151,  1152,  1153,  1154,  1155,  1156,  1157,
+    1158,  1159,  1160,  1161,  1162,  1163,  1164,  1165,  1167,  1168,
+    1169,  1170,  1173,  1174,  1177,  1178,  1179,  1183,  1194,  1195,
+    1196,  1197,  1200,  1209,  1216,  1219,  1220,  1223,  1224,  1227,
+    1228,  1231,  1232,  1233,  1234,  1235,  1236,  1237,  1239,  1285,
+    1286,  1287,  1288,  1289,  1290,  1291,  1293,  1296,  1297,  1298,
+    1299,  1301,  1302,  1305,  1307,  1308,  1311,  1312,  1314,  1315,
+    1321,  1329,  1332,  1352,  1379,  1399,  1439,  1446,  1450,  1457,
+    1467,  1468,  1476,  1486,  1498,  1499,  1504,  1505,  1506,  1507,
+    1508,  1513,  1514,  1515,  1516,  1517,  1518,  1519,  1520,  1521,
+    1522,  1523,  1524,  1525,  1526,  1527,  1528,  1529,  1530,  1567,
+    1576,  1587,  1595,  1617,  1618,  1619,  1657,  1661,  1665,  1668,
+    1669,  1672,  1673,  1676,  1677,  1682,  1686,  1687,  1688,  1692,
+    1696,  1701,  1702,  1707,  1708,  1713,  1714,  1718,  1722,  1723,
+    1724,  1729,  1734,  1739,  1740,  1745,  1746,  1747,  1748,  1753,
+    1754,  1755,  1756,  1761,  1762,  1763,  1764,  1768,  1772,  1776,
+    1777,  1782,  1783,  1787,  1790,  1791,  1792,  1796,  1799,  1800,
+    1801,  1804,  1809,  1810,  1815,  1816,  1821,  1822,  1827,  1828,
+    1832,  1836,  1839,  1840,  1841,  1844,  1849,  1850,  1855,  1856,
+    1861,  1862,  1867,  1868,  1872,  1873,  1878,  1879,  1880,  1881,
+    1885,  1889,  1893,  1897,  1905,  1912,  1919,  1926,  1927,  1930,
+    1933,  1944,  1950,  1951,  1954,  1955,  1957,  1970,  1971,  1973,
+    1974,  1977,  1978,  2000,  2003,  2004,  2007,  2015,  2018,  2019,
+    2022,  2023,  2026,  2027,  2029,  2030,  2032,  2035,  2036,  2037,
+    2038,  2039,  2042,  2043,  2046,  2047,  2048,  2049,  2050,  2051,
+    2052,  2053,  2056,  2059,  2060,  2061,  2063,  2064,  2067,  2068,
+    2069,  2072,  2073,  2076,  2077,  2078,  2079,  2080,  2081,  2082,
+    2083,  2084,  2085,  2086,  2087,  2088,  2089,  2090,  2091,  2092,
+    2094,  2095,  2097,  2098,  2104,  2105,  2106,  2107,  2108,  2110,
+    2111,  2112,  2115,  2116,  2117,  2118,  2119,  2120,  2121,  2122,
+    2123,  2124,  2127,  2128,  2129,  2131,  2132,  2134,  2135,  2138,
+    2139,  2142,  2145,  2146,  2148,  2149,  2152,  2153
 };
 #endif
 
-#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
+#if YYDEBUG || YYERROR_VERBOSE || 0
 /* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
    First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
 static const char *const yytname[] =
 {
-  "$end", "error", "$undefined", "','", "':'", "'='", "TOK_BINARY_OP",
-  "TOK_NEQV", "TOK_EQV", "TOK_XOR", "TOK_OR", "TOK_AND", "TOK_NOT",
-  "TOK_NE", "TOK_EQ", "TOK_GE", "TOK_LE", "TOK_GT", "TOK_LT",
-  "TOK_UNARY_OP", "TOK_DSLASH", "'+'", "'-'", "'*'", "TOK_SLASH",
-  "TOK_DASTER", "TOK_SEP", "TOK_SEMICOLON", "TOK_NEXTLINE",
-  "TOK_PARAMETER", "TOK_RESULT", "TOK_ONLY", "TOK_INCLUDE",
-  "TOK_SUBROUTINE", "TOK_PROGRAM", "TOK_FUNCTION", "TOK_OMP", "TOK_DOLLAR",
-  "TOK_FORMAT", "TOK_MAX", "TOK_TANH", "TOK_WHERE", "TOK_ELSEWHERE",
-  "TOK_ENDWHERE", "TOK_MAXVAL", "TOK_TRIM", "TOK_SUM", "TOK_SQRT",
-  "TOK_CASE", "TOK_SELECTCASE", "TOK_FILE", "TOK_END", "TOK_ERR",
-  "TOK_DONOTTREAT", "TOK_ENDDONOTTREAT", "TOK_EXIST", "TOK_MIN",
-  "TOK_FLOAT", "TOK_EXP", "TOK_COS", "TOK_COSH", "TOK_ACOS", "TOK_NINT",
-  "TOK_CYCLE", "TOK_SIN", "TOK_SINH", "TOK_ASIN", "TOK_EQUIVALENCE",
-  "TOK_BACKSPACE", "TOK_LOG", "TOK_TAN", "TOK_ATAN", "TOK_RECURSIVE",
-  "TOK_ABS", "TOK_MOD", "TOK_SIGN", "TOK_MINLOC", "TOK_MAXLOC", "TOK_EXIT",
-  "TOK_MINVAL", "TOK_PUBLIC", "TOK_PRIVATE", "TOK_ALLOCATABLE",
-  "TOK_RETURN", "TOK_THEN", "TOK_ELSEIF", "TOK_ELSE", "TOK_ENDIF",
-  "TOK_PRINT", "TOK_PLAINGOTO", "TOK_CONSTRUCTID", "TOK_LOGICALIF",
-  "TOK_PLAINDO", "TOK_CONTAINS", "TOK_ENDDO", "TOK_MODULE",
-  "TOK_ENDMODULE", "TOK_DOWHILE", "TOK_ALLOCATE", "TOK_OPEN", "TOK_CLOSE",
-  "TOK_INQUIRE", "TOK_WRITE", "TOK_READ", "TOK_REWIND", "TOK_DEALLOCATE",
-  "TOK_NULLIFY", "TOK_FIN", "TOK_DEBUT", "TOK_DIMENSION", "TOK_ENDSELECT",
-  "TOK_EXTERNAL", "TOK_INTENT", "TOK_INTRINSIC", "TOK_NAMELIST",
-  "TOK_CASEDEFAULT", "TOK_OPTIONAL", "TOK_POINTER", "TOK_CONTINUE",
-  "TOK_SAVE", "TOK_TARGET", "TOK_QUOTE", "TOK_IMPLICIT", "TOK_NONE",
-  "TOK_CALL", "TOK_STAT", "TOK_POINT_TO", "TOK_COMMON", "TOK_GLOBAL",
-  "TOK_INTERFACE", "TOK_ENDINTERFACE", "TOK_LEFTAB", "TOK_RIGHTAB",
-  "TOK_PAUSE", "TOK_PROCEDURE", "TOK_STOP", "TOK_NAMEEQ", "TOK_REAL8",
+  "$end", "error", "$undefined", "','", "':'", "'='", "TOK_NEQV",
+  "TOK_EQV", "TOK_XOR", "TOK_OR", "TOK_AND", "TOK_NOT", "TOK_NE", "TOK_EQ",
+  "TOK_GE", "TOK_LE", "TOK_GT", "TOK_LT", "TOK_DSLASH", "'+'", "'-'",
+  "'*'", "TOK_SLASH", "TOK_DASTER", "TOK_SEMICOLON", "TOK_PARAMETER",
+  "TOK_RESULT", "TOK_ONLY", "TOK_INCLUDE", "TOK_SUBROUTINE", "TOK_PROGRAM",
+  "TOK_FUNCTION", "TOK_FORMAT", "TOK_MAX", "TOK_TANH", "TOK_WHERE",
+  "TOK_ELSEWHEREPAR", "TOK_ELSEWHERE", "TOK_ENDWHERE", "TOK_MAXVAL",
+  "TOK_TRIM", "TOK_NULL_PTR", "TOK_SUM", "TOK_SQRT", "TOK_CASE",
+  "TOK_SELECTCASE", "TOK_FILE", "TOK_UNIT", "TOK_FMT", "TOK_NML",
+  "TOK_END", "TOK_EOR", "TOK_ERR", "TOK_EXIST", "TOK_MIN", "TOK_FLOAT",
+  "TOK_EXP", "TOK_COS", "TOK_COSH", "TOK_ACOS", "TOK_NINT", "TOK_CYCLE",
+  "TOK_SIN", "TOK_SINH", "TOK_ASIN", "TOK_EQUIVALENCE", "TOK_BACKSPACE",
+  "TOK_LOG", "TOK_TAN", "TOK_ATAN", "TOK_RECURSIVE", "TOK_ABS", "TOK_MOD",
+  "TOK_SIGN", "TOK_MINLOC", "TOK_MAXLOC", "TOK_EXIT", "TOK_MINVAL",
+  "TOK_PUBLIC", "TOK_PRIVATE", "TOK_ALLOCATABLE", "TOK_RETURN", "TOK_THEN",
+  "TOK_ELSEIF", "TOK_ELSE", "TOK_ENDIF", "TOK_PRINT", "TOK_PLAINGOTO",
+  "TOK_LOGICALIF", "TOK_PLAINDO", "TOK_CONTAINS", "TOK_ENDDO",
+  "TOK_MODULE", "TOK_ENDMODULE", "TOK_WHILE", "TOK_CONCURRENT",
+  "TOK_ALLOCATE", "TOK_OPEN", "TOK_CLOSE", "TOK_INQUIRE", "TOK_WRITE",
+  "TOK_FLUSH", "TOK_READ", "TOK_REWIND", "TOK_DEALLOCATE", "TOK_NULLIFY",
+  "TOK_DIMENSION", "TOK_ENDSELECT", "TOK_EXTERNAL", "TOK_INTENT",
+  "TOK_INTRINSIC", "TOK_NAMELIST", "TOK_DEFAULT", "TOK_OPTIONAL",
+  "TOK_POINTER", "TOK_CONTINUE", "TOK_SAVE", "TOK_TARGET", "TOK_IMPLICIT",
+  "TOK_NONE", "TOK_CALL", "TOK_STAT", "TOK_POINT_TO", "TOK_COMMON",
+  "TOK_GLOBAL", "TOK_LEFTAB", "TOK_RIGHTAB", "TOK_PAUSE", "TOK_PROCEDURE",
+  "TOK_STOP", "TOK_REAL8", "TOK_FOURDOTS", "TOK_HEXA", "TOK_ASSIGNTYPE",
   "TOK_OUT", "TOK_INOUT", "TOK_IN", "TOK_USE", "TOK_TRUE", "TOK_FALSE",
   "TOK_LABEL", "TOK_TYPE", "TOK_TYPEPAR", "TOK_ENDTYPE", "TOK_REAL",
-  "TOK_INTEGER", "TOK_LOGICAL", "TOK_DOUBLEPRECISION", "TOK_DOUBLEREAL",
-  "TOK_ENDSUBROUTINE", "TOK_ENDFUNCTION", "TOK_ENDPROGRAM", "TOK_ENDUNIT",
-  "TOK_CHARACTER", "TOK_CHAR_CONSTANT", "TOK_CHAR_CUT", "TOK_DATA",
-  "TOK_CHAR_INT", "TOK_CHAR_MESSAGE", "TOK_CSTREAL", "TOK_CSTREALDP",
-  "TOK_CSTREALQP", "TOK_SFREAL", "TOK_COMPLEX", "TOK_DOUBLECOMPLEX",
-  "TOK_NAME", "TOK_NAME_CHAR", "TOK_PROBTYPE", "TOK_INTERPTYPE",
-  "TOK_VARTYPE", "TOK_BC", "TOK_OP", "TOK_CSTINT", "TOK_COMMENT",
-  "TOK_FILENAME", "'('", "')'", "'['", "']'", "'!'", "'_'", "'<'", "'>'",
-  "'\\n'", "'/'", "'%'", "$accept", "input", "line", "suite_line_list",
-  "suite_line", "instr", "fin_line", "keyword", "position", "thislabel",
-  "cmnt", "nulcurbuf", "opt_recursive", "entry", "name_routine",
-  "writedeclar", "before_include", "filename", "arglist", "arglist1",
+  "TOK_INTEGER", "TOK_LOGICAL", "TOK_DOUBLEPRECISION", "TOK_ENDSUBROUTINE",
+  "TOK_ENDFUNCTION", "TOK_ENDPROGRAM", "TOK_ENDUNIT", "TOK_CHARACTER",
+  "TOK_CHAR_CONSTANT", "TOK_CHAR_CUT", "TOK_DATA", "TOK_CHAR_MESSAGE",
+  "TOK_CSTREAL", "TOK_COMPLEX", "TOK_DOUBLECOMPLEX", "TOK_NAME",
+  "TOK_CSTINT", "'('", "')'", "'<'", "'>'", "'\\n'", "'/'", "'%'",
+  "$accept", "input", "line", "line-break", "suite_line_list",
+  "suite_line", "fin_line", "opt_recursive", "opt_result", "entry",
+  "label", "name_routine", "filename", "arglist", "arglist_after_result",
   "args", "arg", "spec", "opt_spec", "name_intrinsic",
   "use_intrinsic_list", "list_couple", "list_expr_equi", "expr_equi",
   "list_expr_equi1", "list_expr", "opt_sep", "after_type",
-  "before_function", "before_parameter", "before_data", "data",
-  "datavallist", "save", "before_save", "varsave", "datanamelist",
-  "expr_data", "opt_signe", "namelist", "namelist_action",
-  "after_namelist", "interface", "before_dimension", "dimension",
-  "private", "public", "use_name_list", "common", "before_common",
-  "var_common_list", "var_common", "comblock", "opt_comma", "paramlist",
-  "paramitem", "module_proc_stmt", "proc_name_list", "implicit",
-  "opt_retour", "dcl", "nodimsgiven", "type", "before_typepar",
-  "c_selector", "c_attribute", "before_character", "typespec", "typename",
-  "lengspec", "proper_lengspec", "selector", "proper_selector",
-  "attribute", "clause", "opt_clause", "options", "attr_spec_list",
-  "attr_spec", "intent_spec", "access_spec", "dims", "dimlist", "dim",
-  "ubound", "expr", "predefinedfunction", "minmaxlist", "uexpr", "signe",
-  "operation", "after_slash", "after_equal", "lhs", "beforefunctionuse",
+  "before_function", "before_parameter", "data_stmt", "data_stmt_set_list",
+  "data_stmt_set", "data_stmt_value_list", "save", "before_save",
+  "varsave", "datanamelist", "expr_data", "opt_signe", "namelist",
+  "before_dimension", "dimension", "private", "public", "use_name_list",
+  "common", "before_common", "var_common_list", "var_common", "comblock",
+  "opt_comma", "paramlist", "paramitem", "module_proc_stmt",
+  "proc_name_list", "implicit", "dcl", "nodimsgiven", "type", "c_selector",
+  "c_attribute", "before_character", "typespec", "lengspec",
+  "proper_lengspec", "selector", "proper_selector", "attribute", "clause",
+  "opt_clause", "options", "attr_spec_list", "attr_spec", "intent_spec",
+  "access_spec", "dims", "dimlist", "dim", "ubound", "expr",
+  "predefinedfunction", "minmaxlist", "uexpr", "signe", "operation",
+  "after_slash", "after_equal", "lhs", "beforefunctionuse",
   "array_ele_substring_func_ref", "begin_array", "structure_component",
   "vec", "funarglist", "funargs", "funarg", "triplet", "ident",
   "simple_const", "string_constant", "opt_substring", "substring",
-  "optexpr", "opt_expr", "initial_value", "before_initial",
-  "complex_const", "use_stat", "word_use", "module_name", "rename_list",
-  "rename_name", "only_list", "only_name", "exec", "word_endsubroutine",
-  "word_endunit", "word_endprogram", "word_endfunction", "caselist",
-  "boucledo", "do_arg", "opt_int", "opt_name", "optname", "worddo",
-  "wordwhile", "iffable", "before_dims", "ident_dims", "int_list",
-  "after_ident_dims", "call", "opt_call", "opt_callarglist", "keywordcall",
-  "before_call", "callarglist", "callarg", "stop", "io", "option_inlist",
-  "option_read", "opt_inlist", "ioctl", "after_rewind", "ctllist",
-  "ioclause", "iofctl", "infmt", "read", "write", "fexpr", "unpar_fexpr",
-  "addop", "inlist", "opt_lhs", "inelt", "opt_operation", "outlist",
-  "out2", "other", "dospec", "label", "goto", "allocation_list",
-  "allocate_object", "array_element", "allocate_object_list",
-  "opt_stat_spec", "pointer_name_list", "logif", "do_var", 0
+  "optexpr", "opt_expr", "initial_value", "complex_const", "use_stat",
+  "word_use", "rename_list", "rename_name", "only_list", "only_name",
+  "execution-part-construct", "executable-construct", "action-stmt",
+  "assignment-stmt", "where-stmt", "where-construct",
+  "opt-where-body-construct", "opt-masked-elsewhere-construct",
+  "opt-elsewhere-construct", "where-construct-stmt",
+  "where-body-construct", "where-assignment-stmt", "mask-expr",
+  "masked-elsewhere-stmt", "elsewhere-stmt", "end-where-stmt",
+  "forall-header", "block", "do-construct", "block-do-construct",
+  "do-stmt", "label-do-stmt", "nonlabel-do-stmt", "loop-control",
+  "do-variable", "do-block", "end-do", "end-do-stmt", "if-construct",
+  "opt-else-if-stmt-block", "else-if-stmt-block", "opt-else-stmt-block",
+  "else-stmt-block", "if-then-stmt", "else-if-stmt", "else-stmt",
+  "end-if-stmt", "if-stmt", "case-construct", "opt_case-stmt-block",
+  "case-stmt-block", "select-case-stmt", "case-stmt", "end-select-stmt",
+  "case-selector", "case-value-range-list", "case-value-range",
+  "case-value", "continue-stmt", "format-stmt", "word_endsubroutine",
+  "word_endunit", "word_endprogram", "word_endfunction", "opt_name",
+  "before_dims", "ident_dims", "int_list", "after_ident_dims", "call",
+  "opt_call", "opt_callarglist", "keywordcall", "before_call",
+  "callarglist", "callarg", "stop", "option_inlist", "option_read",
+  "opt_inlist", "ioctl", "after_rewind", "ctllist", "ioclause",
+  "declare_after_percent", "iofctl", "infmt", "read", "fexpr",
+  "unpar_fexpr", "addop", "inlist", "inelt", "opt_operation", "outlist",
+  "other", "dospec", "goto", "allocation_list", "allocate_object",
+  "allocate_object_list", "opt_stat_spec", "pointer_name_list", YY_NULL
 };
 #endif
@@ -1162,6 +1036,6 @@
 {
        0,   256,   257,    44,    58,    61,   258,   259,   260,   261,
-     262,   263,   264,   265,   266,   267,   268,   269,   270,   271,
-     272,    43,    45,    42,   273,   274,   275,   276,   277,   278,
+     262,   263,   264,   265,   266,   267,   268,   269,   270,    43,
+      45,    42,   271,   272,   273,   274,   275,   276,   277,   278,
      279,   280,   281,   282,   283,   284,   285,   286,   287,   288,
      289,   290,   291,   292,   293,   294,   295,   296,   297,   298,
@@ -1177,7 +1051,5 @@
      389,   390,   391,   392,   393,   394,   395,   396,   397,   398,
      399,   400,   401,   402,   403,   404,   405,   406,   407,   408,
-     409,   410,   411,   412,   413,   414,   415,   416,   417,   418,
-     419,   420,   421,   422,   423,   424,   425,   426,   427,    40,
-      41,    91,    93,    33,    95,    60,    62,    10,    47,    37
+     409,   410,    40,    41,    60,    62,    10,    47,    37
 };
 # endif
@@ -1186,60 +1058,64 @@
 static const yytype_uint16 yyr1[] =
 {
-       0,   190,   191,   191,   192,   192,   192,   192,   192,   193,
-     193,   194,   194,   194,   194,   194,   195,   196,   197,   197,
-     197,   197,   198,   199,   199,   200,   200,   201,   202,   202,
-     203,   203,   203,   203,   203,   203,   204,   205,   206,   207,
-     208,   208,   208,   209,   209,   209,   210,   210,   211,   211,
-     212,   212,   212,   212,   212,   212,   212,   212,   212,   212,
-     212,   212,   212,   212,   212,   212,   212,   212,   212,   212,
-     212,   213,   213,   214,   214,   214,   214,   214,   214,   214,
-     214,   214,   214,   214,   214,   214,   214,   214,   214,   214,
-     214,   214,   214,   214,   214,   214,   214,   215,   215,   216,
+       0,   169,   170,   170,   171,   171,   171,   171,   172,   172,
+     172,   172,   172,   173,   173,   173,   174,   174,   174,   174,
+     175,   176,   176,   177,   177,   178,   178,   178,   178,   179,
+     179,   180,   181,   182,   182,   182,   183,   183,   183,   184,
+     184,   185,   185,   186,   186,   186,   186,   186,   186,   186,
+     186,   186,   186,   186,   186,   186,   186,   186,   186,   186,
+     186,   186,   186,   187,   187,   188,   188,   188,   188,   188,
+     188,   188,   188,   188,   188,   188,   188,   188,   188,   188,
+     188,   188,   188,   188,   188,   188,   188,   188,   188,   189,
+     189,   190,   190,   191,   191,   192,   193,   193,   194,   194,
+     195,   195,   196,   196,   197,   198,   199,   200,   200,   201,
+     201,   201,   202,   202,   203,   203,   203,   203,   204,   205,
+     205,   206,   206,   206,   207,   207,   207,   207,   207,   208,
+     208,   209,   209,   209,   209,   210,   211,   211,   212,   212,
+     213,   213,   214,   214,   214,   214,   215,   215,   215,   216,
      216,   217,   217,   218,   219,   219,   220,   220,   221,   221,
-     222,   222,   223,   224,   225,   226,   226,   226,   227,   227,
-     228,   228,   228,   228,   229,   230,   230,   231,   231,   231,
-     232,   232,   232,   232,   232,   233,   233,   234,   235,   235,
-     235,   235,   236,   237,   237,   238,   239,   239,   240,   240,
-     241,   241,   242,   242,   243,   243,   243,   244,   244,   245,
-     245,   246,   247,   247,   248,   248,   249,   249,   250,   251,
-     252,   252,   253,   253,   254,   255,   255,   256,   257,   257,
-     257,   257,   258,   259,   259,   259,   259,   260,   260,   260,
-     261,   262,   263,   263,   263,   263,   263,   263,   264,   264,
-     265,   265,   266,   266,   266,   267,   267,   268,   268,   268,
-     268,   269,   269,   270,   270,   271,   271,   271,   272,   272,
-     273,   273,   273,   273,   273,   273,   273,   273,   273,   273,
-     273,   274,   274,   274,   275,   275,   276,   276,   277,   277,
-     278,   278,   278,   278,   278,   279,   279,   280,   280,   280,
-     280,   281,   281,   281,   281,   281,   281,   281,   281,   281,
-     281,   281,   281,   281,   281,   281,   281,   281,   281,   281,
-     281,   281,   281,   281,   281,   281,   281,   282,   282,   283,
-     283,   283,   283,   283,   283,   284,   284,   285,   285,   285,
-     285,   285,   285,   285,   285,   285,   285,   285,   285,   285,
-     285,   285,   285,   285,   285,   285,   285,   285,   286,   286,
-     286,   286,   287,   287,   288,   288,   288,   289,   290,   290,
-     290,   290,   291,   292,   293,   294,   294,   295,   295,   296,
-     296,   297,   297,   297,   297,   297,   297,   297,   298,   299,
-     299,   299,   299,   299,   299,   299,   299,   300,   300,   300,
-     300,   301,   301,   302,   303,   303,   304,   304,   305,   305,
-     305,   306,   307,   308,   308,   308,   308,   309,   310,   311,
-     311,   312,   313,   313,   314,   314,   315,   315,   315,   315,
-     315,   315,   315,   315,   315,   315,   315,   315,   315,   315,
-     315,   315,   315,   315,   315,   315,   315,   315,   315,   316,
-     317,   318,   319,   320,   320,   320,   321,   321,   321,   322,
-     322,   322,   323,   323,   324,   324,   325,   325,   326,   327,
-     328,   328,   328,   328,   328,   328,   328,   328,   328,   328,
-     328,   328,   329,   330,   330,   331,   331,   332,   332,   333,
-     334,   334,   335,   335,   336,   337,   338,   338,   339,   339,
-     340,   340,   341,   341,   341,   341,   341,   341,   342,   342,
-     343,   343,   344,   344,   345,   345,   346,   346,   346,   346,
-     346,   347,   347,   348,   348,   348,   348,   348,   348,   348,
-     348,   348,   349,   349,   350,   350,   351,   351,   351,   352,
-     353,   353,   354,   354,   354,   354,   354,   354,   354,   354,
-     354,   354,   354,   354,   354,   354,   355,   355,   356,   356,
-     357,   357,   358,   358,   358,   358,   358,   359,   359,   359,
-     360,   360,   360,   361,   361,   361,   361,   361,   361,   361,
-     361,   362,   362,   362,   362,   362,   363,   363,   364,   365,
-     365,   366,   366,   366,   367,   367,   367,   368,   369,   369,
-     370,   370,   371,   371,   372,   373
+     222,   223,   224,   224,   225,   225,   226,   226,   227,   228,
+     228,   228,   228,   229,   229,   229,   229,   230,   230,   230,
+     231,   232,   232,   232,   232,   232,   232,   233,   233,   234,
+     234,   235,   235,   235,   236,   236,   237,   237,   237,   237,
+     237,   238,   238,   239,   239,   240,   240,   240,   241,   241,
+     242,   242,   242,   242,   242,   242,   242,   242,   242,   242,
+     242,   243,   243,   243,   244,   244,   245,   245,   246,   246,
+     247,   247,   247,   247,   247,   248,   248,   249,   249,   249,
+     249,   250,   250,   250,   250,   250,   250,   250,   250,   250,
+     250,   250,   250,   250,   250,   250,   250,   250,   250,   250,
+     250,   250,   250,   250,   250,   250,   250,   251,   251,   252,
+     252,   252,   252,   252,   252,   253,   253,   254,   254,   254,
+     254,   254,   254,   254,   254,   254,   254,   254,   254,   254,
+     254,   254,   254,   254,   254,   254,   254,   254,   255,   255,
+     255,   255,   256,   256,   257,   257,   257,   258,   259,   259,
+     259,   259,   260,   261,   262,   263,   263,   264,   264,   265,
+     265,   266,   266,   266,   266,   266,   266,   266,   267,   268,
+     268,   268,   268,   268,   268,   268,   268,   269,   269,   269,
+     269,   270,   270,   271,   272,   272,   273,   273,   274,   274,
+     274,   275,   276,   276,   276,   276,   277,   278,   278,   279,
+     280,   280,   281,   281,   282,   282,   283,   283,   283,   283,
+     283,   284,   284,   284,   284,   284,   284,   284,   284,   284,
+     284,   284,   284,   284,   284,   284,   284,   284,   284,   284,
+     284,   284,   284,   284,   284,   284,   285,   286,   287,   288,
+     288,   289,   289,   290,   290,   291,   292,   292,   292,   293,
+     294,   295,   295,   296,   296,   297,   297,   298,   299,   299,
+     299,   300,   301,   302,   302,   303,   303,   303,   303,   304,
+     304,   304,   304,   305,   305,   305,   305,   306,   307,   308,
+     308,   309,   309,   310,   311,   311,   311,   312,   313,   313,
+     313,   314,   315,   315,   316,   316,   317,   317,   318,   318,
+     319,   320,   321,   321,   321,   322,   323,   323,   324,   324,
+     325,   325,   326,   326,   327,   327,   328,   328,   328,   328,
+     329,   330,   331,   332,   333,   334,   335,   336,   336,   337,
+     338,   338,   339,   339,   340,   340,   341,   342,   342,   343,
+     343,   344,   344,   345,   346,   346,   347,   347,   348,   348,
+     349,   349,   350,   350,   351,   351,   352,   353,   353,   353,
+     353,   353,   354,   354,   355,   355,   355,   355,   355,   355,
+     355,   355,   356,   357,   357,   357,   358,   358,   359,   359,
+     359,   360,   360,   361,   361,   361,   361,   361,   361,   361,
+     361,   361,   361,   361,   361,   361,   361,   361,   361,   361,
+     362,   362,   363,   363,   364,   364,   364,   364,   364,   365,
+     365,   365,   366,   366,   366,   366,   366,   366,   366,   366,
+     366,   366,   367,   367,   367,   368,   368,   369,   369,   370,
+     370,   371,   372,   372,   373,   373,   374,   374
 };
 
@@ -1247,166 +1123,177 @@
 static const yytype_uint8 yyr2[] =
 {
-       0,     2,     0,     2,     2,     2,     1,     3,     3,     1,
-       3,     2,     2,     3,     3,     2,     2,     2,     1,     1,
-       1,     1,     0,     0,     2,     0,     1,     0,     0,     1,
-       0,     4,     2,     6,     4,     2,     1,     0,     1,     1,
-       0,     2,     3,     0,     2,     3,     1,     3,     1,     1,
-       2,     4,     2,     2,     4,     2,     1,     1,     1,     1,
-       1,     1,     1,     1,     1,     1,     4,     3,     3,     2,
-       3,     0,     1,     1,     1,     1,     1,     1,     1,     1,
+       0,     2,     0,     2,     1,     1,     2,     1,     2,     1,
+       3,     2,     2,     1,     3,     3,     2,     2,     3,     1,
+       0,     0,     1,     0,     2,     4,     2,     5,     2,     1,
+       2,     1,     1,     0,     2,     3,     0,     2,     3,     1,
+       3,     1,     1,     2,     4,     2,     2,     4,     2,     1,
+       1,     1,     1,     1,     1,     1,     1,     1,     4,     3,
+       3,     2,     2,     0,     1,     1,     1,     1,     1,     1,
        1,     1,     1,     1,     1,     1,     1,     1,     1,     1,
-       1,     1,     1,     1,     1,     1,     1,     1,     3,     3,
-       5,     1,     3,     3,     2,     4,     1,     3,     0,     2,
-       2,     3,     1,     1,     1,     4,     6,     4,     1,     3,
-       2,     3,     5,     3,     1,     0,     2,     1,     4,     3,
-       2,     3,     3,     3,     3,     0,     1,     2,     2,     3,
-       5,     3,     0,     2,     2,     1,     5,     5,     2,     3,
-       2,     3,     1,     3,     2,     3,     5,     1,     2,     1,
-       3,     2,     1,     3,     0,     1,     1,     3,     3,     2,
-       1,     3,     2,     2,     0,     6,     7,     0,     2,     2,
-       3,     3,     1,     0,     2,     4,     3,     3,     4,     2,
-       1,     1,     1,     1,     1,     1,     1,     1,     0,     2,
-       1,     3,     0,     2,     3,     1,     3,     2,     3,     1,
-       1,     1,     1,     0,     3,     0,     2,     4,     1,     3,
+       1,     1,     1,     1,     1,     1,     1,     1,     1,     1,
+       3,     3,     5,     1,     3,     3,     2,     4,     1,     3,
+       0,     1,     2,     3,     1,     1,     2,     1,     3,     4,
+       4,     8,     1,     3,     2,     3,     5,     3,     1,     0,
+       2,     1,     4,     3,     2,     3,     3,     3,     3,     0,
+       1,     2,     3,     5,     3,     1,     5,     5,     2,     3,
+       2,     3,     1,     1,     3,     3,     2,     3,     5,     1,
+       2,     1,     3,     2,     1,     3,     0,     1,     1,     3,
+       3,     2,     1,     3,     2,     2,     5,     6,     0,     2,
+       2,     3,     3,     0,     2,     4,     3,     3,     4,     2,
+       1,     1,     1,     1,     1,     1,     1,     0,     2,     1,
+       3,     0,     2,     3,     1,     3,     2,     3,     1,     1,
+       1,     1,     1,     0,     3,     0,     1,     3,     1,     3,
        1,     1,     1,     2,     1,     4,     1,     1,     1,     1,
        1,     1,     1,     1,     1,     1,     0,     3,     1,     3,
-       1,     1,     2,     2,     3,     1,     1,     1,     3,     1,
-       1,     3,     3,     4,     4,     3,     4,     4,     3,     4,
+       1,     1,     2,     2,     3,     1,     1,     1,     1,     1,
+       3,     3,     3,     4,     4,     3,     4,     4,     3,     4,
        4,     4,     4,     4,     4,     4,     4,     4,     4,     4,
-       4,     4,     3,     4,     4,     4,     4,     1,     3,     1,
+       4,     4,     3,     4,     3,     4,     4,     1,     3,     1,
        1,     1,     2,     2,     2,     1,     1,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     3,     2,
-       3,     2,     2,     2,     2,     2,     2,     2,     0,     1,
+       2,     2,     2,     2,     2,     2,     3,     3,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     0,     1,
        2,     2,     2,     1,     1,     1,     1,     0,     1,     2,
-       4,     5,     4,     3,     3,     1,     2,     1,     3,     1,
+       4,     5,     4,     4,     3,     1,     2,     1,     3,     1,
        1,     3,     5,     4,     3,     2,     2,     1,     1,     1,
        1,     1,     1,     1,     1,     2,     2,     1,     2,     1,
-       1,     0,     1,     5,     0,     1,     1,     1,     0,     3,
-       3,     0,     5,     2,     4,     6,     6,     1,     1,     1,
-       3,     3,     1,     3,     3,     1,     1,     5,     5,     4,
-       1,     2,     2,     2,     2,     1,     2,     5,     1,     1,
-       2,     5,     1,     2,     3,     4,     1,     1,     1,     1,
-       1,     1,     1,     1,     3,     3,     3,     2,     2,     0,
-       5,     7,     0,     2,     1,     1,     0,     1,     1,     1,
-       1,     2,     1,     1,     1,     5,     5,     2,     2,     2,
-       2,     1,     0,     4,     6,     1,     3,     2,     2,     2,
-       0,     3,     0,     1,     2,     1,     1,     3,     1,     2,
-       1,     1,     2,     2,     2,     3,     2,     1,     0,     1,
-       2,     2,     0,     2,     3,     3,     3,     3,     1,     3,
-       1,     1,     3,     1,     1,     1,     3,     2,     4,     4,
-       2,     2,     1,     1,     1,     1,     1,     1,     1,     1,
-       1,     3,     1,     1,     3,     3,     3,     3,     2,     3,
-       2,     2,     2,     2,     3,     1,     1,     1,     1,     3,
-       0,     1,     2,     4,     2,     2,     5,     0,     1,     2,
-       1,     1,     1,     3,     3,     3,     3,     3,     3,     1,
-       1,     1,     3,     5,     5,     5,     5,     7,     1,     8,
-       2,     1,     1,     3,     1,     1,     1,     4,     1,     3,
-       0,     4,     1,     3,     3,     1
+       1,     0,     1,     5,     0,     1,     1,     1,     0,     2,
+       2,     5,     2,     4,     6,     6,     1,     1,     3,     3,
+       1,     3,     3,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     2,     1,     1,     2,     2,     2,     3,     2,
+       5,     5,     2,     2,     2,     2,     1,     4,     1,     2,
+       2,     2,     2,     1,     1,     1,     1,     5,     6,     0,
+       3,     0,     4,     0,     4,     4,     1,     1,     1,     1,
+       1,     3,     4,     1,     2,     1,     2,     0,     0,     2,
+       3,     1,     4,     1,     1,     4,     2,     5,     3,     3,
+       1,     4,     2,     6,     8,     5,     3,     1,     1,     1,
+       1,     1,     2,     6,     0,     1,     2,     3,     0,     1,
+       2,     3,     7,     5,     5,     6,     1,     2,     1,     2,
+       5,     4,     0,     1,     2,     3,     6,     4,     2,     3,
+       1,     2,     3,     1,     1,     3,     1,     2,     2,     3,
+       1,     1,     1,     1,     1,     1,     1,     1,     1,     0,
+       4,     7,     1,     3,     2,     2,     2,     0,     3,     0,
+       1,     2,     2,     1,     1,     3,     1,     2,     1,     1,
+       0,     1,     2,     2,     0,     2,     3,     3,     3,     1,
+       3,     1,     1,     3,     1,     1,     1,     3,     5,     4,
+       2,     2,     0,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     3,     1,     1,     3,     3,     3,     3,     2,
+       3,     2,     2,     2,     2,     2,     2,     2,     3,     1,
+       1,     1,     1,     3,     2,     4,     2,     2,     5,     0,
+       1,     2,     1,     1,     1,     1,     3,     3,     3,     3,
+       3,     3,     5,     5,     5,     5,     7,     8,     2,     1,
+       3,     1,     1,     3,     0,     4,     1,     3
 };
 
-/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
-   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
+/* YYDEFACT[STATE-NAME] -- Default reduction number in state STATE-NUM.
+   Performed when YYTABLE doesn't specify something else to do.  Zero
    means the default is an error.  */
 static const yytype_uint16 yydefact[] =
 {
-       2,     0,     1,    37,    20,    21,    18,    19,    27,     6,
-      22,     3,    25,    30,    27,    24,     4,    26,    37,   113,
-      38,     0,   457,     0,   388,   389,     0,     0,     0,     0,
-       0,    29,   354,   108,   108,     0,     0,   392,     0,   488,
-       0,     0,   418,   398,   416,     0,     0,   419,     0,   482,
-     483,   487,   489,   486,     0,     0,     0,   145,   397,   108,
-     108,     0,   396,     0,   420,   124,     0,   445,   157,     0,
-       0,     0,   450,     0,   451,   367,    71,   182,     0,   193,
-     192,   197,   195,   399,   402,   401,   400,   190,   114,   194,
-     196,   338,   435,     5,     9,    22,     0,    22,     0,    22,
-       0,     0,    57,   125,    65,   142,    64,   164,    59,    61,
-      60,    56,     0,    63,    58,   215,     0,   183,   202,   191,
-     432,    62,     0,    25,     0,   380,     0,     0,   385,   412,
-       0,   376,     0,   431,   424,   440,     0,     0,   423,     0,
-       0,     0,   422,     0,     8,     7,    36,    32,     0,     0,
-     285,   286,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   339,   340,
-       0,   347,   350,   349,   342,   343,   344,   341,     0,   403,
-     250,   247,     0,   279,   316,   318,   315,   281,   314,   280,
-     351,   249,     0,     0,   356,   357,   429,     0,    69,   101,
-       0,   355,   427,     0,   150,     0,   148,     0,   428,     0,
-     415,   414,   393,   538,     0,   540,     0,   417,   408,    35,
-     384,     0,   470,   468,     0,   456,     0,     0,     0,     0,
-     162,     0,     0,   138,     0,    53,   172,   173,   158,   143,
-     144,   170,   169,   234,   235,   108,    72,    52,    30,    15,
-      25,     0,     0,    11,    39,    22,    12,     0,     0,    55,
-     166,   127,   164,     0,   125,     0,   236,   120,   125,   165,
-     137,     0,   165,     0,     0,     0,   236,   154,   159,     0,
-       0,     0,   112,    50,     0,   177,   174,   209,   210,     0,
-       0,     0,   179,     0,     0,   178,     0,    16,   236,   368,
-     363,    37,   382,   381,   383,   164,   409,   407,     0,     0,
-       0,   421,     0,   442,   439,   444,   430,     0,   452,   506,
-     507,   485,     0,     0,     0,     0,   338,     0,   505,   492,
-     493,   453,   458,   462,     0,   484,     0,   454,   390,     0,
-       0,   432,   386,     0,   284,   277,     0,     0,     0,     0,
+       2,     0,     1,     7,     9,   105,     0,     0,   482,     0,
+       0,     0,     0,     0,    22,   344,   100,   100,     0,   540,
+       0,     0,   156,   395,     0,     0,     0,   533,   534,   539,
+       0,   535,   538,     0,     0,     0,   135,   100,   100,     0,
+       0,   371,   118,     0,   503,   149,     0,   508,     0,   509,
+     356,    21,    63,     0,     0,   183,   181,   182,   186,   483,
+     486,   485,   484,   180,     0,   184,   185,   328,   492,    20,
+       3,     4,     5,    13,     0,    20,    20,     0,     0,    50,
+     119,    57,   156,    52,    54,    53,    49,     0,    56,    51,
+     205,   173,   191,   489,    55,     0,    19,   364,   366,   394,
+     370,     0,   367,   421,     0,   423,   424,   369,     0,   393,
+     368,     0,   365,     0,   388,     0,     0,     0,   386,   374,
+     497,     0,     0,     0,     0,   373,    32,    20,    31,    26,
+       0,     0,     0,   275,   276,     0,     0,     0,     0,   331,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,   530,   520,   249,     0,   522,   521,     0,
-       0,   247,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   308,     0,     0,
-       0,   282,   283,     0,   354,   319,   317,   317,   345,   348,
-     346,   352,     0,     0,   394,     0,     0,   236,     0,     0,
-     109,   152,   151,   149,     0,     0,   554,     0,   545,   432,
-     542,   550,   541,   546,   341,   247,   314,   544,   548,   550,
-     552,     0,    67,    74,    75,    78,    73,    79,    76,    81,
-      82,    83,    84,    85,    80,    86,    87,    88,    89,    90,
-      91,    92,    93,    94,    95,    77,    96,    97,    68,     0,
-     139,     0,   106,     0,     0,     0,    10,    17,    40,    40,
-      13,     0,     0,     0,   135,     0,    70,     0,     0,   135,
-     123,   164,     0,   126,   121,   141,   164,   236,   236,   164,
-     161,     0,   155,   220,   222,   236,   224,     0,   226,   227,
-     228,   229,   230,     0,   218,   221,   216,    40,   174,   110,
-       0,     0,   212,   207,   211,   181,   184,     0,   338,     0,
-     213,     0,   203,   205,     0,   180,   236,     0,    14,   413,
-     555,   406,     0,   437,   438,   432,   436,     0,   448,     0,
-     443,   446,   474,   475,     0,   314,     0,   471,   473,   490,
-     500,   503,   502,   501,     0,   473,   510,   517,   511,   517,
-     460,   459,   517,   508,   510,   461,     0,     0,     0,     0,
-       0,   498,   455,     0,     0,     0,     0,   252,     0,     0,
-       0,   251,   258,   255,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   272,     0,     0,     0,
-       0,     0,     0,   247,     0,     0,     0,   324,     0,     0,
-       0,   248,     0,     0,   313,   307,   302,   292,   303,   304,
-     305,   301,   291,   297,   299,   293,   295,   287,   288,   289,
-       0,     0,   309,   306,   290,     0,   296,     0,   294,   323,
-       0,   325,     0,     0,   404,   405,   395,     0,   103,   104,
-     102,    66,     0,     0,     0,   317,     0,     0,   467,   469,
-     466,     0,     0,     0,   379,     0,   163,     0,    99,     0,
-     171,    51,     0,    31,    34,   168,    54,   167,     0,   118,
-       0,   136,     0,     0,   127,   129,     0,   125,   241,   245,
-       0,   238,   240,   246,     0,   198,   198,     0,   160,   223,
-       0,     0,     0,   111,     0,   236,   208,     0,     0,   213,
-     186,     0,   189,     0,   204,   433,     0,     0,   364,   369,
-       0,   236,   449,   441,     0,     0,   480,   481,   317,   236,
-       0,   464,   465,   504,   465,     0,   518,   514,   515,   510,
-     512,   463,   499,   495,   496,   497,   494,   550,   550,   387,
-     278,   253,   254,   257,   261,   262,   263,   264,   265,   260,
-     266,   267,   268,   269,   270,   271,   273,   274,   275,   276,
-     256,   248,     0,     0,     0,   523,   524,   527,   528,   525,
-     526,   259,   247,   312,   310,   311,   300,   298,   354,   337,
-     329,   326,   327,   330,   320,   322,   236,   153,   391,     0,
-       0,     0,   543,   377,   549,   378,   553,    98,   107,     0,
-      49,    48,    41,     0,    46,    43,   115,   135,   135,   135,
-     135,   135,   130,   128,   135,   117,   122,   243,     0,   237,
-     242,   140,     0,   146,   147,   156,   232,   233,   231,     0,
-     219,   217,   236,   198,   185,   213,   187,     0,   206,     0,
-       0,     0,     0,   236,   447,   491,     0,     0,     0,   476,
-     472,   473,   510,   517,   519,   509,     0,     0,   338,     0,
-       0,     0,   362,     0,     0,   335,   336,     0,   321,   105,
-       0,   547,     0,   100,     0,    42,     0,    33,   119,   131,
-     132,   133,   134,     0,   239,   244,   246,     0,   199,   200,
-     225,   198,   358,   188,   214,   375,   365,   366,   372,   371,
-     370,     0,   434,   479,   478,     0,   513,   425,   426,     0,
-     533,   535,   534,   353,   334,     0,   331,   328,     0,   551,
-      47,    44,     0,   116,     0,   358,   175,     0,     0,     0,
-     410,   516,     0,   333,     0,   539,    45,   201,   176,     0,
-       0,   374,   373,     0,     0,   332,   359,   360,   411,   536,
-       0,   537
+       0,     0,   334,   329,   330,     0,   337,   340,   339,   333,
+     328,   332,     0,   346,   347,   239,   237,     0,   269,   306,
+     308,   305,   271,   304,   270,   341,   384,   238,     0,    61,
+      93,     0,   345,   382,   101,   140,     0,   138,     0,   383,
+     588,     0,     0,   157,    29,   156,     0,   432,    28,   488,
+     487,   392,     0,     0,   377,   521,   519,     0,   379,     0,
+       0,     0,     0,   154,     0,     0,   131,     0,    46,   164,
+     165,   150,   162,   161,     6,   224,   225,   100,    64,   200,
+     198,   199,     0,    45,   121,     0,   156,   107,     0,     0,
+       8,    11,    12,    20,    21,     0,     0,    16,    17,     0,
+       0,    48,   158,    62,   119,     0,   226,   114,   119,   157,
+       0,     0,     0,     0,   226,   146,   151,     0,     0,   104,
+     206,    43,     0,   168,     0,     0,     0,   170,     0,     0,
+     169,   226,   352,   399,   418,   418,   462,   390,   389,   391,
+       0,     0,   532,   372,     0,   499,   496,   501,   502,   385,
+     375,   560,   561,   537,     0,     0,     0,     0,     0,     0,
+       0,   328,     0,   559,   543,   544,   376,   510,   514,     0,
+     536,     0,    18,   410,     0,     0,   274,   267,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   573,   574,   572,     0,   575,
+       0,     0,   237,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   298,     0,
+       0,     0,   272,   273,   532,   344,   309,   307,   307,   335,
+     338,   336,   342,     0,   226,     0,     0,   143,   142,   141,
+     139,     0,     0,    30,   428,     0,   417,   437,     0,   591,
+     594,   589,   525,   526,     0,   304,     0,   522,   524,   541,
+     378,   332,   237,   304,   592,   594,   596,     0,    59,    66,
+      67,    70,    65,    71,    68,    73,    74,    75,    76,    77,
+      72,    78,    79,    80,    81,    82,    83,    84,    85,    86,
+      87,    69,    88,    89,    60,     0,   132,     0,    98,     0,
+       0,     0,     0,   202,   196,   201,   172,   129,     0,     0,
+       0,     0,   129,     0,     0,   156,    10,    14,    15,    33,
+      33,     0,     0,     0,   117,   156,     0,   120,   115,   134,
+     156,   226,   226,   156,   153,     0,   147,   210,   212,   226,
+     214,     0,   216,   217,   218,   219,   220,     0,   208,   211,
+      33,     0,   102,   226,   174,     0,   328,     0,   203,   332,
+       0,   192,   194,     0,   226,     0,   401,   438,     0,   444,
+       0,     0,   463,     0,   494,   495,     0,   493,     0,   506,
+       0,   500,   504,   551,   552,   554,   553,   557,   556,   555,
+       0,   524,     0,   569,   569,   569,   512,   511,   562,     0,
+     513,     0,     0,     0,     0,     0,   549,   405,   467,     0,
+     242,     0,     0,     0,   241,   248,   245,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   262,
+       0,   264,     0,     0,     0,   237,     0,     0,     0,     0,
+     314,     0,     0,   240,     0,     0,   303,   297,   292,   282,
+     293,   294,   295,   291,   281,   289,   290,   283,   288,   277,
+     278,   279,     0,     0,   299,   296,   280,     0,   285,     0,
+     284,     0,     0,   315,     0,     0,     0,    95,    96,    94,
+      58,     0,     0,     0,     0,   436,     0,     0,     0,     0,
+     530,   531,   307,   226,     0,   516,   518,   520,   517,     0,
+       0,     0,   387,     0,   155,     0,    91,     0,   163,    44,
+     197,     0,   112,     0,   130,     0,     0,   108,   121,   123,
+       0,     0,     0,   156,   431,     0,    25,    23,   160,    47,
+     159,   119,   231,   235,     0,   228,   230,   236,     0,   187,
+     187,     0,   152,   213,     0,     0,   207,   103,   226,   187,
+       0,     0,   203,   176,     0,   179,     0,   193,   490,     0,
+       0,   353,   357,   396,   409,   407,   408,   403,     0,   406,
+     419,   441,   481,   422,   439,   440,     0,   448,   445,     0,
+     473,     0,   468,   470,   464,   461,   418,   489,   507,   498,
+       0,   558,   542,     0,   570,   566,   564,   567,     0,   515,
+     550,   546,   547,   548,   545,   397,   268,   243,   244,   247,
+     251,   252,   253,   254,   255,   250,   256,   257,   258,   259,
+     260,   261,   263,   265,   266,   246,     0,     0,     0,   576,
+     577,   580,   581,   578,   579,   249,   237,   302,   300,   301,
+     287,   286,   313,   344,   327,   319,   316,   317,   320,   310,
+     312,   226,   145,   144,     0,     0,   453,     0,   460,     0,
+       0,     0,   590,   380,     0,     0,   532,   527,   523,   593,
+     381,   597,    90,    99,     0,   109,   129,   129,   129,   129,
+     129,   124,   122,     0,     0,   110,     0,     0,   427,    42,
+      41,    34,     0,    39,    36,    27,   116,   233,     0,   227,
+     232,   133,     0,   136,   137,   148,   222,   223,   221,     0,
+     209,   187,   348,   175,   203,   177,     0,   195,     0,     0,
+       0,     0,     0,     0,   400,   420,   442,     0,   456,   446,
+       0,   449,     0,   418,     0,   480,     0,   474,   476,   469,
+     471,   465,   226,   505,     0,   569,   571,   563,   328,     0,
+       0,     0,   351,     0,     0,   325,   326,     0,   311,    97,
+       0,     0,     0,   435,     0,     0,   529,     0,    92,   113,
+     125,   126,   127,   128,     0,     0,   466,     0,     0,    35,
+       0,    24,   229,   234,   236,     0,   188,   189,   215,   348,
+       0,     0,   166,   178,   204,   363,   354,   355,   360,   359,
+     358,     0,   413,   415,     0,   398,   399,     0,   457,   458,
+     450,   443,   418,   447,   478,     0,   472,   477,   226,     0,
+     565,   582,   583,   584,   343,   324,     0,   321,   318,     0,
+       0,     0,   433,   595,   528,     0,   129,   452,    40,    37,
+       0,     0,   167,   349,   350,     0,     0,   411,   414,   416,
+     399,   402,     0,   459,   451,   475,   479,   491,   568,   323,
+       0,   587,     0,     0,     0,     0,     0,    38,   190,   362,
+     361,   412,   404,   454,   322,   434,   585,   111,   455,     0,
+     586
 };
 
@@ -1414,129 +1301,138 @@
 static const yytype_int16 yydefgoto[] =
 {
-      -1,     1,    11,    93,    94,    95,   259,    12,   260,    13,
-      18,    15,    96,    97,   147,    14,    98,   265,   693,   907,
-     833,   834,    99,   255,   477,   478,   245,   208,   209,   426,
-     481,   215,   293,   294,   100,   101,   272,   698,   102,   103,
-     277,   273,   699,   700,   104,   105,   280,   106,   107,   108,
-     109,   110,   432,   111,   112,   287,   288,   242,   275,   269,
-     270,   113,   252,   114,   530,   295,   529,   115,   116,   302,
-     539,   117,   118,   119,   853,   918,   305,   542,   299,   540,
-     732,   296,   523,   524,   859,   525,   503,   710,   711,   712,
-     355,   190,   356,   191,   192,   411,   653,   635,   193,   661,
-     194,   195,   196,   197,   663,   811,   812,   813,   198,   199,
-     200,   420,   415,   212,   206,   956,   957,   201,   121,   122,
-     310,   738,   739,   927,   928,   123,   124,   125,   126,   127,
-     202,   128,   551,   316,   222,   228,   129,   130,   131,   308,
-     132,   133,   321,   134,   324,   559,   135,   136,   560,   561,
-     137,   138,   580,   341,   585,   328,   235,   566,   567,   139,
-     343,   140,   141,   344,   569,   346,   581,   582,   583,   757,
-     386,   387,   388,   889,   225,   142,   441,   442,   443,   449,
-     677,   451,   143,   552
+      -1,     1,    70,    71,    72,    73,   250,    74,   865,    75,
+     205,   129,   127,   696,   951,   862,   863,    76,   237,   463,
+     464,   228,   189,   190,   403,   467,   196,   281,   282,    77,
+      78,   246,   247,   681,    79,    80,   267,   248,   682,   683,
+      81,    82,    83,    84,    85,   409,    86,    87,   275,   276,
+     225,   206,   261,   262,    88,   233,    89,   283,   522,    90,
+     287,   527,    91,    92,   873,   956,   290,   531,   242,   528,
+     725,   284,   517,   518,   879,   519,   497,   704,   705,   706,
+     337,   175,   338,   176,   177,   392,   635,   617,   178,   643,
+     179,   180,   181,   182,   645,   816,   817,   818,   183,   184,
+     185,   401,   396,   193,   186,   962,   187,    94,    95,   731,
+     732,   967,   968,   740,    97,    98,   734,    99,   100,   536,
+     737,   892,   101,   738,   739,   334,   893,   974,   975,   655,
+     537,   102,   103,   104,   105,   106,   207,   418,   538,   743,
+     744,   107,   747,   748,   900,   901,   108,   749,   902,   981,
+     109,   110,   541,   542,   111,   543,   755,   752,   906,   907,
+     908,   745,   112,   113,   114,   115,   116,   211,   291,   117,
+     118,   303,   119,   306,   550,   120,   121,   551,   552,   122,
+     566,   326,   570,   214,   218,   426,   427,   546,   123,   328,
+     124,   428,   429,   331,   567,   568,   765,   368,   369,   854,
+     125,   420,   421,   435,   658,   437
 };
 
 /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
    STATE-NUM.  */
-#define YYPACT_NINF -711
+#define YYPACT_NINF -845
 static const yytype_int16 yypact[] =
 {
-    -711,   923,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,   -98,  5724,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,   -51,  -711,   -47,  -711,  -711,  4731,    54,  2666,    70,
-     115,  -711,  4731,    34,    40,  2666,   117,  -711,   -63,  -711,
-       7,  4731,  -711,  -711,   -39,    66,   -63,  -711,   137,  -711,
-    -711,  -711,  -711,  -711,   184,   141,   170,  -711,  -711,   199,
-     199,   155,  -711,   175,  -711,  -711,    37,  -711,  -711,    92,
-     -63,   -63,  -711,   129,  -711,  -711,   116,  -711,   -63,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,   217,  -711,  -711,    31,  -711,    96,  -711,
-     -64,   187,    97,   156,  -711,   149,  -711,   384,   390,  -711,
-    -711,   395,   165,  -711,  -711,    91,   -15,    80,   125,   372,
-     416,  -711,   253,   -98,   -63,  -711,   -63,   -63,  -711,   247,
-    4731,  -711,    24,   434,  -711,   267,   278,  2666,  -711,   270,
-    5575,   270,  -711,  2341,  -711,  -711,  -711,  -711,  4731,  4731,
-    -711,  -711,  4731,   276,   279,   280,  4731,  4731,  4731,   285,
-     291,   292,   296,   299,   301,   309,   310,   313,   316,   317,
-     318,  4731,   319,   325,   328,   329,   330,  4859,  -711,  -711,
-     331,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  4731,  2530,
-    -711,  -711,  4731,   304,  -711,   334,   342,  -711,   343,   354,
-     -33,  -711,    43,  4731,  -711,  2530,  -711,   356,   528,  -711,
-    4731,  2530,  -711,   534,  -711,   376,  -711,   376,  -711,  4731,
-    -711,  -711,  -711,  -711,  4731,  -711,  1494,  -711,  -711,  -711,
-    -711,   356,  -711,  -711,  4987,  -711,   356,   356,   376,  2588,
-    -711,   377,   356,  -711,  4731,   544,  -711,  -711,  -711,  -711,
-    -711,  -711,   546,  -711,  -711,   199,  -711,  -711,  5724,  -711,
-     -98,   -51,   -51,  -711,  -711,  -711,  -711,   557,   394,   561,
-    -711,    21,    33,   144,   397,   139,   388,  -711,   397,   356,
-    -711,   139,  -711,   399,   402,   139,   388,   571,  -711,   407,
-     733,   575,  -711,  -711,   -51,   572,  -711,  3067,  -711,   401,
-     215,  3963,  -711,  5115,   -15,  -711,   425,  -711,   388,  -711,
-     601,  -711,  -711,  -711,  -711,   384,   356,  2530,  4731,  4731,
-     356,  -711,   429,  4091,  -711,  -711,  -711,  5430,  -711,  -711,
-    -711,  -711,  4731,  4731,  4731,  4731,   610,  5430,  -711,   304,
-     354,  -711,  1098,   616,   588,   618,  5621,  4859,  -711,   441,
-     443,  -711,  -711,  1515,   670,  2530,    27,  4731,  4731,  4731,
-      36,  1550,    45,  4731,  4731,  4731,  4731,  4731,  4731,  4731,
-    4731,  4731,  4731,  4731,  4731,  1572,  4731,  4731,  4731,  4731,
-    4731,  4859,  2530,  1594,   782,  -711,   500,   630,   631,  4731,
-    1615,   633,  3451,  4731,  4731,  4731,  4731,  4731,  4731,  4731,
-    4731,  4731,  4731,  4731,  4731,  4731,  4731,  3195,  4731,  3579,
-    3707,  -711,   128,   356,  4731,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  4731,  4731,  -711,  1637,    48,   388,    70,  1697,
-    -711,  -711,   641,   641,  1819,  1173,  -711,   304,   -24,    -1,
-     457,   647,  -711,  -711,   471,   472,   151,    -1,  -711,   650,
-    -711,    62,   641,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,   651,   634,
-    -711,    71,  2530,   476,   488,   -63,  -711,  -711,   480,   480,
-    -711,  4731,    72,   394,   314,  4731,  -711,   491,   495,   314,
-    -711,   384,  2538,  -711,  -711,  -711,   384,   388,   388,   384,
-    -711,   407,   571,  -711,  -711,   388,  -711,   486,  -711,  -711,
-    -711,  -711,  -711,   358,  -711,  -711,  -711,   480,  -711,  -711,
-     497,  4219,  -711,  -711,  2530,  -711,  -711,  3963,  3323,   487,
-     665,  4347,  -711,  2530,   489,  -711,   388,    23,  -711,  -711,
-    -711,  -711,   667,  2530,  2530,  -711,  -711,   498,  2530,   493,
-     672,  -711,  -711,  -711,  5621,  3835,    75,  -711,   119,  -711,
-    2530,  2530,  2530,  2530,  4731,   530,  5850,  2530,   304,  1840,
-    -711,   674,  2530,  -711,  5850,  -711,  5621,  5621,  5621,  5621,
-    5621,   654,  -711,   356,   356,  2666,  4731,  -711,    84,    85,
-    1879,  -711,  -711,  -711,  1900,  1921,  1942,  1963,  2006,  2027,
-    2145,  2209,  2230,  2251,  2272,  2293,  -711,    86,    88,    89,
-      90,    98,  2327,   678,   687,   693,  4859,  -711,  4859,  4859,
-      99,  -711,  4731,  4731,  2530,  -711,   710,   710,   569,   569,
-     670,   814,   814,   814,   814,   814,   814,   133,   133,   128,
-    4731,  4731,  2530,  -711,   128,  4731,   814,  4731,   814,   304,
-     695,  2811,   517,   520,  2530,  2530,  -711,   356,  -711,  -711,
-    -711,  -711,   532,   619,  4731,  2811,   -49,   526,  -711,  -711,
-    -711,   -49,   527,   356,  -711,  2588,  -711,  4731,  -711,  4731,
-    -711,  -711,    67,  -711,   681,  2530,  -711,  -711,   689,    50,
-     716,  -711,  2348,   691,   538,  -711,   705,   397,  4731,  -711,
-     105,  -711,  -711,  1384,   356,   707,   707,   407,  -711,  -711,
-     287,   733,   732,  -711,   568,   388,  -711,   558,  4219,   665,
-    -711,   570,  -711,   560,  -711,  -711,   738,   617,   741,  -711,
-    4731,   388,  -711,  -711,  4091,   536,  -711,  -711,  2811,   519,
-    5430,  -711,  -711,  2530,   727,   106,  -711,  2530,  2530,  5850,
-    2530,   674,   574,   654,   654,   654,   406,   647,   650,  -711,
-    2530,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  5243,  5243,  5243,  2530,  -711,  2530,  -711,  2530,
-    -711,  -711,   573,   814,   814,   128,   814,   814,  4731,  2939,
-    1406,   745,  -711,  -711,   334,  -711,   388,  -711,  -711,  2475,
-     107,   744,  -711,  -711,  -711,  -711,  -711,  -711,  2530,   109,
-    -711,  -711,  -711,   110,  -711,   577,  -711,   314,   314,   314,
-     314,   314,   354,  -711,   314,  -711,  -711,  2530,  2538,  -711,
-    4475,  -711,  5371,  -711,  -711,   571,  -711,  -711,  -711,   579,
-    -711,  -711,   388,   707,  -711,   665,  -711,  4219,  -711,   -50,
-     581,   582,  1196,   388,  -711,  -711,  1362,   580,   356,  -711,
-    -711,   588,  5891,  2530,  -711,  -711,   583,   584,   747,   585,
-     590,   591,  -711,   592,  4731,  1428,  4731,  2811,  -711,  -711,
-     754,  -711,   356,  -711,    26,  -711,    93,  -711,  -711,    29,
-      29,   586,   113,   737,  -711,  -711,  2530,  4603,  -711,  2530,
-    -711,   707,    64,  -711,  -711,   649,  -711,   770,  -711,  -711,
-    -711,  4731,  -711,  -711,   457,   596,  2530,  -711,  -711,  4731,
-    -711,  -711,  -711,  -711,  2530,  4731,  1471,  -711,  4731,  -711,
-    -711,  -711,   111,  -711,   597,    64,  -711,   162,   609,   611,
-    1282,  -711,  1305,  2530,  4731,  2530,  -711,  -711,  -711,  4731,
-    4731,  -711,  -711,  4731,  4731,  2530,  2530,  2530,  2530,  1328,
-    4731,  2530
+    -845,   967,  -845,  -845,  -845,  -845,   -22,    45,  -845,    94,
+     186,  3621,   199,   238,  -845,  4658,    16,    36,  3621,  -845,
+     369,   256,    56,  -845,   299,   280,   268,  -845,  -845,  -845,
+     306,  -845,  -845,   409,   311,   350,  -845,   357,   357,   119,
+     354,  -845,  -845,    53,  -845,  -845,   420,  -845,   386,  -845,
+    -845,  5758,   363,   274,   280,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,   237,  -845,  -845,   549,  -845,  -845,
+    -845,   122,   563,  -845,   440,  -845,  -845,   319,   433,   436,
+     159,   495,   622,   624,  -845,  -845,   523,   329,  -845,  -845,
+     398,   102,   163,  -845,  -845,   471,  -845,  -845,  -845,  -845,
+    -845,   215,  -845,  -845,   215,  -845,  -845,  -845,   215,  -845,
+    -845,   215,  -845,   280,  -845,   280,   280,    20,   630,  -845,
+     472,    44,  3621,   306,  5477,  -845,  -845,  -845,  -845,  -845,
+    4658,  4658,  4658,  -845,  -845,  4658,   473,   474,   477,  -845,
+    4658,  4658,  4658,   478,   484,   486,   487,   488,   494,   496,
+     497,   498,   499,   500,   501,  4658,   505,  4658,   507,   508,
+     511,  4767,  -845,  -845,  -845,   512,  -845,  -845,  -845,  -845,
+    -845,  -845,  4658,  -845,  2490,  -845,  -845,  4658,   470,  -845,
+     513,   515,  -845,   516,   522,   270,  -845,  -845,   524,   654,
+    -845,  4658,  2490,  -845,  -845,  -845,   277,  -845,   277,  -845,
+    -845,  4658,  4658,  -845,  -845,   110,   326,  -845,  -845,  -845,
+    -845,  -845,   524,  5347,  4767,  -845,  -845,  4876,  -845,   524,
+     524,   277,  2573,  -845,   527,   524,  -845,  4658,   665,  -845,
+    -845,  -845,  -845,   680,   563,  -845,  -845,   357,  -845,  -845,
+    2967,  -845,   526,  -845,    88,   524,    32,  -845,   384,    82,
+    -845,  -845,  -845,  -845,  5621,    45,    45,  -845,  -845,   687,
+     533,   691,  -845,  -845,   535,   442,   534,  -845,   535,   524,
+     442,   537,   539,   442,   534,   699,  -845,   545,   847,  -845,
+    -845,  -845,    45,   714,   564,   434,  3874,  -845,  4985,   274,
+    -845,   534,   727,   122,   122,   122,   258,  -845,  -845,  -845,
+    4658,  4658,  -845,  -845,   571,  3983,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  4658,  4658,  4658,  4658,  4658,  4658,
+    4658,   726,  5347,  -845,   470,   522,  -845,  1249,   730,   555,
+     561,  5523,  -845,  2490,   572,  1332,   875,  2490,    38,  4658,
+    4658,  4658,    48,  1353,    61,  4658,  4658,  4658,  4658,  4658,
+    4658,  4658,  4658,  4658,  4658,  4658,  4658,  1514,  4658,    68,
+    4658,  4658,  4658,  4767,  2490,  1533,   753,  1552,   278,   731,
+    4658,  1616,   733,  3294,  4658,  4658,  4658,  4658,  4658,  4658,
+    4658,  4658,  4658,  4658,  4658,  4658,  4658,  4658,  3076,  4658,
+    3403,  3512,  -845,   185,  -845,  4658,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,    69,   534,   199,  1635,  -845,  -845,   734,
+     734,  1129,  1713,  -845,  -845,   576,  -845,  -845,   736,   470,
+     739,  -845,  -845,  -845,  5523,  3765,    79,  -845,   555,  -845,
+     740,   581,   582,   439,  -845,   743,  -845,   105,   734,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,   744,   717,  -845,   106,  2490,   588,
+     591,   280,  4092,  -845,  -845,  2490,  -845,   598,  4658,    31,
+     237,   594,   598,   595,   602,   125,  -845,  -845,  -845,   609,
+     609,  4658,   109,   533,  -845,   622,  2531,  -845,  -845,  -845,
+     622,   534,   534,   622,  -845,   545,   699,  -845,  -845,   534,
+    -845,   615,  -845,  -845,  -845,  -845,  -845,   123,  -845,  -845,
+     609,   618,  -845,   534,  -845,  3874,  3185,   585,   750,    34,
+    4201,  -845,  2490,   592,   534,    80,  4331,  5955,    78,  5879,
+      13,    85,  -845,   215,  2490,  2490,   524,  -845,   619,  2490,
+     616,   778,  -845,  2490,  2490,  2490,  2490,  2490,  2490,  2490,
+    4658,   337,  1249,  2490,   706,  1732,  -845,   779,  -845,  1249,
+    -845,  5523,  5523,  5523,  5523,  5523,   760,  4658,  -845,  4658,
+    -845,   111,   115,  1751,  -845,  -845,  -845,  1796,  1815,  1834,
+    1912,  1931,  1995,  2014,  2033,  2092,  2111,  2130,  2194,  -845,
+     121,  -845,   130,   136,   149,   781,   785,   786,  4767,  4767,
+    -845,  4767,   150,  -845,  4658,  4658,  2490,  -845,   542,   542,
+     806,   806,   875,   887,   887,   887,   887,   887,   887,   164,
+     164,   185,  4658,  4658,  2490,  -845,   185,  4658,   887,  4658,
+     887,   524,   787,  2640,   627,   629,   524,  -845,  -845,  -845,
+    -845,   295,  4658,  6031,  4658,  -845,  4658,    19,   631,   337,
+    -845,  -845,  2640,    83,  5347,  -845,  -845,  -845,  -845,    19,
+     632,   524,  -845,  2573,  -845,  4658,  -845,  4658,  -845,  -845,
+    -845,   771,    42,   547,  -845,  2213,   636,  -845,   637,  -845,
+     776,  4658,  4658,   135,  -845,   242,  -845,   774,  2490,  -845,
+    -845,   535,  4658,  -845,   151,  -845,  -845,  1253,   524,   780,
+     780,   545,  -845,  -845,   476,   847,  -845,  -845,   534,   780,
+     641,  4092,   750,  -845,   645,  -845,   644,  -845,  -845,   804,
+     688,   809,  -845,  2490,  -845,  -845,  -845,   773,   215,  -845,
+     215,   653,  -845,  -845,  -845,  -845,   652,   536,  -845,   215,
+    -845,  2749,   655,   664,  -845,  -845,   122,  -845,  -845,  -845,
+    3983,  2490,  -845,   152,  -845,  2490,  2490,  2490,  1249,   779,
+     570,   760,   760,   760,   593,  -845,  2490,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  5094,  5094,  5094,  2490,
+    -845,  2490,  -845,  2490,  -845,  -845,   667,   887,   887,   185,
+     887,   887,   470,  4658,  2858,  1415,   828,  -845,  -845,   513,
+    -845,   534,  -845,  -845,  2291,   670,  -845,   671,  -845,  2310,
+    1150,   829,  -845,  -845,  1233,   672,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  2490,   153,  -845,   598,   598,   598,   598,
+     598,   522,  -845,   832,   676,  -845,  2329,  2374,  -845,  -845,
+    -845,  -845,   154,  -845,   678,  -845,  -845,  2490,  2531,  -845,
+    4440,  -845,  5203,  -845,  -845,   699,  -845,  -845,  -845,   679,
+    -845,   780,   231,  -845,   750,  -845,  4092,  -845,   291,   681,
+     683,  4658,   586,   215,   122,   122,  -845,  4658,   685,  -845,
+     454,  -845,   215,   122,  4658,  2490,   155,  -845,   842,  -845,
+    -845,  5955,   534,  -845,  1831,  2490,  -845,  -845,   832,   684,
+     686,   689,  -845,   690,  4658,  1435,  4658,  2640,  -845,  -845,
+     845,  4658,  4658,  -845,  4658,   524,  -845,   524,  -845,  -845,
+      66,    66,   693,   143,  4658,   833,  -845,   768,    60,  -845,
+     259,  -845,  -845,  -845,  2490,  4549,  -845,  2490,  -845,   231,
+    4658,  4658,  -845,  -845,  -845,   729,  -845,   851,  -845,  -845,
+    -845,   695,   696,   702,   215,  -845,   122,  2393,  -845,   703,
+    -845,  -845,   122,  5955,  -845,  2749,  -845,  4658,   534,   701,
+    2490,  -845,  -845,  -845,  -845,  2490,  4658,  1455,  -845,  4658,
+     704,  2412,  1171,   470,   697,  1192,   598,  -845,  -845,  -845,
+     157,   705,  -845,  2490,  2490,   709,   713,   716,  -845,  -845,
+     122,  4331,   784,  -845,  5955,  -845,  -845,  -845,  -845,  2490,
+    4658,  2490,  4658,  6107,  4658,  4658,   855,  -845,  -845,  -845,
+    -845,  -845,  4331,   719,  2490,  2490,  1213,  -845,  -845,  4658,
+    2490
 };
 
@@ -1544,1252 +1440,1297 @@
 static const yytype_int16 yypgoto[] =
 {
-    -711,  -711,  -711,  -711,   523,  -711,    30,  -711,   774,  -711,
-     -66,   772,  -711,  -711,    65,     6,  -711,  -711,  -430,  -711,
-    -118,  -110,  -711,  -711,   123,  -711,  -711,  -711,   373,  -711,
-     120,     1,  -711,  -711,  -711,  -711,  -711,  -480,  -711,  -711,
-    -264,   312,  -439,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,   -68,  -711,  -711,  -276,   300,   -35,   -85,   548,
-     324,  -711,  -711,  -711,   274,  -711,  -711,  -711,  -711,  -711,
-     281,  -711,  -711,  -711,  -699,  -711,  -711,  -711,   515,  -290,
-    -666,  -711,  -711,   100,  -711,   749,  -104,  -711,   -25,   -17,
-     -26,  -136,    56,  -176,  -432,  -497,  -711,  -711,  -103,  -711,
-    -711,  -711,  -204,  -711,   404,   159,   -57,    95,    -5,   -70,
-    -711,  -711,  -197,  -398,   -30,  -108,  -711,  -166,  -711,  -711,
-    -711,  -711,   -23,  -711,  -105,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,   -28,  -711,  -711,  -711,   708,   302,
-    -208,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,   118,
-    -711,  -711,  -711,  -711,  -711,   277,  -711,  -711,   114,  -711,
-    -711,  -711,  -711,  -306,   720,  -263,  -226,  -711,  -673,  -554,
-     514,   482,  -326,  -710,   308,  -711,   273,  -202,  -711,   275,
-    -416,  -711,  -711,  -711
+    -845,  -845,  -845,   -96,   830,   628,   -26,  -845,  -845,  -845,
+     399,   156,  -845,   -94,  -845,   -67,   -63,  -845,  -845,   232,
+    -845,  -845,  -845,   509,  -845,   234,    30,  -845,  -845,  -845,
+    -845,  -845,   444,  -464,  -845,  -845,  -238,   438,  -242,  -845,
+    -845,  -845,  -845,  -845,  -845,   -47,  -845,  -845,  -263,   417,
+     -27,   -50,   668,   437,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,   404,  -845,  -845,  -671,  -845,  -845,  -845,   642,  -231,
+    -656,  -845,  -845,   217,  -845,   882,  -236,  -845,    67,    70,
+     -11,   -78,    55,  -144,  -458,  -507,  -845,  -845,   -97,  -845,
+    -845,  -845,  -845,  -845,   540,  -845,     9,   279,     1,   -70,
+    -845,  -845,  -182,  -382,   365,   -20,  -128,  -845,  -845,  -845,
+      52,  -845,   -73,    43,  -845,  -630,  -845,  -515,  -514,  -844,
+    -845,  -845,  -845,  -845,  -566,  -718,  -845,  -845,  -845,  -845,
+    -294,  -845,  -845,  -845,  -845,  -845,  -185,  -845,  -845,  -845,
+    -845,  -845,  -845,  -663,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,   405,  -845,  -845,  -845,  -845,  -845,   -40,
+    -787,  -845,  -845,  -845,  -845,  -845,  -845,   -38,   190,    11,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,   191,  -845,
+    -845,  -845,  -845,   506,  -845,  -845,   288,  -384,  -845,  -845,
+    -845,   -39,   834,  -250,  -126,  -699,  -522,  -140,  -287,  -465,
+    -845,  -845,  -213,  -845,   519,  -845
 };
 
 /* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
    positive, shift that token.  If negative, reduce the rule which
-   number is the opposite.  If zero, do what YYDEFACT says.
-   If YYTABLE_NINF, syntax error.  */
-#define YYTABLE_NINF -511
+   number is the opposite.  If YYTABLE_NINF, syntax error.  */
+#define YYTABLE_NINF -542
 static const yytype_int16 yytable[] =
 {
-     189,   384,   205,   421,   338,   218,   211,   533,   120,   205,
-     500,   385,   391,   512,   504,   226,   660,   854,   230,   706,
-     281,   568,   283,   440,   145,   758,   285,   438,   760,   318,
-     596,   575,   438,   682,   448,   217,   282,   339,   213,   596,
-     591,   383,   249,   250,   213,   494,   422,   423,   596,   830,
-     257,   667,   840,   837,   736,   625,   243,   311,   445,   694,
-     238,   239,   701,   866,   261,   683,   262,   701,   278,  -361,
-     340,   838,   839,   840,   687,   493,   821,   289,   750,    17,
-     756,   590,   756,   890,   891,   756,   885,   596,   596,   596,
-     830,   596,   596,   596,   290,   291,   312,   723,   313,   314,
-     274,   596,   596,   300,   317,   267,   220,   326,   848,   882,
-     897,   205,   687,   904,   904,   268,   830,  -164,   146,   925,
-      91,  -164,   353,   354,   221,   419,   292,   263,   437,   266,
-     227,   361,   148,   437,   838,   839,   840,   926,   351,   586,
-     329,   330,   587,   588,   589,   375,   414,   498,   303,   433,
-     319,   382,   279,   408,   297,   416,   406,   407,   408,   240,
-     246,   298,   390,   241,   922,  -315,   412,   969,   499,  -164,
-     452,   384,   935,  -164,   247,   240,   240,   425,   675,   241,
-     241,   385,   510,   223,   429,   240,   224,   497,  -314,   241,
-    -361,   338,   737,   434,   487,   831,   253,   254,   435,   923,
-     495,   338,   427,   213,   546,   623,   577,   597,   382,   885,
-     338,   383,   360,   320,   362,   385,   601,   841,   482,   248,
-     496,   214,   955,   424,   339,   603,   439,   216,   668,   446,
-     549,   447,   450,   203,   339,   229,   831,   480,   841,   578,
-     501,   726,   684,   339,   258,   383,   506,   832,   729,   207,
-     509,   688,   696,   120,   264,   751,   485,   340,   745,   301,
-     884,   884,   831,   884,   771,   772,   786,   340,   787,   788,
-     789,   534,   579,   951,   505,   534,   340,   543,   790,   801,
-     762,   763,   764,   765,   766,   849,   883,   901,   970,   903,
-     905,   966,   553,   554,   210,   490,   219,   558,   251,   752,
-     796,   841,   798,   800,   304,   590,   570,   571,   572,   573,
-     659,   550,   590,   409,   410,   555,   231,   548,   409,   410,
-     236,   382,   565,   669,    91,   276,   488,   489,   590,   936,
-     417,   680,   565,   600,   286,   150,   151,   604,   605,   606,
-     607,   608,   609,   610,   611,   612,   613,   614,   615,   237,
-     755,   886,   887,   232,   244,   622,   271,   908,   761,   527,
-     233,   721,   722,   234,   913,   391,   634,   636,   637,   638,
-     639,   640,   641,   642,   643,   644,   645,   646,   647,   648,
-     649,   652,   654,   656,   658,   440,   756,   282,   211,   438,
-     438,   536,   448,   284,   537,   306,   664,   665,   282,   909,
-     910,   911,   912,   715,   716,   701,   701,   701,   701,   701,
-     893,   719,   701,   598,   599,  -164,   707,   342,   347,  -164,
-     307,   714,   309,   315,   717,   856,   857,   858,   338,   587,
-     588,   589,   617,   618,   619,   620,   621,   322,   865,   884,
-     577,   855,   735,   846,   881,   630,   323,   325,   577,   327,
-     338,   338,   338,   338,   338,   357,   802,   691,   358,   359,
-     385,   339,   385,   385,   363,   695,   796,   798,   800,   702,
-     364,   365,   438,   578,   822,   366,   713,   438,   367,   824,
-     368,   578,   590,   339,   339,   339,   339,   339,   369,   370,
-     437,   437,   371,   413,   340,   372,   373,   374,   376,   590,
-     590,   590,   590,   590,   377,   534,   579,   378,   379,   380,
-     389,   534,   534,   414,   579,   390,   340,   340,   340,   340,
-     340,   416,   417,   418,   392,    91,   393,   394,   395,   396,
-     397,   428,   398,   399,   400,   401,   402,   403,   430,   749,
-     404,   405,   406,   407,   408,   431,   479,   483,   753,   484,
-     586,   329,   330,   587,   588,   589,   586,   329,   330,   587,
-     588,   589,   491,   267,   493,   769,   276,   502,   507,   205,
-     770,   508,   391,   437,   511,   528,   286,   924,   437,   526,
-     397,   535,   398,   399,   400,   401,   402,   403,   439,   447,
-     404,   405,   406,   407,   408,   329,   330,   587,   588,   589,
-     795,   545,   797,   799,   547,   556,   382,   803,   586,   329,
-     330,   587,   588,   589,   338,   574,   802,   898,   590,   584,
-     593,   863,   594,   577,   804,   805,   385,   385,   385,   806,
-     842,   807,   627,   628,   629,   810,   632,   873,  -490,  -490,
-    -490,  -490,  -490,  -490,   672,   879,   320,   339,   819,   810,
-     676,   678,   679,   681,   685,   689,   578,   690,   686,   692,
-     703,   828,   816,   482,   704,   720,   725,   730,   731,   734,
-     934,   447,   740,   743,   223,   744,   447,   759,   826,   589,
-     340,   792,   847,   398,   399,   400,   401,   402,   403,   579,
-     793,   404,   405,   406,   407,   408,   794,   814,   502,   808,
-     815,   817,   534,   818,   409,   410,   823,   825,   878,   851,
-     754,   835,   899,   836,   872,   844,   875,   495,   558,   395,
-     396,   397,   876,   398,   399,   400,   401,   402,   403,   845,
-     852,   404,   405,   406,   407,   408,   861,   862,   864,   867,
-     868,   391,   869,   870,   871,   565,   577,  -491,   897,   902,
-     929,   737,   939,   892,   409,   410,   906,   948,   921,   920,
-     933,   953,   513,   937,   938,   940,   795,   797,   799,   932,
-     941,   942,   943,   959,   841,   958,   961,   967,   971,   578,
-     925,   486,   211,   895,    16,   626,   144,  -247,   952,  -247,
-    -247,  -247,  -247,  -247,   950,  -247,  -247,  -247,  -247,  -247,
-    -247,   670,   724,  -247,  -247,  -247,  -247,  -247,   827,   829,
-     705,   718,   579,   253,   254,   514,   492,   697,   727,   544,
-     662,   860,   713,   914,   916,   256,   919,  -511,  -511,  -511,
-    -511,  -511,  -511,   915,   820,   404,   405,   406,   407,   408,
-     947,   534,   515,   877,   516,   517,   518,   968,   930,   519,
-     520,   352,   521,   522,   972,   409,   410,   741,   178,   179,
-     345,   592,   874,   624,   880,   742,   767,     0,   944,   768,
-     946,   810,     0,   351,   181,   182,     0,     0,   183,   184,
-     185,   186,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,   390,   187,     0,     0,   409,   410,   949,     0,     0,
-       0,     0,     0,     0,     0,   960,     0,     0,     0,     0,
-       0,     0,     0,   962,     0,     0,     0,     0,     0,   963,
-       0,     0,   965,     2,     3,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   975,     0,
-       0,     0,     0,   976,   977,     0,     0,   978,   979,     0,
-     -23,     0,   -23,     0,   981,   -23,   -23,   -23,   -23,     4,
-       5,   -23,     0,     0,   -23,   -23,   -23,  -247,  -247,     0,
-       0,   -23,   -23,     0,     0,     0,     6,     7,     0,     0,
-       0,     0,     0,     0,     0,     0,   -23,     0,     0,     0,
-     -23,   -23,     0,     0,     0,   -23,     0,     0,     0,   409,
-     410,   -23,     0,   -23,   -23,     0,   -23,     0,   -23,   -23,
-     -23,   -23,   -23,     0,   -23,   -23,   -23,   -23,   -23,   -23,
-     -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,
-       0,     0,   -23,   -23,   -23,     0,   -23,   -23,   -23,     0,
-     -23,   -23,   -23,     0,     0,   -23,     0,   -23,     0,     0,
-     -23,   -23,   -23,   -23,     0,     0,   -23,   -23,   -23,     0,
-       0,     0,     0,     0,   -23,     0,     0,     8,   -23,   -23,
-     -23,   -23,   -23,   -23,   -23,     0,   -23,   -23,   -23,   -23,
-     -23,     0,     0,   -23,     0,     0,     0,     0,     0,     0,
-     -23,   -23,   -23,     0,     0,     0,     0,     0,     0,   -23,
-       9,  -510,     0,  -510,     0,  -510,  -510,  -510,  -510,  -510,
-      10,  -510,  -510,  -510,  -510,  -510,  -510,     0,     0,  -510,
-    -510,  -510,  -510,  -510,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   152,   153,     0,
-       0,     0,   154,   155,   156,   157,     0,     0,     0,     0,
-       0,     0,     0,     0,   158,   159,   160,   161,   162,   163,
-     164,     0,   165,   166,   167,     0,     0,   168,   169,   170,
-       0,   171,   172,   173,   174,   175,   674,   176,   392,     0,
-     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
-     402,   403,     0,     0,   404,   405,   406,   407,   408,   931,
-       0,   392,     0,   393,   394,   395,   396,   397,     0,   398,
-     399,   400,   401,   402,   403,     0,     0,   404,   405,   406,
-     407,   408,     0,     0,     0,     0,     0,     0,     0,     0,
+     174,   539,    93,   402,   192,   293,   434,   174,   294,   474,
+     641,   775,   295,   642,   506,   296,   243,   366,   690,   684,
+     414,   735,   736,   828,   684,   300,   494,   324,   372,   265,
+     498,   270,   271,   367,   686,   203,   273,  -171,   504,   874,
+     226,   579,   766,   767,    96,   846,   323,   198,   882,   257,
+     258,   579,    93,   268,   325,   534,   764,   764,   764,   203,
+     277,   847,   848,   849,   579,  -171,   885,   221,   222,   917,
+     366,   579,   646,   432,   430,   297,   607,   298,   299,   575,
+    -430,   859,   664,   365,   899,   329,   367,   849,   373,   374,
+     375,   376,   377,   378,    96,   379,   380,   381,   382,   383,
+     384,   332,   385,   386,   387,   388,   389,   729,   671,   675,
+     477,   174,   493,   203,   579,   419,   324,   984,   579,   333,
+     335,   336,   419,   285,   579,   750,   715,   483,   203,   540,
+     343,   126,  1021,   579,  -426,   323,   365,   223,   203,   579,
+     831,   224,   301,   325,   357,   307,   251,   194,   479,  -429,
+     364,   410,   579,   579,   868,   914,   675,   948,   985,  -425,
+     948,   371,   847,   848,   849,  -171,   393,   194,   648,   741,
+     484,   485,   229,   971,   438,   751,  1042,   223,   575,   170,
+     406,   224,   195,   230,   288,   387,   388,   389,   302,   404,
+     411,   412,   753,   742,  -171,   342,   480,   344,  -106,   394,
+    1026,   580,   197,   364,   308,   128,   364,   417,   389,   850,
+     959,   584,   359,  1000,   425,   917,   468,   204,   433,   605,
+     860,   436,  -430,   606,   586,   324,   466,   486,   963,   475,
+     564,   601,   647,   850,   324,   367,   960,   980,   495,     4,
+     730,   680,   665,   500,   323,   496,   503,   390,   391,   563,
+     478,   836,   325,   323,   716,    93,   130,   565,   916,   916,
+     916,   325,   252,   859,   286,   709,   710,   471,   672,   676,
+     499,   413,   699,   713,   777,   475,  -426,   532,   778,   170,
+     859,   609,   251,   561,   792,   365,   204,   719,   253,   544,
+     545,  -429,   576,   793,   549,   722,   413,    96,   728,   794,
+     694,  -425,   540,   553,   554,   555,   556,   557,   558,   559,
+     850,   575,   795,   805,   869,   915,   938,   949,   986,   266,
+    1037,   800,   802,   425,   804,   289,   575,   324,   390,   391,
+     583,   919,   920,   921,   587,   588,   589,   590,   591,   592,
+     593,   594,   595,   596,   597,   598,   323,   223,   131,   390,
+     391,   224,   371,   961,   325,   571,   311,   312,   572,   573,
+     574,   188,   616,   618,   619,   620,   621,   622,   623,   624,
+     625,   626,   627,   628,   629,   630,   631,   634,   636,   638,
+     640,    69,   939,   199,   192,   659,   372,   481,   684,   684,
+     684,   684,   684,   990,   581,   582,   697,   244,   252,   245,
+     191,   278,   860,   828,   610,   861,   482,   239,   764,   575,
+     407,   489,   490,   600,   663,   602,   603,   604,   202,   860,
+     415,   416,  1009,   400,   253,   612,   717,   837,   822,   279,
+     212,   923,   395,   679,   240,   241,   763,   408,   520,   264,
+     209,   235,   236,   769,   832,   701,   210,   756,   875,   989,
+     708,   965,   937,   711,  -156,   823,   839,   966,  -156,   208,
+     223,   475,   911,   866,   224,   564,   775,   685,   213,   255,
+     806,   256,   564,   219,   324,   324,   324,   324,   324,   259,
+     698,   260,   881,   916,   563,   707,   170,   309,   194,   274,
+     884,   563,   565,   323,   323,   323,   323,   323,   269,   565,
+     762,   325,   325,   325,   325,   325,   735,   736,   858,   800,
+     802,   804,   220,  -156,   475,   475,   227,  -156,   372,   371,
+     575,   575,   575,   575,   575,   733,   203,   735,   736,   280,
+     200,   201,   770,   771,   772,   773,   774,   746,    93,   979,
+      93,  -156,  1036,   231,   812,  -156,   232,   757,   684,   761,
+     376,   377,   378,   249,   379,   380,   381,   382,   383,   384,
+     419,   385,   386,   387,   388,   389,   733,   324,   776,   215,
+     216,   217,   419,   571,   311,   312,   572,   573,   574,  -541,
+    -541,  -541,  -541,  -541,  -541,   929,   323,   254,   139,   311,
+     312,   572,   573,   574,   325,   524,   525,   799,   801,   263,
+     803,   398,   668,   364,   807,   940,   941,   942,   943,   983,
+     876,   877,   878,   851,   572,   573,   574,   133,   134,   746,
+     898,   808,   809,   972,   973,   203,   810,   272,   811,   310,
+     327,   292,   815,   304,   305,   339,   340,   928,   394,   341,
+     345,   824,   894,   829,   895,   830,   346,   821,   347,   348,
+     349,   834,   806,   903,    93,   964,   350,   405,   351,   352,
+     353,   354,   355,   356,   843,   425,   468,   358,   469,   360,
+     361,   564,   841,   362,   370,   395,   988,   397,   398,   162,
+     856,   857,   399,   470,   170,   163,   164,   465,  1024,   476,
+     563,   867,   491,   259,   493,   266,   496,   501,   565,   502,
+     166,   167,   505,   168,   169,   274,   390,   391,   171,   871,
+     475,   373,   374,   375,   376,   377,   378,   521,   379,   380,
+     381,   382,   383,   384,   523,   385,   386,   387,   388,   389,
+     535,   560,   547,   569,   611,   577,   614,   651,   654,   674,
+     905,   656,   657,   609,   666,   667,   669,   673,   723,   549,
+     677,   678,  1027,   724,   688,   727,   608,   691,  -237,  -237,
+    -237,  -237,  -237,  -237,   692,  -237,  -237,  -237,  -237,  -237,
+    -237,   695,  -237,  -237,  -237,  -237,  -237,   714,   718,   759,
+     758,   760,   768,   574,   796,   799,   801,   803,   797,   798,
+     819,   813,   820,   845,   833,   840,   853,   976,   855,   478,
+     864,   872,   192,   925,   883,   886,   982,   887,   888,   891,
+     889,   372,   890,   896,   897,   909,   378,   564,   379,   380,
+     381,   382,   383,   384,   910,   385,   386,   387,   388,   389,
+     922,   927,   931,   932,   935,   936,   563,   944,  1003,   945,
+     950,   969,   958,   730,   565,   978,   987,   991,   999,   992,
+    1007,  1015,   993,   994,  1016,  1006,  1018,   707,  1017,   954,
+     850,   957,  1019,  1023,  1028,   302,  1043,  1032,  1038,  1039,
+     390,   391,   507,   965,   394,   475,  1041,  1047,  1020,  1048,
+     333,   234,   488,  1010,   693,  1008,   977,   379,   380,   381,
+     382,   383,   384,   905,   385,   386,   387,   388,   389,  -542,
+    -542,  -542,  -542,  -542,  -542,   842,   385,   386,   387,   388,
+     389,   844,    93,   995,   649,   997,   815,  -237,  -237,   689,
+     333,  1001,   712,  1002,   687,   235,   236,   508,   492,   720,
+     700,   533,   880,  1005,   238,   952,   998,   644,    93,  1012,
+     953,   835,   970,  1040,   371,  1025,   754,   912,  1004,  1013,
+    1014,   913,   838,   509,   670,   510,   511,   512,   330,     0,
+     513,   514,     0,   515,   516,     0,     0,     2,     3,     0,
+     390,   391,     0,     0,   905,     0,   905,     0,     0,     0,
+       0,     0,     0,     0,    93,  1029,     0,     0,  1031,     0,
+       0,     4,     5,     0,     0,     6,   -21,     7,   -21,     8,
+       0,     0,     9,     0,     0,     0,     0,     0,     0,     0,
+     733,     0,    10,     0,     0,     0,     0,     0,     0,  1044,
+       0,   733,     0,  1045,  1046,    93,     0,     0,    11,     0,
+       0,   733,    12,    13,    93,     0,     0,    14,  1050,   390,
+     391,     0,     0,    15,     0,    16,    17,     0,    18,     0,
+       0,   390,   391,    19,    20,    21,    22,    23,     0,    24,
+      25,     0,     0,    26,    27,    28,    29,    30,    31,    32,
+      33,    34,    35,    36,     0,    37,     0,    38,    39,     0,
+       0,    40,    41,    42,     0,    43,     0,    44,     0,     0,
+      45,    46,     0,     0,    47,    48,    49,     0,     0,     0,
+       0,     0,     0,     0,    50,     0,     0,    51,    52,    53,
+      54,    55,    56,    57,    58,    59,    60,    61,    62,    63,
+       0,     0,    64,     0,     0,    65,    66,    67,    68,     0,
+       0,     0,   652,    69,   373,   374,   375,   376,   377,   378,
+       0,   379,   380,   381,   382,   383,   384,     0,   385,   386,
+     387,   388,   389,   934,     0,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,  1034,     0,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,  1035,     0,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,  1049,     0,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   926,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   870,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,     0,     0,     0,
+       0,     0,   135,   136,     0,     0,     0,     0,   137,   138,
+     139,   140,   141,   390,   391,     0,     0,     0,     0,     0,
+       0,     0,     0,   142,   143,   144,   145,   146,   147,   148,
+       0,   149,   150,   151,   390,   391,   152,   153,   154,     0,
+     155,   156,   157,   158,   159,     0,   160,     0,     0,     0,
+       0,     0,     0,     0,     0,   390,   391,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   390,   391,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   390,   391,     0,
+       0,   162,     0,     0,     0,     0,     0,   163,   164,     0,
+       0,     0,     0,   165,     0,     0,   613,   390,   391,     0,
+       0,     0,   166,   167,     0,   168,   169,     0,     0,   170,
+     171,   562,     0,     0,     0,     0,     0,   390,   391,   926,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,   996,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,  1030,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     178,   179,     0,     0,     0,     0,   180,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   181,   182,     0,     0,
-     183,   184,   185,   186,     0,     0,     0,    91,     0,     0,
-       0,     0,     0,     0,   187,     0,     0,   576,     0,     0,
-       0,     0,     0,  -510,  -510,   973,     0,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,     0,     0,   404,   405,   406,   407,   408,   974,     0,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,   980,     0,   392,     0,   393,   394,   395,   396,   397,
-       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
-     405,   406,   407,   408,     0,     0,     0,     0,   409,   410,
-       0,     0,     0,     0,     0,     0,   896,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,   409,   410,   404,   405,   406,   407,   408,   850,   392,
-       0,   393,   394,   395,   396,   397,     0,   398,   399,   400,
-     401,   402,   403,     0,     0,   404,   405,   406,   407,   408,
-     896,   392,     0,   393,   394,   395,   396,   397,     0,   398,
-     399,   400,   401,   402,   403,     0,     0,   404,   405,   406,
-     407,   408,   945,   392,     0,   393,   394,   395,   396,   397,
-       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
-     405,   406,   407,   408,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   409,   410,     0,
-       0,     0,     0,     0,     0,   964,   392,     0,   393,   394,
-     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
-     409,   410,   404,   405,   406,   407,   408,     0,     0,   392,
-       0,   393,   394,   395,   396,   397,     0,   398,   399,   400,
-     401,   402,   403,   409,   410,   404,   405,   406,   407,   408,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,   631,     0,     0,     0,     0,   409,   410,     0,
-       0,     0,     0,     0,     0,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,   409,
-     410,   404,   405,   406,   407,   408,     0,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,   409,   410,   404,   405,   406,   407,   408,     0,  -250,
-       0,  -250,  -250,  -250,  -250,  -250,     0,  -250,  -250,  -250,
-    -250,  -250,  -250,   409,   410,  -250,  -250,  -250,  -250,  -250,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,   409,   410,   404,   405,
-     406,   407,   408,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   436,     0,     0,     0,     0,   409,
-     410,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,   595,     0,     0,     0,     0,
-     409,   410,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
-     406,   407,   408,     0,     0,     0,     0,     0,     0,     0,
-     602,     0,     0,     0,     0,   409,   410,     0,     0,     0,
+       0,     0,     0,     0,     0,   578,   390,   391,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   616,     0,     0,     0,     0,   409,   410,     0,
+       0,     0,     0,     0,     0,     0,   585,   390,   391,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,  -239,  -239,
+    -239,  -239,  -239,  -239,     0,  -239,  -239,  -239,  -239,  -239,
+    -239,     0,  -239,  -239,  -239,  -239,  -239,  -238,  -238,  -238,
+    -238,  -238,  -238,     0,  -238,  -238,  -238,  -238,  -238,  -238,
+       0,  -238,  -238,  -238,  -238,  -238,     0,     0,     0,   390,
+     391,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   390,
+     391,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   390,
+     391,   373,   374,   375,   376,   377,   378,     0,   379,   380,
+     381,   382,   383,   384,     0,   385,   386,   387,   388,   389,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,  -250,     0,     0,     0,     0,  -250,
-    -250,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,   631,     0,     0,     0,     0,
-     409,   410,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   666,     0,     0,
-       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
-     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
-     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
-       0,   404,   405,   406,   407,   408,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   671,     0,     0,
-       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
-     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
-     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
-       0,   404,   405,   406,   407,   408,   392,     0,   393,   394,
-     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
-       0,     0,   404,   405,   406,   407,   408,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,     0,     0,   404,   405,   406,   407,   408,   392,     0,
-     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
-     402,   403,     0,     0,   404,   405,   406,   407,   408,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   673,
-       0,     0,     0,     0,   409,   410,     0,     0,     0,   418,
-       0,   392,     0,   393,   394,   395,   396,   397,     0,   398,
-     399,   400,   401,   402,   403,   409,   410,   404,   405,   406,
-     407,   408,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
-     406,   407,   408,     0,     0,     0,     0,     0,     0,   773,
-       0,     0,     0,     0,   409,   410,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   599,   390,   391,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     774,     0,     0,     0,     0,   409,   410,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,  -239,  -239,  -239,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,   775,     0,     0,     0,     0,   409,   410,     0,     0,
+       0,     0,     0,     0,     0,  -238,  -238,  -238,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,     0,     0,     0,     0,   613,
+     390,   391,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   650,   390,
+     391,   373,   374,   375,   376,   377,   378,     0,   379,   380,
+     381,   382,   383,   384,     0,   385,   386,   387,   388,   389,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,     0,     0,
+       0,     0,     0,     0,   135,   136,     0,     0,     0,     0,
+     137,   138,   139,   140,   141,     0,   653,   390,   391,     0,
+       0,     0,     0,     0,     0,   142,   143,   144,   145,   146,
+     147,   148,   399,   149,   150,   151,   390,   391,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
+       0,     0,     0,     0,   779,   390,   391,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,     0,     0,     0,     0,   780,
+     390,   391,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,     0,     0,   165,     0,     0,   781,   390,
+     391,     0,     0,     0,   166,   167,     0,   168,   169,     0,
+       0,   918,   171,   562,     0,     0,     0,   782,   390,   391,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   776,     0,     0,     0,     0,   409,   410,     0,
+       0,     0,     0,     0,     0,   783,   390,   391,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,   777,     0,     0,     0,     0,   409,   410,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   778,     0,     0,     0,
-       0,   409,   410,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   779,     0,     0,
-       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
-     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
-     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
-       0,   404,   405,   406,   407,   408,   392,     0,   393,   394,
-     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
-       0,     0,   404,   405,   406,   407,   408,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,     0,     0,   404,   405,   406,   407,   408,   392,     0,
-     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
-     402,   403,     0,     0,   404,   405,   406,   407,   408,     0,
-       0,     0,     0,     0,     0,   780,     0,     0,     0,     0,
-     409,   410,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
-     406,   407,   408,   392,     0,   393,   394,   395,   396,   397,
-       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
-     405,   406,   407,   408,     0,     0,     0,     0,     0,    22,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   781,
-       0,     0,     0,     0,   409,   410,     0,     0,     0,     0,
-       0,     0,     0,     0,    28,     0,     0,     0,     0,     0,
-     782,     0,     0,     0,     0,   409,   410,     0,     0,    32,
-       0,     0,     0,     0,    35,   348,     0,     0,     0,    39,
-      40,   783,     0,     0,     0,     0,   409,   410,     0,   349,
-      49,    50,    51,    52,    53,    54,   350,     0,     0,     0,
-       0,     0,   784,     0,     0,     0,     0,   409,   410,    64,
-       0,     0,     0,     0,     0,    67,     0,     0,     0,     0,
-       0,     0,     0,   785,    72,     0,    74,     0,   409,   410,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,     0,     0,     0,     0,     0,   791,     0,     0,
-      91,     0,   409,   410,     0,     0,     0,    92,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   843,     0,
-       0,     0,     0,   409,   410,   392,     0,   393,   394,   395,
-     396,   397,   708,   398,   399,   400,   401,   402,   403,     0,
-     149,   404,   405,   406,   407,   408,     0,     0,     0,   150,
-     151,   709,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   152,   153,     0,
-       0,     0,   154,   155,   156,   157,     0,     0,     0,     0,
-       0,     0,     0,     0,   158,   159,   160,   161,   162,   163,
-     164,     0,   165,   166,   167,     0,     0,   168,   169,   170,
-       0,   171,   172,   173,   174,   175,     0,   176,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   453,     0,
-       0,     0,   454,   455,   456,   457,     0,     0,     0,     0,
-       0,     0,     0,     0,   458,   459,   460,   461,   462,   463,
-     464,     0,   465,   466,   467,   900,     0,   468,   469,   470,
-     409,   410,   471,   472,   473,   474,     0,   475,     0,   177,
-       0,     0,     0,     0,     0,     0,     0,     0,   149,     0,
-     178,   179,     0,     0,     0,     0,   180,   150,   151,     0,
-       0,     0,     0,     0,     0,     0,   181,   182,     0,     0,
-     183,   184,   185,   186,     0,   152,   153,    91,     0,     0,
-     154,   155,   156,   157,   187,   409,   410,   188,     0,     0,
-       0,     0,   158,   159,   160,   161,   162,   163,   164,     0,
-     165,   166,   167,     0,     0,   168,   169,   170,     0,   171,
-     172,   173,   174,   175,     0,   176,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   476,     0,     0,
+       0,     0,     0,     0,   784,   390,   391,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,     0,     0,     0,     0,   785,   390,
+     391,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   786,   390,   391,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   787,   390,   391,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   788,   390,   391,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   789,   390,   391,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   790,   390,   391,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,   373,   374,   375,   376,   377,   378,
+       0,   379,   380,   381,   382,   383,   384,     0,   385,   386,
+     387,   388,   389,     0,     0,     0,     0,   791,   390,   391,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   852,   390,   391,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   930,   390,   391,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   933,   390,   391,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   946,   390,   391,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   702,     0,   947,   390,   391,
+       0,     0,   132,     0,     0,     0,     0,     0,     0,     0,
+     133,   134,   703,     0,     0,     0,  1022,   390,   391,     0,
+       0,     0,     0,     0,   135,   136,     0,     0,     0,     0,
+     137,   138,   139,   140,   141,  1033,   390,   391,     0,     0,
+       0,     0,     0,     0,     0,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,   439,   160,     0,
+       0,     0,   440,   441,     0,   442,   443,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   444,   445,   446,
+     447,   448,   449,   450,     0,   451,   452,   453,     0,     0,
+     454,   455,   456,     0,   814,   457,   458,   459,   460,     0,
+     461,   132,     0,     0,   390,   391,   161,     0,     0,   133,
+     134,     0,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,   135,   136,   165,     0,     0,     0,   137,
+     138,   139,   140,   141,   166,   167,     0,   168,   169,     0,
+       0,   170,   171,   172,   142,   143,   144,   145,   146,   147,
+     148,     0,   149,   150,   151,     0,     0,   152,   153,   154,
+       0,   155,   156,   157,   158,   159,     0,   160,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   462,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   904,     0,     0,     0,     0,     0,     0,
+     132,     0,     0,     0,     0,   161,     0,     0,   133,   134,
+       0,     0,   162,     0,     0,     0,     0,     0,   163,   164,
+       0,     0,   135,   136,   165,     0,     0,     0,   137,   138,
+     139,   140,   141,   166,   167,     0,   168,   169,     0,     0,
+     170,   171,   172,   142,   143,   144,   145,   146,   147,   148,
+       0,   149,   150,   151,     0,     0,   152,   153,   154,     0,
+     155,   156,   157,   158,   159,     0,   160,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   177,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   178,   179,
-       0,     0,     0,     0,   180,   809,     0,     0,     0,     0,
-       0,     0,     0,   149,   181,   182,     0,     0,   183,   184,
-     185,   186,   150,   151,     0,    91,     0,     0,     0,     0,
-       0,     0,   187,     0,     0,   188,     0,     0,     0,     0,
-     152,   153,     0,   204,     0,   154,   155,   156,   157,     0,
-       0,     0,     0,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   924,     0,     0,     0,     0,     0,     0,   132,
+       0,     0,     0,     0,   161,     0,     0,   133,   134,     0,
+       0,   162,     0,     0,     0,     0,     0,   163,   164,     0,
+       0,   135,   136,   165,     0,     0,     0,   137,   138,   139,
+     140,   141,   166,   167,     0,   168,   169,     0,     0,   170,
+     171,   172,   142,   143,   144,   145,   146,   147,   148,     0,
+     149,   150,   151,     0,     0,   152,   153,   154,     0,   155,
+     156,   157,   158,   159,     0,   160,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   472,     0,     0,     0,     0,     0,   132,     0,
+       0,     0,     0,   161,     0,     0,   133,   134,   473,     0,
+     162,     0,     0,     0,     0,     0,   163,   164,     0,     0,
+     135,   136,   165,     0,     0,     0,   137,   138,   139,   140,
+     141,   166,   167,     0,   168,   169,     0,     0,   170,   171,
+     172,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,     0,     0,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,   632,     0,     0,     0,     0,     0,   132,     0,     0,
+       0,     0,   161,     0,     0,   133,   134,     0,   633,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,   135,
+     136,   165,     0,     0,     0,   137,   138,   139,   140,   141,
+     166,   167,     0,   168,   169,     0,     0,   170,   171,   172,
+     142,   143,   144,   145,   146,   147,   148,     0,   149,   150,
+     151,     0,     0,   152,   153,   154,     0,   155,   156,   157,
+     158,   159,     0,   160,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     721,     0,     0,     0,     0,     0,   132,     0,     0,     0,
+       0,   161,     0,     0,   133,   134,   473,     0,   162,     0,
+       0,     0,     0,     0,   163,   164,     0,     0,   135,   136,
+     165,     0,     0,     0,   137,   138,   139,   140,   141,   166,
+     167,     0,   168,   169,     0,     0,   170,   171,   172,   142,
+     143,   144,   145,   146,   147,   148,     0,   149,   150,   151,
+       0,     0,   152,   153,   154,     0,   155,   156,   157,   158,
+     159,     0,   160,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   615,
+       0,     0,     0,     0,     0,   132,     0,     0,     0,     0,
+     161,     0,     0,   133,   134,     0,     0,   162,     0,     0,
+       0,     0,     0,   163,   164,     0,     0,   135,   136,   165,
+       0,     0,     0,   137,   138,   139,   140,   141,   166,   167,
+       0,   168,   169,     0,     0,   170,   171,   172,   142,   143,
+     144,   145,   146,   147,   148,     0,   149,   150,   151,     0,
+       0,   152,   153,   154,     0,   155,   156,   157,   158,   159,
+       0,   160,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   637,     0,
+       0,     0,     0,     0,   132,     0,     0,     0,     0,   161,
+       0,     0,   133,   134,     0,     0,   162,     0,     0,     0,
+       0,     0,   163,   164,     0,     0,   135,   136,   165,     0,
+       0,     0,   137,   138,   139,   140,   141,   166,   167,     0,
+     168,   169,     0,     0,   170,   171,   172,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   639,     0,     0,
+       0,     0,     0,   132,     0,     0,     0,     0,   161,     0,
+       0,   133,   134,     0,     0,   162,     0,     0,     0,     0,
+       0,   163,   164,     0,     0,   135,   136,   165,     0,     0,
+       0,   137,   138,   139,   140,   141,   166,   167,     0,   168,
+     169,     0,     0,   170,   171,   172,   142,   143,   144,   145,
+     146,   147,   148,     0,   149,   150,   151,     0,     0,   152,
+     153,   154,     0,   155,   156,   157,   158,   159,     0,   160,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,   894,     0,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
+       0,     0,   132,     0,     0,     0,     0,   161,     0,     0,
+     133,   134,     0,     0,   162,     0,     0,     0,     0,     0,
+     163,   164,     0,     0,   135,   136,   165,     0,     0,     0,
+     137,   138,   139,   140,   141,   166,   167,     0,   168,   169,
+       0,     0,   170,   171,   172,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   161,     0,     0,     0,
+       0,     0,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,     0,     0,   165,     0,     0,     0,     0,
+       0,     0,     0,     0,   166,   167,   132,   168,   169,     0,
+       0,   170,   171,   172,   133,   134,   660,   173,   661,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   135,   136,
+       0,     0,     0,     0,   137,   138,   139,   140,   141,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   142,
+     143,   144,   145,   146,   147,   148,     0,   149,   150,   151,
+       0,     0,   152,   153,   154,     0,   155,   156,   157,   158,
+     159,     0,   160,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,   531,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-     532,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   132,     0,     0,     0,     0,
+     161,     0,     0,   133,   134,   473,     0,   162,     0,     0,
+       0,     0,     0,   163,   164,     0,     0,   135,   136,   165,
+       0,     0,     0,   137,   138,   139,   140,   141,   166,   167,
+       0,   168,   169,     0,     0,   170,   171,   662,   142,   143,
+     144,   145,   146,   147,   148,     0,   149,   150,   151,     0,
+       0,   152,   153,   154,     0,   155,   156,   157,   158,   159,
+       0,   160,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   132,     0,     0,     0,     0,   161,
+       0,     0,   133,   134,   548,     0,   162,     0,     0,     0,
+       0,     0,   163,   164,     0,     0,   135,   136,   165,     0,
+       0,     0,   137,   138,   139,   140,   141,   166,   167,     0,
+     168,   169,     0,     0,   526,   171,   172,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   132,     0,     0,     0,     0,   161,     0,
+       0,   133,   134,   473,     0,   162,     0,     0,     0,     0,
+       0,   163,   164,     0,     0,   135,   136,   165,     0,     0,
+       0,   137,   138,   139,   140,   141,   166,   167,     0,   168,
+     169,     0,     0,   170,   171,   172,   142,   143,   144,   145,
+     146,   147,   148,     0,   149,   150,   151,     0,     0,   152,
+     153,   154,     0,   155,   156,   157,   158,   159,     0,   160,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-     650,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,     0,   651,
-       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
+       0,     0,   132,     0,     0,     0,     0,   161,     0,     0,
+     133,   134,   726,     0,   162,     0,     0,     0,     0,     0,
+     163,   164,     0,     0,   135,   136,   165,     0,     0,     0,
+     137,   138,   139,   140,   141,   166,   167,     0,   168,   169,
+       0,     0,   170,   171,   172,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,   728,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,   532,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   188,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   161,     0,     0,     0,
+       0,     0,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,   132,     0,     0,   165,     0,     0,     0,     0,
+     133,   134,     0,     0,   166,   167,     0,   168,   169,     0,
+       0,   170,   171,   172,   135,   136,     9,     0,     0,     0,
+     137,   138,   139,   140,   141,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,   633,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,    91,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,   132,     0,     0,     0,     0,   161,     0,     0,   133,
+     134,   703,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,   135,   136,   165,     0,     0,     0,   137,
+     138,   139,   140,   141,   166,   167,     0,   168,   169,     0,
+       0,   170,   171,   172,   142,   143,   144,   145,   146,   147,
+     148,     0,   149,   150,   151,     0,     0,   152,   153,   154,
+       0,   155,   156,   157,   158,   159,     0,   160,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,     0,   655,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
+     132,     0,     0,     0,     0,   161,     0,     0,   133,   134,
+    1011,     0,   162,     0,     0,     0,     0,     0,   163,   164,
+       0,     0,   135,   136,   165,     0,     0,     0,   137,   138,
+     139,   140,   141,   166,   167,     0,   168,   169,     0,     0,
+     170,   171,   172,   142,   143,   144,   145,   146,   147,   148,
+       0,   149,   150,   151,     0,     0,   152,   153,   154,     0,
+     155,   156,   157,   158,   159,     0,   160,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   132,
+       0,     0,     0,     0,   161,     0,     0,   133,   134,     0,
+       0,   162,     0,     0,     0,     0,     0,   163,   164,     0,
+       0,   135,   136,   165,     0,     0,     0,   137,   138,   139,
+     140,   141,   166,   167,     0,   168,   169,     0,     0,   170,
+     171,   172,   142,   143,   144,   145,   146,   147,   148,     0,
+     149,   150,   151,     0,     0,   152,   153,   154,     0,   155,
+     156,   157,   158,   159,     0,   160,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   132,     0,
+       0,     0,     0,   161,     0,     0,   133,   134,     0,     0,
+     162,     0,     0,     0,     0,     0,   163,   164,     0,     0,
+     135,   136,   165,     0,     0,     0,   137,   138,   139,   140,
+     141,   166,   167,     0,   168,   169,     0,     0,   170,   171,
+     172,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,     0,     0,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   132,     0,     0,
+       0,     0,   161,     0,     0,   133,   134,     0,     0,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,   135,
+     136,   165,     0,     0,     0,   137,   138,   139,   140,   141,
+     166,   167,     0,   168,   169,     0,     0,   170,   171,   363,
+     142,   143,   144,   145,   146,   147,   148,     0,   149,   150,
+     151,     0,     0,   152,   153,   154,     0,   155,   156,   157,
+     158,   159,     0,   160,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   132,     0,     0,     0,
+       0,   161,     0,     0,   133,   134,     0,     0,   162,     0,
+       0,     0,     0,     0,   163,   164,     0,     0,   135,   136,
+     165,     0,     0,     0,   137,   138,   139,   140,   141,   166,
+     167,     0,   168,   169,     0,     0,   170,   431,   172,   142,
+     143,   144,   145,   146,   147,   148,     0,   149,   150,   151,
+       0,     0,   152,   153,   154,     0,   155,   156,   157,   158,
+     159,     0,   160,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   132,     0,     0,     0,     0,
+     161,     0,     0,   133,   134,     0,     0,   162,     0,     0,
+       0,     0,     0,   163,   164,     0,     0,   135,   136,   165,
+       0,     0,     0,   137,   138,   139,   140,   141,   166,   167,
+       0,   168,   169,     0,     0,   170,   529,   530,   142,   143,
+     144,   145,   146,   147,   148,     0,   149,   150,   151,     0,
+       0,   152,   153,   154,     0,   155,   156,   157,   158,   159,
+       0,   160,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   132,     0,     0,     0,     0,   161,
+       0,     0,   133,   134,     0,     0,   162,     0,     0,     0,
+       0,     0,   163,   164,     0,     0,   135,   136,   165,     0,
+       0,     0,   137,   138,   139,   140,   141,   166,   167,     0,
+     168,   169,     0,     0,   918,   171,   363,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   161,     0,
+       0,     0,     0,     0,     0,   162,     0,     0,     0,     0,
+       0,   163,   164,     0,     0,     0,     0,   165,     0,     0,
+       0,     0,     0,     0,     0,     0,   166,   167,     0,   168,
+     169,     0,     0,   170,   171,   955,   311,   312,   422,     0,
+     423,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     135,   136,     0,     0,     0,     0,   137,   138,   139,   140,
+     141,     0,     0,   314,   315,   316,   317,   318,     0,   319,
+     320,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,     0,     0,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,     0,
+       0,   165,     0,     0,     0,     0,   311,   312,   313,     0,
+     166,   167,     0,   168,   169,     0,     0,   321,   171,   424,
+     135,   136,     0,     0,     0,     0,   137,   138,   139,   140,
+     141,     0,     0,   314,   315,   316,   317,   318,     0,   319,
+     320,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,   311,   312,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,   135,   136,     0,     0,
+       0,     0,   137,   138,   139,   140,   141,     0,     0,   314,
+     315,   316,   317,   318,     0,   319,   320,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,     0,
+       0,   165,     0,     0,     0,     0,     0,     0,     0,     0,
+     166,   167,     0,   168,   169,     0,     0,   321,   171,   322,
+       0,     0,     0,     0,     0,     0,     5,     0,     0,     6,
+       0,     7,     0,     8,     0,   162,     9,     0,     0,     0,
+       0,   163,   164,     0,     0,     0,    10,   165,     0,     0,
+       0,     0,     0,     0,     0,     0,   166,   167,     0,   168,
+     169,     0,    11,   321,   171,   424,    12,    13,     0,     0,
+       0,    14,     0,     0,     0,     0,     0,    15,     0,    16,
+      17,     0,    18,     0,     0,     0,     0,    19,    20,    21,
+      22,    23,     0,    24,    25,     0,     0,    26,    27,    28,
+      29,    30,    31,    32,    33,    34,    35,    36,     0,    37,
+       0,    38,    39,     0,     0,    40,    41,    42,     0,    43,
+       0,    44,     0,     0,    45,    46,     0,     0,    47,    48,
+      49,     0,     0,     0,     0,     0,     0,     0,    50,     0,
+       0,     0,    52,    53,    54,    55,    56,    57,    58,    59,
+      60,    61,    62,    63,     0,     0,    64,     0,     0,    65,
+      66,    67,    68,     5,     0,     0,     6,   487,     7,     0,
+       8,     0,     0,     9,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,    10,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,    11,
+       0,     0,     0,    12,    13,     0,     0,     0,    14,     0,
+       0,     0,     0,     0,    15,     0,    16,    17,     0,    18,
+       0,     0,     0,     0,    19,    20,    21,    22,    23,     0,
+      24,    25,     0,     0,    26,    27,    28,    29,    30,    31,
+      32,    33,    34,    35,    36,     0,    37,     0,    38,    39,
+       0,     0,    40,    41,    42,     0,    43,     0,    44,     0,
+       0,    45,    46,     0,     0,    47,    48,    49,     0,     0,
+       0,     0,     0,     0,     0,    50,     0,     0,     0,    52,
+      53,    54,    55,    56,    57,    58,    59,    60,    61,    62,
+      63,     8,     0,    64,     9,     0,    65,    66,    67,    68,
+       0,     0,     0,     0,    10,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,   657,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-       0,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
+      11,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,    15,     0,     0,     0,     0,
+      18,     0,   746,     0,     0,    19,    20,    21,    22,    23,
+       0,     0,    25,     0,     0,    26,    27,    28,    29,    30,
+      31,    32,    33,    34,    35,     0,     0,     8,     0,     0,
+       9,     0,     0,     0,    41,     0,     0,     0,     0,    44,
+      10,     0,     0,     0,     0,     0,    47,     0,    49,     0,
+       0,     0,     0,     0,     0,     0,    11,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,    59,    60,    61,
+      62,    15,     0,     0,     0,     0,    18,     0,     0,    67,
+      68,    19,    20,    21,    22,    23,     0,     0,    25,     0,
+       0,    26,    27,    28,    29,    30,    31,    32,    33,    34,
+      35,     0,     0,     0,     0,     0,   825,     0,     0,     0,
+      41,     0,     0,     0,     0,    44,     0,     0,     0,     0,
+       0,     0,    47,     0,    49,     0,     0,     0,     0,     0,
+       0,     0,    11,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,    59,    60,    61,    62,    15,     0,     0,
+       0,     0,    18,   826,     0,    67,    68,    19,    20,   827,
+       0,    23,     0,     0,    25,     0,     0,    26,    27,    28,
+      29,    30,    31,    32,    33,    34,    35,     0,     0,     0,
+       0,     0,   825,     0,     0,     0,    41,     0,     0,     0,
+       0,    44,     0,     0,     0,     0,     0,     0,    47,     0,
+      49,     0,     0,     0,     0,     0,     0,     0,    11,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,    59,
+      60,    61,    62,    15,     0,     0,     0,     0,    18,     0,
+       0,   170,    68,    19,    20,   827,     0,    23,     0,     0,
+      25,     0,     0,    26,    27,    28,    29,    30,    31,    32,
+      33,    34,    35,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,    41,     0,     0,     0,     0,    44,     0,     0,
+       0,     0,     0,     0,    47,     0,    49,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,   746,     0,
-     747,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,   532,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   748,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,   557,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,   538,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,     0,     0,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,   532,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,     0,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-     733,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,   709,     0,
-       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,   954,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   188,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,    91,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,     0,     0,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,     0,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-       0,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   381,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,     0,     0,
-       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   444,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,     0,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   541,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,   888,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   381,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,   329,   330,   562,     0,   563,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   152,
-     153,     0,     0,     0,   154,   155,   156,   157,     0,     0,
-     332,   333,   334,     0,     0,   335,   158,   159,   160,   161,
-     162,   163,   164,     0,   165,   166,   167,     0,     0,   168,
-     169,   170,   177,   171,   172,   173,   174,   175,     0,   176,
-       0,     0,     0,   178,   179,     0,     0,     0,     0,   180,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,     0,     0,
-      91,     0,     0,     0,     0,     0,     0,   187,     0,     0,
-     917,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   178,   179,     0,     0,     0,     0,   180,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   181,   182,
-       0,     0,   183,   184,   185,   186,   329,   330,   331,   336,
-       0,     0,     0,     0,     0,     0,   187,     0,     0,   564,
-       0,     0,     0,     0,   152,   153,     0,     0,     0,   154,
-     155,   156,   157,     0,     0,   332,   333,   334,     0,     0,
-     335,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,   329,   330,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-     152,   153,     0,     0,     0,   154,   155,   156,   157,     0,
-       0,   332,   333,   334,     0,     0,   335,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   178,   179,     0,
-       0,     0,     0,   180,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,     0,     0,   336,     0,     0,     0,     0,     0,
-       0,   187,     0,    19,   337,     0,    20,   -28,    21,   -28,
-       0,     0,    22,   178,   179,    23,    24,    25,     0,   180,
-       0,     0,    26,    27,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,    28,     0,     0,
-     336,    29,    30,     0,     0,     0,    31,   187,     0,     0,
-     564,     0,    32,     0,    33,    34,     0,    35,     0,    36,
-      37,    38,    39,    40,     0,    41,    42,    43,    44,    45,
-      46,    47,    48,    49,    50,    51,    52,    53,    54,    55,
-      56,     0,     0,    57,    58,    59,     0,    60,    61,    62,
-       0,    63,    64,    65,     0,     0,    66,     0,    67,     0,
-       0,    68,    69,    70,    71,     0,     0,    72,    73,    74,
-       0,     0,     0,     0,     0,    75,     0,     0,     0,    76,
-      77,    78,    79,    80,    81,    82,     0,    83,    84,    85,
-      86,    87,     0,     0,    88,     0,     0,     0,     0,   152,
-     153,    89,    90,    91,   154,   155,   156,   157,     0,     0,
-      92,     0,     0,     0,     0,     0,   158,   159,   160,   161,
-     162,   163,   164,     0,   165,   166,   167,     0,     0,   168,
-     169,   170,     0,   171,   172,   173,   174,   175,     0,   176,
-     152,   153,     0,     0,     0,   154,   155,   156,   157,     0,
-       0,     0,     0,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   178,   179,     0,     0,     0,     0,   180,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   181,   182,
-       0,     0,   183,   184,   185,   186,     0,     0,     0,    91,
-       0,     0,     0,     0,     0,     0,   187,     0,     0,   576,
-       0,     0,     0,   178,   179,     0,     0,     0,     0,   180,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,     0,     0,
-     888,     0,     0,     0,     0,     0,     0,   187,     0,     0,
-     576
+       0,     0,     0,     0,     0,    59,    60,    61,    62,     0,
+       0,     0,     0,     0,     0,     0,     0,   170,    68
 };
+
+#define yypact_value_is_default(Yystate) \
+  (!!((Yystate) == (-845)))
+
+#define yytable_value_is_error(Yytable_value) \
+  (!!((Yytable_value) == (-542)))
 
 static const yytype_int16 yycheck[] =
 {
-      26,   177,    28,   200,   140,    35,    32,   297,    13,    35,
-     274,   177,   188,   289,   278,    41,   414,   716,    46,   499,
-     105,   327,   107,   231,    18,   579,   111,   231,   582,     5,
-       3,   337,   236,   449,   236,    34,     3,   140,     4,     3,
-     346,   177,    70,    71,     4,    24,     3,     4,     3,    23,
-      78,     3,    23,     3,    31,   381,    61,   123,   234,   489,
-      59,    60,   494,   729,    33,     3,    35,   499,   103,     5,
-     140,    21,    22,    23,     3,     3,   125,   112,     3,   177,
-     577,   344,   579,   793,   794,   582,   759,     3,     3,     3,
-      23,     3,     3,     3,     3,     4,   124,   527,   126,   127,
-       3,     3,     3,    23,   130,   169,   169,   137,     3,     3,
-       3,   137,     3,     3,     3,   179,    23,    20,   169,   169,
-     169,    24,   148,   149,   187,   158,    35,    97,   231,    99,
-     169,   157,   179,   236,    21,    22,    23,   187,   143,    20,
-      21,    22,    23,    24,    25,   171,   179,     3,    23,   217,
-     126,   177,     3,    25,   169,   179,    23,    24,    25,    20,
-     123,   176,   188,    24,   863,   189,   192,     5,    24,    20,
-     238,   347,   882,    24,   137,    20,    20,   203,   179,    24,
-      24,   347,   286,   176,   210,    20,   179,   272,   189,    24,
-     126,   327,   169,   219,   260,   169,    80,    81,   224,   865,
-     179,   337,   207,     4,   308,   381,   342,   180,   234,   882,
-     346,   347,   156,   189,   158,   381,   180,   188,   244,   127,
-     187,   187,   921,   180,   327,   180,   231,   187,   180,   234,
-     315,   236,   237,   179,   337,   169,   169,   242,   188,   342,
-     275,   531,   180,   346,    27,   381,   281,   180,   538,   179,
-     285,   180,   180,   258,   158,   180,   255,   327,   564,   179,
-     757,   758,   169,   760,   180,   180,   180,   337,   180,   180,
-     180,   297,   342,   180,   279,   301,   346,   303,   180,   180,
-     586,   587,   588,   589,   590,   180,   180,   180,   126,   180,
-     180,   180,   318,   319,   179,   265,   179,   323,   169,   180,
-     626,   188,   628,   629,   179,   568,   332,   333,   334,   335,
-     413,   316,   575,   185,   186,   320,   179,   311,   185,   186,
-     179,   347,   327,   427,   169,   169,   261,   262,   591,   883,
-     179,   180,   337,   359,   169,    21,    22,   363,   364,   365,
-     366,   367,   368,   369,   370,   371,   372,   373,   374,   179,
-     576,   767,   768,   169,   179,   381,   169,   837,   584,   294,
-     176,     3,     4,   179,   844,   541,   392,   393,   394,   395,
-     396,   397,   398,   399,   400,   401,   402,   403,   404,   405,
-     406,   407,   408,   409,   410,   593,   883,     3,   414,   593,
-     594,   176,   594,     3,   179,    23,   422,   423,     3,   838,
-     839,   840,   841,   507,   508,   837,   838,   839,   840,   841,
-     808,   515,   844,   357,   358,    20,   501,   140,   141,    24,
-       4,   506,   169,   176,   509,   138,   139,   140,   564,    23,
-      24,    25,   376,   377,   378,   379,   380,     3,   728,   936,
-     576,   717,   546,   707,   750,   389,   179,   169,   584,   179,
-     586,   587,   588,   589,   590,   179,   632,   485,   179,   179,
-     626,   564,   628,   629,   179,   491,   792,   793,   794,   495,
-     179,   179,   676,   576,   676,   179,   502,   681,   179,   681,
-     179,   584,   745,   586,   587,   588,   589,   590,   179,   179,
-     593,   594,   179,   189,   564,   179,   179,   179,   179,   762,
-     763,   764,   765,   766,   179,   531,   576,   179,   179,   179,
-     179,   537,   538,   179,   584,   541,   586,   587,   588,   589,
-     590,   179,   179,   169,     5,   169,     7,     8,     9,    10,
-      11,     3,    13,    14,    15,    16,    17,    18,     4,   565,
-      21,    22,    23,    24,    25,   169,   169,     3,   574,     3,
-      20,    21,    22,    23,    24,    25,    20,    21,    22,    23,
-      24,    25,     5,   169,     3,   595,   169,   179,   169,   595,
-     596,   169,   748,   676,     3,     3,   169,   867,   681,     4,
-      11,   180,    13,    14,    15,    16,    17,    18,   593,   594,
-      21,    22,    23,    24,    25,    21,    22,    23,    24,    25,
-     626,   176,   628,   629,     3,   176,   632,   633,    20,    21,
-      22,    23,    24,    25,   750,     5,   792,   814,   881,     3,
-     179,   725,   179,   759,   650,   651,   792,   793,   794,   655,
-     700,   657,   132,     3,     3,   661,     3,   741,    20,    21,
-      22,    23,    24,    25,     3,   749,   189,   750,   674,   675,
-       3,   180,   180,     3,     3,   179,   759,   169,    24,   179,
-     169,   687,   667,   689,   169,   179,   169,   180,     3,   180,
-     878,   676,     5,   180,   176,     3,   681,     3,   683,    25,
-     750,     3,   708,    13,    14,    15,    16,    17,    18,   759,
-       3,    21,    22,    23,    24,    25,     3,   180,   179,     4,
-     180,   169,   728,    84,   185,   186,   180,   180,   189,   714,
-     180,    30,   816,    24,   740,    24,   180,   179,   744,     9,
-      10,    11,   748,    13,    14,    15,    16,    17,    18,    24,
-      23,    21,    22,    23,    24,    25,     4,   169,   180,   169,
-     180,   917,     4,   126,     3,   750,   882,    20,     3,     5,
-     169,   169,     5,   180,   185,   186,   179,     3,   862,   180,
-     180,    24,    29,   180,   180,   180,   792,   793,   794,   873,
-     180,   180,   180,     3,   188,   126,   180,   180,   169,   882,
-     169,   258,   808,   809,    10,     3,    14,     5,   906,     7,
-       8,     9,    10,    11,   904,    13,    14,    15,    16,    17,
-      18,   428,   528,    21,    22,    23,    24,    25,   685,   689,
-     498,   511,   882,    80,    81,    82,   268,   493,   537,   304,
-     416,   721,   848,   848,   850,    76,   852,    13,    14,    15,
-      16,    17,    18,   850,   675,    21,    22,    23,    24,    25,
-     897,   867,   109,   748,   111,   112,   113,   955,   871,   116,
-     117,   143,   119,   120,   959,   185,   186,   555,   142,   143,
-     140,   347,   744,   381,   750,   557,   593,    -1,   894,   594,
-     896,   897,    -1,   878,   158,   159,    -1,    -1,   162,   163,
+      11,   295,     1,   185,    15,   101,   219,    18,   104,   240,
+     394,   577,   108,   395,   277,   111,    54,   161,   482,   477,
+     205,   536,   536,   653,   482,     5,   264,   124,   172,    79,
+     268,    81,    82,   161,     3,     3,    86,     3,   274,   710,
+      39,     3,   564,   565,     1,     3,   124,    17,   719,    75,
+      76,     3,    51,    80,   124,   291,   563,   564,   565,     3,
+      87,    19,    20,    21,     3,    31,   722,    37,    38,   768,
+     214,     3,     3,   217,   214,   113,   363,   115,   116,   329,
+      24,    21,     3,   161,   747,   124,   214,    21,     5,     6,
+       7,     8,     9,    10,    51,    12,    13,    14,    15,    16,
+      17,   127,    19,    20,    21,    22,    23,    27,     3,     3,
+      22,   122,     3,     3,     3,   212,   213,   904,     3,   130,
+     131,   132,   219,    21,     3,   112,     3,    45,     3,    44,
+     141,   153,   976,     3,    24,   213,   214,    18,     3,     3,
+     121,    22,   122,   213,   155,   101,    24,   131,   245,    24,
+     161,   198,     3,     3,     3,     3,     3,     3,     3,    24,
+       3,   172,    19,    20,    21,   131,   177,   131,   404,    91,
+      88,    89,   119,   891,   221,   162,  1020,    18,   428,   160,
+     191,    22,   166,   130,    21,    21,    22,    23,   168,   188,
+     201,   202,   107,   115,   160,   140,   246,   142,   166,   168,
+     987,   163,   166,   214,   160,   160,   217,   206,    23,   167,
+     881,   163,   157,   931,   213,   914,   227,   161,   217,   363,
+     160,   220,   166,   363,   163,   322,   225,   253,   884,   240,
+     327,   163,   163,   167,   331,   363,     5,   900,   265,    24,
+     160,   472,   163,   270,   322,   162,   273,   164,   165,   327,
+     162,   168,   322,   331,   131,   254,   162,   327,   765,   766,
+     767,   331,   140,    21,   162,   501,   502,   237,   163,   163,
+     269,   161,   163,   509,   163,   286,   166,   288,   163,   160,
+      21,     3,    24,   322,   163,   363,   161,   523,   166,   300,
+     301,   166,   331,   163,   305,   526,   161,   254,   534,   163,
+     485,   166,    44,   314,   315,   316,   317,   318,   319,   320,
+     167,   561,   163,   163,   163,   163,   163,   163,   163,   160,
+     163,   608,   609,   322,   611,   162,   576,   424,   164,   165,
+     341,   796,   797,   798,   345,   346,   347,   348,   349,   350,
+     351,   352,   353,   354,   355,   356,   424,    18,   162,   164,
+     165,    22,   363,   122,   424,    18,    19,    20,    21,    22,
+      23,   162,   373,   374,   375,   376,   377,   378,   379,   380,
+     381,   382,   383,   384,   385,   386,   387,   388,   389,   390,
+     391,   166,   846,    18,   395,   424,   530,     3,   846,   847,
+     848,   849,   850,   915,   339,   340,   490,   160,   140,   162,
+     162,     3,   160,  1033,   126,   163,    22,   133,   915,   659,
+     133,   255,   256,   358,   425,   360,   361,   362,   162,   160,
+      94,    95,   163,   153,   166,   370,   520,   663,   133,    31,
+     162,   813,   162,   471,   160,   161,   562,   160,   282,     3,
+     160,    78,    79,   569,   657,   495,   166,   543,   711,   914,
+     500,   160,   836,   503,    18,   160,   669,   166,    22,   160,
+      18,   472,   756,   701,    22,   562,  1032,   478,   162,    29,
+     614,    31,   569,   162,   571,   572,   573,   574,   575,   160,
+     491,   162,   718,   990,   562,   496,   160,   122,   131,   160,
+     721,   569,   562,   571,   572,   573,   574,   575,     3,   569,
+     163,   571,   572,   573,   574,   575,  1021,  1021,   693,   796,
+     797,   798,   162,    18,   525,   526,   162,    22,   662,   530,
+     770,   771,   772,   773,   774,   536,     3,  1042,  1042,   131,
+     161,   162,   571,   572,   573,   574,   575,    83,   537,    85,
+     539,    18,  1006,   123,   641,    22,   160,   546,  1006,   560,
+       8,     9,    10,     4,    12,    13,    14,    15,    16,    17,
+     657,    19,    20,    21,    22,    23,   577,   664,   579,   160,
+     161,   162,   669,    18,    19,    20,    21,    22,    23,    18,
+      19,    20,    21,    22,    23,   821,   664,    24,    41,    19,
+      20,    21,    22,    23,   664,   161,   162,   608,   609,   166,
+     611,   162,   163,   614,   615,   847,   848,   849,   850,   903,
+     134,   135,   136,   683,    21,    22,    23,    19,    20,    83,
+      84,   632,   633,    37,    38,     3,   637,     3,   639,   123,
+     124,   160,   643,     3,   162,   162,   162,   819,   168,   162,
+     162,   652,   738,   654,   740,   656,   162,   646,   162,   162,
+     162,   662,   796,   749,   653,   886,   162,     3,   162,   162,
+     162,   162,   162,   162,   675,   664,   677,   162,     3,   162,
+     162,   768,   671,   162,   162,   162,   912,   162,   162,   132,
+     691,   692,   160,     3,   160,   138,   139,   160,   982,   163,
+     768,   702,     5,   160,     3,   160,   162,   160,   768,   160,
+     153,   154,     3,   156,   157,   160,   164,   165,   161,   708,
+     721,     5,     6,     7,     8,     9,    10,     3,    12,    13,
+      14,    15,    16,    17,   160,    19,    20,    21,    22,    23,
+       3,     5,   161,     3,     3,   163,     3,     3,   162,    22,
+     751,     5,     3,     3,   163,   163,     3,     3,   163,   760,
+     162,   160,   988,     3,   160,   163,     3,   162,     5,     6,
+       7,     8,     9,    10,   162,    12,    13,    14,    15,    16,
+      17,   162,    19,    20,    21,    22,    23,   162,   160,   163,
+     161,     3,     3,    23,     3,   796,   797,   798,     3,     3,
+     163,     4,   163,    22,   163,   163,   160,   893,    22,   162,
+      26,    21,   813,   814,   163,   160,   902,   163,     4,    36,
+     122,   955,     3,   160,   162,   160,    10,   914,    12,    13,
+      14,    15,    16,    17,   160,    19,    20,    21,    22,    23,
+     163,     3,   162,   162,     5,   163,   914,     5,   935,   163,
+     162,   160,   163,   160,   914,   160,     4,   163,     3,   163,
+      82,   122,   163,   163,     3,    22,   160,   868,   163,   870,
+     167,   872,   160,   160,   163,   168,    82,   163,   163,   160,
+     164,   165,    25,   160,   168,   886,   160,    22,   974,   160,
+     891,    51,   254,   950,   485,   948,   897,    12,    13,    14,
+      15,    16,    17,   904,    19,    20,    21,    22,    23,    12,
+      13,    14,    15,    16,    17,   673,    19,    20,    21,    22,
+      23,   677,   911,   924,   405,   926,   927,   164,   165,   481,
+     931,   932,   505,   934,   480,    78,    79,    80,   260,   525,
+     493,   289,   715,   944,    52,   868,   927,   397,   937,   959,
+     870,   662,   890,  1016,   955,   985,   541,   757,   937,   960,
+     961,   760,   664,   106,   435,   108,   109,   110,   124,    -1,
+     113,   114,    -1,   116,   117,    -1,    -1,     0,     1,    -1,
+     164,   165,    -1,    -1,   985,    -1,   987,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   983,   996,    -1,    -1,   999,    -1,
+      -1,    24,    25,    -1,    -1,    28,    29,    30,    31,    32,
+      -1,    -1,    35,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+    1021,    -1,    45,    -1,    -1,    -1,    -1,    -1,    -1,  1030,
+      -1,  1032,    -1,  1034,  1035,  1024,    -1,    -1,    61,    -1,
+      -1,  1042,    65,    66,  1033,    -1,    -1,    70,  1049,   164,
+     165,    -1,    -1,    76,    -1,    78,    79,    -1,    81,    -1,
+      -1,   164,   165,    86,    87,    88,    89,    90,    -1,    92,
+      93,    -1,    -1,    96,    97,    98,    99,   100,   101,   102,
+     103,   104,   105,   106,    -1,   108,    -1,   110,   111,    -1,
+      -1,   114,   115,   116,    -1,   118,    -1,   120,    -1,    -1,
+     123,   124,    -1,    -1,   127,   128,   129,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   137,    -1,    -1,   140,   141,   142,
+     143,   144,   145,   146,   147,   148,   149,   150,   151,   152,
+      -1,    -1,   155,    -1,    -1,   158,   159,   160,   161,    -1,
+      -1,    -1,     3,   166,     5,     6,     7,     8,     9,    10,
+      -1,    12,    13,    14,    15,    16,    17,    -1,    19,    20,
+      21,    22,    23,     3,    -1,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,     3,    -1,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,     3,    -1,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     3,    -1,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     4,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     4,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    33,    34,    -1,    -1,    -1,    -1,    39,    40,
+      41,    42,    43,   164,   165,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    54,    55,    56,    57,    58,    59,    60,
+      -1,    62,    63,    64,   164,   165,    67,    68,    69,    -1,
+      71,    72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   164,   165,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,   164,   165,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,   164,   165,    -1,
+      -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,
+      -1,    -1,    -1,   144,    -1,    -1,   163,   164,   165,    -1,
+      -1,    -1,   153,   154,    -1,   156,   157,    -1,    -1,   160,
+     161,   162,    -1,    -1,    -1,    -1,    -1,   164,   165,     4,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     4,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     4,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,   164,
+     165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   164,
+     165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   164,
+     165,     5,     6,     7,     8,     9,    10,    -1,    12,    13,
+      14,    15,    16,    17,    -1,    19,    20,    21,    22,    23,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,    -1,    -1,    -1,    -1,   163,
      164,   165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   917,   176,    -1,    -1,   185,   186,   902,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   931,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   939,    -1,    -1,    -1,    -1,    -1,   945,
-      -1,    -1,   948,     0,     1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   964,    -1,
-      -1,    -1,    -1,   969,   970,    -1,    -1,   973,   974,    -1,
-      27,    -1,    29,    -1,   980,    32,    33,    34,    35,    36,
-      37,    38,    -1,    -1,    41,    42,    43,   185,   186,    -1,
-      -1,    48,    49,    -1,    -1,    -1,    53,    54,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    63,    -1,    -1,    -1,
-      67,    68,    -1,    -1,    -1,    72,    -1,    -1,    -1,   185,
-     186,    78,    -1,    80,    81,    -1,    83,    -1,    85,    86,
-      87,    88,    89,    -1,    91,    92,    93,    94,    95,    96,
-      97,    98,    99,   100,   101,   102,   103,   104,   105,   106,
-      -1,    -1,   109,   110,   111,    -1,   113,   114,   115,    -1,
-     117,   118,   119,    -1,    -1,   122,    -1,   124,    -1,    -1,
-     127,   128,   129,   130,    -1,    -1,   133,   134,   135,    -1,
-      -1,    -1,    -1,    -1,   141,    -1,    -1,   144,   145,   146,
-     147,   148,   149,   150,   151,    -1,   153,   154,   155,   156,
-     157,    -1,    -1,   160,    -1,    -1,    -1,    -1,    -1,    -1,
-     167,   168,   169,    -1,    -1,    -1,    -1,    -1,    -1,   176,
-     177,     3,    -1,     5,    -1,     7,     8,     9,    10,    11,
-     187,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,    40,    -1,
-      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
-      62,    -1,    64,    65,    66,    -1,    -1,    69,    70,    71,
-      -1,    73,    74,    75,    76,    77,     3,    79,     5,    -1,
-       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
-      17,    18,    -1,    -1,    21,    22,    23,    24,    25,     3,
-      -1,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
-      14,    15,    16,    17,    18,    -1,    -1,    21,    22,    23,
-      24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   163,   164,
+     165,     5,     6,     7,     8,     9,    10,    -1,    12,    13,
+      14,    15,    16,    17,    -1,    19,    20,    21,    22,    23,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,    -1,    -1,
+      -1,    -1,    -1,    -1,    33,    34,    -1,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,    -1,   163,   164,   165,    -1,
+      -1,    -1,    -1,    -1,    -1,    54,    55,    56,    57,    58,
+      59,    60,   160,    62,    63,    64,   164,   165,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,    -1,    -1,    -1,    -1,   163,
+     164,   165,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    -1,    -1,   144,    -1,    -1,   163,   164,
+     165,    -1,    -1,    -1,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    -1,    -1,    -1,   163,   164,   165,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     142,   143,    -1,    -1,    -1,    -1,   148,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,
-     162,   163,   164,   165,    -1,    -1,    -1,   169,    -1,    -1,
-      -1,    -1,    -1,    -1,   176,    -1,    -1,   179,    -1,    -1,
-      -1,    -1,    -1,   185,   186,     3,    -1,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,    -1,    -1,    21,    22,    23,    24,    25,     3,    -1,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,     3,    -1,     5,    -1,     7,     8,     9,    10,    11,
-      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,   185,   186,
-      -1,    -1,    -1,    -1,    -1,    -1,     4,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,   185,   186,    21,    22,    23,    24,    25,     4,     5,
-      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
-      16,    17,    18,    -1,    -1,    21,    22,    23,    24,    25,
-       4,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
-      14,    15,    16,    17,    18,    -1,    -1,    21,    22,    23,
-      24,    25,     4,     5,    -1,     7,     8,     9,    10,    11,
-      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   185,   186,    -1,
-      -1,    -1,    -1,    -1,    -1,     4,     5,    -1,     7,     8,
-       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
-     185,   186,    21,    22,    23,    24,    25,    -1,    -1,     5,
-      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
-      16,    17,    18,   185,   186,    21,    22,    23,    24,    25,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
-      -1,    -1,    -1,    -1,    -1,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,   185,
-     186,    21,    22,    23,    24,    25,    -1,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,   185,   186,    21,    22,    23,    24,    25,    -1,     5,
-      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
-      16,    17,    18,   185,   186,    21,    22,    23,    24,    25,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,   185,   186,    21,    22,
-      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,
-     186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
-     185,   186,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
-      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,    -1,    -1,    -1,    -1,   163,   164,
+     165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,
-     186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
-     185,   186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
-      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
-      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
-      -1,    21,    22,    23,    24,    25,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
-      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
-      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
-      -1,    21,    22,    23,    24,    25,     5,    -1,     7,     8,
-       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
-      -1,    -1,    21,    22,    23,    24,    25,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,    -1,    -1,    21,    22,    23,    24,    25,     5,    -1,
-       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
-      17,    18,    -1,    -1,    21,    22,    23,    24,    25,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,
-      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,   169,
-      -1,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
-      14,    15,    16,    17,    18,   185,   186,    21,    22,    23,
-      24,    25,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
-      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,   180,
-      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
+      -1,    -1,    -1,   163,   164,   165,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,     5,     6,     7,     8,     9,    10,
+      -1,    12,    13,    14,    15,    16,    17,    -1,    19,    20,
+      21,    22,    23,    -1,    -1,    -1,    -1,   163,   164,   165,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,
-      -1,   185,   186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
-      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
-      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
-      -1,    21,    22,    23,    24,    25,     5,    -1,     7,     8,
-       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
-      -1,    -1,    21,    22,    23,    24,    25,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,    -1,    -1,    21,    22,    23,    24,    25,     5,    -1,
-       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
-      17,    18,    -1,    -1,    21,    22,    23,    24,    25,    -1,
-      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
-     185,   186,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
-      23,    24,    25,     5,    -1,     7,     8,     9,    10,    11,
-      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    38,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,
-      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    63,    -1,    -1,    -1,    -1,    -1,
-     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    78,
-      -1,    -1,    -1,    -1,    83,    84,    -1,    -1,    -1,    88,
-      89,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,    98,
-      99,   100,   101,   102,   103,   104,   105,    -1,    -1,    -1,
-      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,   118,
-      -1,    -1,    -1,    -1,    -1,   124,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   180,   133,    -1,   135,    -1,   185,   186,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-     169,    -1,   185,   186,    -1,    -1,    -1,   176,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,
-      -1,    -1,    -1,   185,   186,     5,    -1,     7,     8,     9,
-      10,    11,     4,    13,    14,    15,    16,    17,    18,    -1,
-      12,    21,    22,    23,    24,    25,    -1,    -1,    -1,    21,
-      22,    23,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,    40,    -1,
-      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
-      62,    -1,    64,    65,    66,    -1,    -1,    69,    70,    71,
-      -1,    73,    74,    75,    76,    77,    -1,    79,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    40,    -1,
-      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
-      62,    -1,    64,    65,    66,   180,    -1,    69,    70,    71,
-     185,   186,    74,    75,    76,    77,    -1,    79,    -1,   131,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,
-     142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,
-     162,   163,   164,   165,    -1,    39,    40,   169,    -1,    -1,
-      44,    45,    46,    47,   176,   185,   186,   179,    -1,    -1,
-      -1,    -1,    56,    57,    58,    59,    60,    61,    62,    -1,
-      64,    65,    66,    -1,    -1,    69,    70,    71,    -1,    73,
-      74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   169,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   163,   164,   165,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   163,   164,   165,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,     4,    -1,   163,   164,   165,
+      -1,    -1,    11,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      19,    20,    21,    -1,    -1,    -1,   163,   164,   165,    -1,
+      -1,    -1,    -1,    -1,    33,    34,    -1,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,   163,   164,   165,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    34,    77,    -1,
+      -1,    -1,    39,    40,    -1,    42,    43,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,     4,    72,    73,    74,    75,    -1,
+      77,    11,    -1,    -1,   164,   165,   125,    -1,    -1,    19,
+      20,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,
+      40,    41,    42,    43,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    54,    55,    56,    57,    58,    59,
+      60,    -1,    62,    63,    64,    -1,    -1,    67,    68,    69,
+      -1,    71,    72,    73,    74,    75,    -1,    77,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   160,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,     4,    -1,    -1,    -1,    -1,    -1,    -1,
+      11,    -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,
+      -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,
+      -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,
+      41,    42,    43,   153,   154,    -1,   156,   157,    -1,    -1,
+     160,   161,   162,    54,    55,    56,    57,    58,    59,    60,
+      -1,    62,    63,    64,    -1,    -1,    67,    68,    69,    -1,
+      71,    72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   142,   143,
-      -1,    -1,    -1,    -1,   148,     4,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,   158,   159,    -1,    -1,   162,   163,
-     164,   165,    21,    22,    -1,   169,    -1,    -1,    -1,    -1,
-      -1,    -1,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,
-      39,    40,    -1,   187,    -1,    44,    45,    46,    47,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,     4,    -1,    -1,    -1,    -1,    -1,    -1,    11,
+      -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,    -1,
+      -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,
+      -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,    41,
+      42,    43,   153,   154,    -1,   156,   157,    -1,    -1,   160,
+     161,   162,    54,    55,    56,    57,    58,    59,    60,    -1,
+      62,    63,    64,    -1,    -1,    67,    68,    69,    -1,    71,
+      72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,     5,    -1,    -1,    -1,    -1,    -1,    11,    -1,
+      -1,    -1,    -1,   125,    -1,    -1,    19,    20,    21,    -1,
+     132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,
+      33,    34,   144,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,   153,   154,    -1,   156,   157,    -1,    -1,   160,   161,
+     162,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    -1,    -1,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,     5,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,
+      -1,    -1,   125,    -1,    -1,    19,    20,    -1,    22,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,
+      34,   144,    -1,    -1,    -1,    39,    40,    41,    42,    43,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      54,    55,    56,    57,    58,    59,    60,    -1,    62,    63,
+      64,    -1,    -1,    67,    68,    69,    -1,    71,    72,    73,
+      74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+       5,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,
+      -1,   125,    -1,    -1,    19,    20,    21,    -1,   132,    -1,
+      -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,
+     144,    -1,    -1,    -1,    39,    40,    41,    42,    43,   153,
+     154,    -1,   156,   157,    -1,    -1,   160,   161,   162,    54,
+      55,    56,    57,    58,    59,    60,    -1,    62,    63,    64,
+      -1,    -1,    67,    68,    69,    -1,    71,    72,    73,    74,
+      75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,     5,
+      -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,
+     125,    -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,
+      -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,
+      -1,    -1,    -1,    39,    40,    41,    42,    43,   153,   154,
+      -1,   156,   157,    -1,    -1,   160,   161,   162,    54,    55,
+      56,    57,    58,    59,    60,    -1,    62,    63,    64,    -1,
+      -1,    67,    68,    69,    -1,    71,    72,    73,    74,    75,
+      -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,     5,    -1,
+      -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,
+      -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,    -1,
+      -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,   153,   154,    -1,
+     156,   157,    -1,    -1,   160,   161,   162,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,     5,    -1,    -1,
+      -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,
+      -1,    19,    20,    -1,    -1,   132,    -1,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,
+      -1,    39,    40,    41,    42,    43,   153,   154,    -1,   156,
+     157,    -1,    -1,   160,   161,   162,    54,    55,    56,    57,
+      58,    59,    60,    -1,    62,    63,    64,    -1,    -1,    67,
+      68,    69,    -1,    71,    72,    73,    74,    75,    -1,    77,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,     4,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
+      -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,    -1,
+      19,    20,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,
+     138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,   153,   154,    -1,   156,   157,
+      -1,    -1,   160,   161,   162,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   125,    -1,    -1,    -1,
+      -1,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    -1,    -1,   144,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   153,   154,    11,   156,   157,    -1,
+      -1,   160,   161,   162,    19,    20,    21,   166,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    33,    34,
+      -1,    -1,    -1,    -1,    39,    40,    41,    42,    43,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    54,
+      55,    56,    57,    58,    59,    60,    -1,    62,    63,    64,
+      -1,    -1,    67,    68,    69,    -1,    71,    72,    73,    74,
+      75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,     5,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      23,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,
+     125,    -1,    -1,    19,    20,    21,    -1,   132,    -1,    -1,
+      -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,
+      -1,    -1,    -1,    39,    40,    41,    42,    43,   153,   154,
+      -1,   156,   157,    -1,    -1,   160,   161,   162,    54,    55,
+      56,    57,    58,    59,    60,    -1,    62,    63,    64,    -1,
+      -1,    67,    68,    69,    -1,    71,    72,    73,    74,    75,
+      -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,
+      -1,    -1,    19,    20,    21,    -1,   132,    -1,    -1,    -1,
+      -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,   153,   154,    -1,
+     156,   157,    -1,    -1,   160,   161,   162,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,
+      -1,    19,    20,    21,    -1,   132,    -1,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,
+      -1,    39,    40,    41,    42,    43,   153,   154,    -1,   156,
+     157,    -1,    -1,   160,   161,   162,    54,    55,    56,    57,
+      58,    59,    60,    -1,    62,    63,    64,    -1,    -1,    67,
+      68,    69,    -1,    71,    72,    73,    74,    75,    -1,    77,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-       5,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,    24,
-      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,    -1,
+      19,    20,    21,    -1,   132,    -1,    -1,    -1,    -1,    -1,
+     138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,   153,   154,    -1,   156,   157,
+      -1,    -1,   160,   161,   162,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,     5,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   125,    -1,    -1,    -1,
+      -1,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    11,    -1,    -1,   144,    -1,    -1,    -1,    -1,
+      19,    20,    -1,    -1,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    33,    34,    35,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,     5,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    11,    -1,    -1,    -1,    -1,   125,    -1,    -1,    19,
+      20,    21,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,
+      40,    41,    42,    43,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    54,    55,    56,    57,    58,    59,
+      60,    -1,    62,    63,    64,    -1,    -1,    67,    68,    69,
+      -1,    71,    72,    73,    74,    75,    -1,    77,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,    -1,     5,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
+      11,    -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,
+      21,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,
+      -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,
+      41,    42,    43,   153,   154,    -1,   156,   157,    -1,    -1,
+     160,   161,   162,    54,    55,    56,    57,    58,    59,    60,
+      -1,    62,    63,    64,    -1,    -1,    67,    68,    69,    -1,
+      71,    72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    11,
+      -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,    -1,
+      -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,
+      -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,    41,
+      42,    43,   153,   154,    -1,   156,   157,    -1,    -1,   160,
+     161,   162,    54,    55,    56,    57,    58,    59,    60,    -1,
+      62,    63,    64,    -1,    -1,    67,    68,    69,    -1,    71,
+      72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    11,    -1,
+      -1,    -1,    -1,   125,    -1,    -1,    19,    20,    -1,    -1,
+     132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,
+      33,    34,   144,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,   153,   154,    -1,   156,   157,    -1,    -1,   160,   161,
+     162,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    -1,    -1,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,
+      -1,    -1,   125,    -1,    -1,    19,    20,    -1,    -1,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,
+      34,   144,    -1,    -1,    -1,    39,    40,    41,    42,    43,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      54,    55,    56,    57,    58,    59,    60,    -1,    62,    63,
+      64,    -1,    -1,    67,    68,    69,    -1,    71,    72,    73,
+      74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,
+      -1,   125,    -1,    -1,    19,    20,    -1,    -1,   132,    -1,
+      -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,
+     144,    -1,    -1,    -1,    39,    40,    41,    42,    43,   153,
+     154,    -1,   156,   157,    -1,    -1,   160,   161,   162,    54,
+      55,    56,    57,    58,    59,    60,    -1,    62,    63,    64,
+      -1,    -1,    67,    68,    69,    -1,    71,    72,    73,    74,
+      75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,
+     125,    -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,
+      -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,
+      -1,    -1,    -1,    39,    40,    41,    42,    43,   153,   154,
+      -1,   156,   157,    -1,    -1,   160,   161,   162,    54,    55,
+      56,    57,    58,    59,    60,    -1,    62,    63,    64,    -1,
+      -1,    67,    68,    69,    -1,    71,    72,    73,    74,    75,
+      -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,
+      -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,    -1,
+      -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,   153,   154,    -1,
+     156,   157,    -1,    -1,   160,   161,   162,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   125,    -1,
+      -1,    -1,    -1,    -1,    -1,   132,    -1,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    -1,    -1,   144,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   153,   154,    -1,   156,
+     157,    -1,    -1,   160,   161,   162,    19,    20,    21,    -1,
+      23,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      33,    34,    -1,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,    -1,    -1,    46,    47,    48,    49,    50,    -1,    52,
+      53,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    -1,    -1,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    -1,
+      -1,   144,    -1,    -1,    -1,    -1,    19,    20,    21,    -1,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      33,    34,    -1,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,    -1,    -1,    46,    47,    48,    49,    50,    -1,    52,
+      53,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    19,    20,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    33,    34,    -1,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,    -1,    -1,    46,
+      47,    48,    49,    50,    -1,    52,    53,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    -1,
+      -1,   144,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      -1,    -1,    -1,    -1,    -1,    -1,    25,    -1,    -1,    28,
+      -1,    30,    -1,    32,    -1,   132,    35,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    -1,    45,   144,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   153,   154,    -1,   156,
+     157,    -1,    61,   160,   161,   162,    65,    66,    -1,    -1,
+      -1,    70,    -1,    -1,    -1,    -1,    -1,    76,    -1,    78,
+      79,    -1,    81,    -1,    -1,    -1,    -1,    86,    87,    88,
+      89,    90,    -1,    92,    93,    -1,    -1,    96,    97,    98,
+      99,   100,   101,   102,   103,   104,   105,   106,    -1,   108,
+      -1,   110,   111,    -1,    -1,   114,   115,   116,    -1,   118,
+      -1,   120,    -1,    -1,   123,   124,    -1,    -1,   127,   128,
+     129,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   137,    -1,
+      -1,    -1,   141,   142,   143,   144,   145,   146,   147,   148,
+     149,   150,   151,   152,    -1,    -1,   155,    -1,    -1,   158,
+     159,   160,   161,    25,    -1,    -1,    28,   166,    30,    -1,
+      32,    -1,    -1,    35,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    45,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    61,
+      -1,    -1,    -1,    65,    66,    -1,    -1,    -1,    70,    -1,
+      -1,    -1,    -1,    -1,    76,    -1,    78,    79,    -1,    81,
+      -1,    -1,    -1,    -1,    86,    87,    88,    89,    90,    -1,
+      92,    93,    -1,    -1,    96,    97,    98,    99,   100,   101,
+     102,   103,   104,   105,   106,    -1,   108,    -1,   110,   111,
+      -1,    -1,   114,   115,   116,    -1,   118,    -1,   120,    -1,
+      -1,   123,   124,    -1,    -1,   127,   128,   129,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   137,    -1,    -1,    -1,   141,
+     142,   143,   144,   145,   146,   147,   148,   149,   150,   151,
+     152,    32,    -1,   155,    35,    -1,   158,   159,   160,   161,
+      -1,    -1,    -1,    -1,    45,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,     5,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
+      61,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    76,    -1,    -1,    -1,    -1,
+      81,    -1,    83,    -1,    -1,    86,    87,    88,    89,    90,
+      -1,    -1,    93,    -1,    -1,    96,    97,    98,    99,   100,
+     101,   102,   103,   104,   105,    -1,    -1,    32,    -1,    -1,
+      35,    -1,    -1,    -1,   115,    -1,    -1,    -1,    -1,   120,
+      45,    -1,    -1,    -1,    -1,    -1,   127,    -1,   129,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    61,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   148,   149,   150,
+     151,    76,    -1,    -1,    -1,    -1,    81,    -1,    -1,   160,
+     161,    86,    87,    88,    89,    90,    -1,    -1,    93,    -1,
+      -1,    96,    97,    98,    99,   100,   101,   102,   103,   104,
+     105,    -1,    -1,    -1,    -1,    -1,    35,    -1,    -1,    -1,
+     115,    -1,    -1,    -1,    -1,   120,    -1,    -1,    -1,    -1,
+      -1,    -1,   127,    -1,   129,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    61,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   148,   149,   150,   151,    76,    -1,    -1,
+      -1,    -1,    81,    82,    -1,   160,   161,    86,    87,    88,
+      -1,    90,    -1,    -1,    93,    -1,    -1,    96,    97,    98,
+      99,   100,   101,   102,   103,   104,   105,    -1,    -1,    -1,
+      -1,    -1,    35,    -1,    -1,    -1,   115,    -1,    -1,    -1,
+      -1,   120,    -1,    -1,    -1,    -1,    -1,    -1,   127,    -1,
+     129,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    61,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   148,
+     149,   150,   151,    76,    -1,    -1,    -1,    -1,    81,    -1,
+      -1,   160,   161,    86,    87,    88,    -1,    90,    -1,    -1,
+      93,    -1,    -1,    96,    97,    98,    99,   100,   101,   102,
+     103,   104,   105,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   115,    -1,    -1,    -1,    -1,   120,    -1,    -1,
+      -1,    -1,    -1,    -1,   127,    -1,   129,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    23,    -1,
-      25,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    23,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    23,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      23,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    23,    -1,
-      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    21,    22,    23,    -1,    25,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,
-      40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,    -1,
-      50,    51,    52,    -1,    -1,    55,    56,    57,    58,    59,
-      60,    61,    62,    -1,    64,    65,    66,    -1,    -1,    69,
-      70,    71,   131,    73,    74,    75,    76,    77,    -1,    79,
-      -1,    -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,
-     169,    -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,
-      -1,    -1,   162,   163,   164,   165,    21,    22,    23,   169,
-      -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,   179,
-      -1,    -1,    -1,    -1,    39,    40,    -1,    -1,    -1,    44,
-      45,    46,    47,    -1,    -1,    50,    51,    52,    -1,    -1,
-      55,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    21,    22,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      39,    40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,
-      -1,    50,    51,    52,    -1,    -1,    55,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    -1,    -1,   169,    -1,    -1,    -1,    -1,    -1,
-      -1,   176,    -1,    29,   179,    -1,    32,    33,    34,    35,
-      -1,    -1,    38,   142,   143,    41,    42,    43,    -1,   148,
-      -1,    -1,    48,    49,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    63,    -1,    -1,
-     169,    67,    68,    -1,    -1,    -1,    72,   176,    -1,    -1,
-     179,    -1,    78,    -1,    80,    81,    -1,    83,    -1,    85,
-      86,    87,    88,    89,    -1,    91,    92,    93,    94,    95,
-      96,    97,    98,    99,   100,   101,   102,   103,   104,   105,
-     106,    -1,    -1,   109,   110,   111,    -1,   113,   114,   115,
-      -1,   117,   118,   119,    -1,    -1,   122,    -1,   124,    -1,
-      -1,   127,   128,   129,   130,    -1,    -1,   133,   134,   135,
-      -1,    -1,    -1,    -1,    -1,   141,    -1,    -1,    -1,   145,
-     146,   147,   148,   149,   150,   151,    -1,   153,   154,   155,
-     156,   157,    -1,    -1,   160,    -1,    -1,    -1,    -1,    39,
-      40,   167,   168,   169,    44,    45,    46,    47,    -1,    -1,
-     176,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,    59,
-      60,    61,    62,    -1,    64,    65,    66,    -1,    -1,    69,
-      70,    71,    -1,    73,    74,    75,    76,    77,    -1,    79,
-      39,    40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,
-      -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,   169,
-      -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,   179,
-      -1,    -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,
-     169,    -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,
-     179
+      -1,    -1,    -1,    -1,    -1,   148,   149,   150,   151,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   160,   161
 };
 
@@ -2798,103 +2739,110 @@
 static const yytype_uint16 yystos[] =
 {
-       0,   191,     0,     1,    36,    37,    53,    54,   144,   177,
-     187,   192,   197,   199,   205,   201,   198,   177,   200,    29,
-      32,    34,    38,    41,    42,    43,    48,    49,    63,    67,
-      68,    72,    78,    80,    81,    83,    85,    86,    87,    88,
-      89,    91,    92,    93,    94,    95,    96,    97,    98,    99,
-     100,   101,   102,   103,   104,   105,   106,   109,   110,   111,
-     113,   114,   115,   117,   118,   119,   122,   124,   127,   128,
-     129,   130,   133,   134,   135,   141,   145,   146,   147,   148,
-     149,   150,   151,   153,   154,   155,   156,   157,   160,   167,
-     168,   169,   176,   193,   194,   195,   202,   203,   206,   212,
-     224,   225,   228,   229,   234,   235,   237,   238,   239,   240,
-     241,   243,   244,   251,   253,   257,   258,   261,   262,   263,
-     298,   308,   309,   315,   316,   317,   318,   319,   321,   326,
-     327,   328,   330,   331,   333,   336,   337,   340,   341,   349,
-     351,   352,   365,   372,   201,   205,   169,   204,   179,    12,
-      21,    22,    39,    40,    44,    45,    46,    47,    56,    57,
-      58,    59,    60,    61,    62,    64,    65,    66,    69,    70,
-      71,    73,    74,    75,    76,    77,    79,   131,   142,   143,
-     148,   158,   159,   162,   163,   164,   165,   176,   179,   280,
-     281,   283,   284,   288,   290,   291,   292,   293,   298,   299,
-     300,   307,   320,   179,   187,   280,   304,   179,   217,   218,
-     179,   280,   303,     4,   187,   221,   187,   221,   304,   179,
-     169,   187,   324,   176,   179,   364,   280,   169,   325,   169,
-     324,   179,   169,   176,   179,   346,   179,   179,   221,   221,
-      20,    24,   247,   298,   179,   216,   123,   137,   127,   324,
-     324,   169,   252,    80,    81,   213,   275,   324,    27,   196,
-     198,    33,    35,   196,   158,   207,   196,   169,   179,   249,
-     250,   169,   226,   231,     3,   248,   169,   230,   247,     3,
-     236,   248,     3,   248,     3,   248,   169,   245,   246,   247,
-       3,     4,    35,   222,   223,   255,   271,   169,   176,   268,
-      23,   179,   259,    23,   179,   266,    23,     4,   329,   169,
-     310,   200,   324,   324,   324,   176,   323,   280,     5,   126,
-     189,   332,     3,   179,   334,   169,   304,   179,   345,    21,
-      22,    23,    50,    51,    52,    55,   169,   179,   281,   288,
-     299,   343,   345,   350,   353,   354,   355,   345,    84,    98,
-     105,   298,   328,   280,   280,   280,   282,   179,   179,   179,
-     282,   280,   282,   179,   179,   179,   179,   179,   179,   179,
-     179,   179,   179,   179,   179,   280,   179,   179,   179,   179,
-     179,   179,   280,   281,   283,   307,   360,   361,   362,   179,
-     280,   283,     5,     7,     8,     9,    10,    11,    13,    14,
-      15,    16,    17,    18,    21,    22,    23,    24,    25,   185,
-     186,   285,   280,   189,   179,   302,   179,   179,   169,   158,
-     301,   302,     3,     4,   180,   280,   219,   298,     3,   280,
-       4,   169,   242,   242,   280,   280,   180,   288,   292,   298,
-     330,   366,   367,   368,   176,   283,   298,   298,   367,   369,
-     298,   371,   242,    40,    44,    45,    46,    47,    56,    57,
-      58,    59,    60,    61,    62,    64,    65,    66,    69,    70,
-      71,    74,    75,    76,    77,    79,   169,   214,   215,   169,
-     298,   220,   280,     3,     3,   221,   194,   200,   204,   204,
-     196,     5,   249,     3,    24,   179,   187,   248,     3,    24,
-     230,   247,   179,   276,   230,   298,   247,   169,   169,   247,
-     276,     3,   245,    29,    82,   109,   111,   112,   113,   116,
-     117,   119,   120,   272,   273,   275,     4,   204,     3,   256,
-     254,     5,    23,   269,   280,   180,   176,   179,   169,   260,
-     269,   179,   267,   280,   268,   176,   276,     3,   205,   248,
-     298,   322,   373,   280,   280,   298,   176,    23,   280,   335,
-     338,   339,    23,    25,   179,   298,   347,   348,   353,   354,
-     280,   280,   280,   280,     5,   353,   179,   281,   288,   299,
-     342,   356,   357,   358,     3,   344,    20,    23,    24,    25,
-     355,   353,   360,   179,   179,   180,     3,   180,   282,   282,
-     280,   180,   180,   180,   280,   280,   280,   280,   280,   280,
-     280,   280,   280,   280,   280,   280,   180,   282,   282,   282,
-     282,   282,   280,   283,   361,   362,     3,   132,     3,     3,
-     282,   180,     3,     5,   280,   287,   280,   280,   280,   280,
-     280,   280,   280,   280,   280,   280,   280,   280,   280,   280,
-       5,    24,   280,   286,   280,     5,   280,     5,   280,   288,
-     303,   289,   294,   294,   280,   280,   180,     3,   180,   276,
-     218,   180,     3,   180,     3,   179,     3,   370,   180,   180,
-     180,     3,   370,     3,   180,     3,    24,     3,   180,   179,
-     169,   324,   179,   208,   208,   280,   180,   250,   227,   232,
-     233,   284,   280,   169,   169,   231,   227,   248,     4,    23,
-     277,   278,   279,   280,   248,   276,   276,   248,   246,   276,
-     179,     3,     4,   208,   254,   169,   269,   260,     5,   269,
-     180,     3,   270,    23,   180,   276,    31,   169,   311,   312,
-       5,   329,   364,   180,     3,   353,    23,    25,   179,   280,
-       3,   180,   180,   280,   180,   356,   285,   359,   359,     3,
-     359,   356,   353,   353,   353,   353,   353,   366,   369,   304,
-     280,   180,   180,   180,   180,   180,   180,   180,   180,   180,
-     180,   180,   180,   180,   180,   180,   180,   180,   180,   180,
-     180,   180,     3,     3,     3,   280,   362,   280,   362,   280,
-     362,   180,   283,   280,   280,   280,   280,   280,     4,     4,
-     280,   295,   296,   297,   180,   180,   298,   169,    84,   280,
-     295,   125,   367,   180,   367,   180,   298,   214,   280,   220,
-      23,   169,   180,   210,   211,    30,    24,     3,    21,    22,
-      23,   188,   299,   180,    24,    24,   230,   280,     3,   180,
-       4,   298,    23,   264,   264,   245,   138,   139,   140,   274,
-     273,     4,   169,   276,   180,   269,   270,   169,   180,     4,
-     126,     3,   280,   276,   339,   180,   280,   297,   189,   276,
-     348,   353,     3,   180,   285,   358,   370,   370,   169,   363,
-     363,   363,   180,   303,     4,   280,     4,     3,   302,   276,
-     180,   180,     5,   180,     3,   180,   179,   209,   227,   232,
-     232,   232,   232,   227,   278,   279,   280,   179,   265,   280,
-     180,   276,   264,   270,   269,   169,   187,   313,   314,   169,
-     312,     3,   276,   180,   330,   363,   359,   180,   180,     5,
-     180,   180,   180,   180,   280,     4,   280,   296,     3,   298,
-     211,   180,   210,    24,    23,   264,   305,   306,   126,     3,
-     280,   180,   280,   280,     4,   280,   180,   180,   305,     5,
-     126,   169,   314,     3,     3,   280,   280,   280,   280,   280,
-       3,   280
+       0,   170,     0,     1,    24,    25,    28,    30,    32,    35,
+      45,    61,    65,    66,    70,    76,    78,    79,    81,    86,
+      87,    88,    89,    90,    92,    93,    96,    97,    98,    99,
+     100,   101,   102,   103,   104,   105,   106,   108,   110,   111,
+     114,   115,   116,   118,   120,   123,   124,   127,   128,   129,
+     137,   140,   141,   142,   143,   144,   145,   146,   147,   148,
+     149,   150,   151,   152,   155,   158,   159,   160,   161,   166,
+     171,   172,   173,   174,   176,   178,   186,   198,   199,   203,
+     204,   209,   210,   211,   212,   213,   215,   216,   223,   225,
+     228,   231,   232,   267,   276,   277,   282,   283,   284,   286,
+     287,   291,   300,   301,   302,   303,   304,   310,   315,   319,
+     320,   323,   331,   332,   333,   334,   335,   338,   339,   341,
+     344,   345,   348,   357,   359,   369,   153,   181,   160,   180,
+     162,   162,    11,    19,    20,    33,    34,    39,    40,    41,
+      42,    43,    54,    55,    56,    57,    58,    59,    60,    62,
+      63,    64,    67,    68,    69,    71,    72,    73,    74,    75,
+      77,   125,   132,   138,   139,   144,   153,   154,   156,   157,
+     160,   161,   162,   166,   249,   250,   252,   253,   257,   259,
+     260,   261,   262,   267,   268,   269,   273,   275,   162,   191,
+     192,   162,   249,   272,   131,   166,   195,   166,   195,   273,
+     161,   162,   162,     3,   161,   179,   220,   305,   160,   160,
+     166,   336,   162,   162,   352,   160,   161,   162,   353,   162,
+     162,   195,   195,    18,    22,   219,   267,   162,   190,   119,
+     130,   123,   160,   224,   173,    78,    79,   187,   244,   133,
+     160,   161,   237,   336,   160,   162,   200,   201,   206,     4,
+     175,    24,   140,   166,    24,    29,    31,   175,   175,   160,
+     162,   221,   222,   166,     3,   220,   160,   205,   219,     3,
+     220,   220,     3,   220,   160,   217,   218,   219,     3,    31,
+     131,   196,   197,   226,   240,    21,   162,   229,    21,   162,
+     235,   337,   160,   172,   172,   172,   172,   336,   336,   336,
+       5,   122,   168,   340,     3,   162,   342,   101,   160,   273,
+     352,    19,    20,    21,    46,    47,    48,    49,    50,    52,
+      53,   160,   162,   250,   257,   268,   350,   352,   358,   360,
+     361,   362,   175,   249,   294,   249,   249,   249,   251,   162,
+     162,   162,   251,   249,   251,   162,   162,   162,   162,   162,
+     162,   162,   162,   162,   162,   162,   162,   249,   162,   251,
+     162,   162,   162,   162,   249,   250,   252,   275,   366,   367,
+     162,   249,   252,     5,     6,     7,     8,     9,    10,    12,
+      13,    14,    15,    16,    17,    19,    20,    21,    22,    23,
+     164,   165,   254,   249,   168,   162,   271,   162,   162,   160,
+     153,   270,   271,   193,   267,     3,   249,   133,   160,   214,
+     214,   249,   249,   161,   305,    94,    95,   267,   306,   257,
+     370,   371,    21,    23,   162,   267,   354,   355,   360,   361,
+     366,   161,   252,   267,   371,   372,   267,   374,   214,    34,
+      39,    40,    42,    43,    54,    55,    56,    57,    58,    59,
+      60,    62,    63,    64,    67,    68,    69,    72,    73,    74,
+      75,    77,   160,   188,   189,   160,   267,   194,   249,     3,
+       3,   195,     5,    21,   238,   249,   163,    22,   162,   257,
+     220,     3,    22,    45,    88,    89,   175,   166,   174,   180,
+     180,     5,   221,     3,   205,   219,   162,   245,   205,   267,
+     219,   160,   160,   219,   245,     3,   217,    25,    80,   106,
+     108,   109,   110,   113,   114,   116,   117,   241,   242,   244,
+     180,     3,   227,   160,   161,   162,   160,   230,   238,   161,
+     162,   236,   249,   237,   245,     3,   288,   299,   307,   299,
+      44,   321,   322,   324,   249,   249,   356,   161,    21,   249,
+     343,   346,   347,   249,   249,   249,   249,   249,   249,   249,
+       5,   360,   162,   250,   257,   268,   349,   363,   364,     3,
+     351,    18,    21,    22,    23,   362,   360,   163,   163,     3,
+     163,   251,   251,   249,   163,   163,   163,   249,   249,   249,
+     249,   249,   249,   249,   249,   249,   249,   249,   249,   163,
+     251,   163,   251,   251,   251,   252,   366,   367,     3,     3,
+     126,     3,   251,   163,     3,     5,   249,   256,   249,   249,
+     249,   249,   249,   249,   249,   249,   249,   249,   249,   249,
+     249,   249,     5,    22,   249,   255,   249,     5,   249,     5,
+     249,   356,   272,   258,   263,   263,     3,   163,   245,   192,
+     163,     3,     3,   163,   162,   298,     5,     3,   373,   360,
+      21,    23,   162,   249,     3,   163,   163,   163,   163,     3,
+     373,     3,   163,     3,    22,     3,   163,   162,   160,   336,
+     238,   202,   207,   208,   253,   249,     3,   201,   160,   206,
+     202,   162,   162,   179,   305,   162,   182,   182,   249,   163,
+     222,   220,     4,    21,   246,   247,   248,   249,   220,   245,
+     245,   220,   218,   245,   162,     3,   131,   182,   160,   245,
+     230,     5,   238,   163,     3,   239,    21,   163,   245,    27,
+     160,   278,   279,   249,   285,   286,   287,   289,   292,   293,
+     282,    91,   115,   308,   309,   330,    83,   311,   312,   316,
+     112,   162,   326,   107,   322,   325,   172,   267,   161,   163,
+       3,   249,   163,   363,   254,   365,   365,   365,     3,   363,
+     360,   360,   360,   360,   360,   293,   249,   163,   163,   163,
+     163,   163,   163,   163,   163,   163,   163,   163,   163,   163,
+     163,   163,   163,   163,   163,   163,     3,     3,     3,   249,
+     367,   249,   367,   249,   367,   163,   252,   249,   249,   249,
+     249,   249,   257,     4,     4,   249,   264,   265,   266,   163,
+     163,   267,   133,   160,   249,    35,    82,    88,   284,   249,
+     249,   121,   371,   163,   249,   266,   168,   245,   355,   371,
+     163,   267,   188,   249,   194,    22,     3,    19,    20,    21,
+     167,   268,   163,   160,   368,    22,   249,   249,   305,    21,
+     160,   163,   184,   185,    26,   177,   205,   249,     3,   163,
+       4,   267,    21,   233,   233,   217,   134,   135,   136,   243,
+     242,   245,   233,   163,   238,   239,   160,   163,     4,   122,
+       3,    36,   290,   295,   172,   172,   160,   162,    84,   312,
+     313,   314,   317,   172,     4,   249,   327,   328,   329,   160,
+     160,   299,   337,   347,     3,   163,   254,   364,   160,   368,
+     368,   368,   163,   272,     4,   249,     4,     3,   271,   245,
+     163,   162,   162,   163,     3,     5,   163,   356,   163,   202,
+     207,   207,   207,   207,     5,   163,   163,   163,     3,   163,
+     162,   183,   247,   248,   249,   162,   234,   249,   163,   233,
+       5,   122,   274,   239,   238,   160,   166,   280,   281,   160,
+     279,   294,    37,    38,   296,   297,   172,   249,   160,    85,
+     312,   318,   172,   299,   329,     3,   163,     4,   245,   368,
+     365,   163,   163,   163,   163,   249,     4,   249,   265,     3,
+     294,   249,   249,   257,   338,   249,    22,    82,   185,   163,
+     184,    21,   274,   249,   249,   122,     3,   163,   160,   160,
+     172,   288,   163,   160,   299,   328,   329,   245,   163,   249,
+       4,   249,   163,   163,     3,     3,   202,   163,   163,   160,
+     281,   160,   288,    82,   249,   249,   249,    22,   160,     3,
+     249
 };
 
@@ -2911,22 +2859,31 @@
 /* Like YYERROR except do call yyerror.  This remains here temporarily
    to ease the transition to the new meaning of YYERROR, for GCC.
-   Once GCC version 2 has supplanted version 1, this can go.  */
+   Once GCC version 2 has supplanted version 1, this can go.  However,
+   YYFAIL appears to be in use.  Nevertheless, it is formally deprecated
+   in Bison 2.4.2's NEWS entry, where a plan to phase it out is
+   discussed.  */
 
 #define YYFAIL		goto yyerrlab
+#if defined YYFAIL
+  /* This is here to suppress warnings from the GCC cpp's
+     -Wunused-macros.  Normally we don't worry about that warning, but
+     some users do, and we want to make it easy for users to remove
+     YYFAIL uses, which will produce warnings from Bison 2.5.  */
+#endif
 
 #define YYRECOVERING()  (!!yyerrstatus)
 
-#define YYBACKUP(Token, Value)					\
-do								\
-  if (yychar == YYEMPTY && yylen == 1)				\
-    {								\
-      yychar = (Token);						\
-      yylval = (Value);						\
-      yytoken = YYTRANSLATE (yychar);				\
-      YYPOPSTACK (1);						\
-      goto yybackup;						\
-    }								\
-  else								\
-    {								\
+#define YYBACKUP(Token, Value)                                  \
+do                                                              \
+  if (yychar == YYEMPTY)                                        \
+    {                                                           \
+      yychar = (Token);                                         \
+      yylval = (Value);                                         \
+      YYPOPSTACK (yylen);                                       \
+      yystate = *yyssp;                                         \
+      goto yybackup;                                            \
+    }                                                           \
+  else                                                          \
+    {                                                           \
       yyerror (YY_("syntax error: cannot back up")); \
       YYERROR;							\
@@ -2934,53 +2891,16 @@
 while (YYID (0))
 
-
+/* Error token number */
 #define YYTERROR	1
 #define YYERRCODE	256
 
 
-/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
-   If N is 0, then set CURRENT to the empty location which ends
-   the previous symbol: RHS[0] (always defined).  */
-
-#define YYRHSLOC(Rhs, K) ((Rhs)[K])
-#ifndef YYLLOC_DEFAULT
-# define YYLLOC_DEFAULT(Current, Rhs, N)				\
-    do									\
-      if (YYID (N))                                                    \
-	{								\
-	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
-	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
-	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
-	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
-	}								\
-      else								\
-	{								\
-	  (Current).first_line   = (Current).last_line   =		\
-	    YYRHSLOC (Rhs, 0).last_line;				\
-	  (Current).first_column = (Current).last_column =		\
-	    YYRHSLOC (Rhs, 0).last_column;				\
-	}								\
-    while (YYID (0))
+/* This macro is provided for backward compatibility. */
+#ifndef YY_LOCATION_PRINT
+# define YY_LOCATION_PRINT(File, Loc) ((void) 0)
 #endif
 
 
-/* YY_LOCATION_PRINT -- Print the location on the stream.
-   This macro was not mandated originally: define only if we know
-   we won't break user code: when these are the locations we know.  */
-
-#ifndef YY_LOCATION_PRINT
-# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
-#  define YY_LOCATION_PRINT(File, Loc)			\
-     fprintf (File, "%d.%d-%d.%d",			\
-	      (Loc).first_line, (Loc).first_column,	\
-	      (Loc).last_line,  (Loc).last_column)
-# else
-#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
-# endif
-#endif
-
-
 /* YYLEX -- calling `yylex' with the right arguments.  */
-
 #ifdef YYLEX_PARAM
 # define YYLEX yylex (YYLEX_PARAM)
@@ -3032,4 +2952,6 @@
 #endif
 {
+  FILE *yyo = yyoutput;
+  YYUSE (yyo);
   if (!yyvaluep)
     return;
@@ -3043,5 +2965,5 @@
     {
       default:
-	break;
+        break;
     }
 }
@@ -3081,15 +3003,18 @@
      || defined __cplusplus || defined _MSC_VER)
 static void
-yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
+yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop)
 #else
 static void
-yy_stack_print (bottom, top)
-    yytype_int16 *bottom;
-    yytype_int16 *top;
+yy_stack_print (yybottom, yytop)
+    yytype_int16 *yybottom;
+    yytype_int16 *yytop;
 #endif
 {
   YYFPRINTF (stderr, "Stack now");
-  for (; bottom <= top; ++bottom)
-    YYFPRINTF (stderr, " %d", *bottom);
+  for (; yybottom <= yytop; yybottom++)
+    {
+      int yybot = *yybottom;
+      YYFPRINTF (stderr, " %d", yybot);
+    }
   YYFPRINTF (stderr, "\n");
 }
@@ -3125,9 +3050,9 @@
   for (yyi = 0; yyi < yynrhs; yyi++)
     {
-      fprintf (stderr, "   $%d = ", yyi + 1);
+      YYFPRINTF (stderr, "   $%d = ", yyi + 1);
       yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
 		       &(yyvsp[(yyi + 1) - (yynrhs)])
 		       		       );
-      fprintf (stderr, "\n");
+      YYFPRINTF (stderr, "\n");
     }
 }
@@ -3165,6 +3090,4 @@
 # define YYMAXDEPTH 10000
 #endif
-
-
 
 
@@ -3270,114 +3193,143 @@
 # endif
 
-/* Copy into YYRESULT an error message about the unexpected token
-   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
-   including the terminating null byte.  If YYRESULT is null, do not
-   copy anything; just return the number of bytes that would be
-   copied.  As a special case, return 0 if an ordinary "syntax error"
-   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
-   size calculation.  */
-static YYSIZE_T
-yysyntax_error (char *yyresult, int yystate, int yychar)
+/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message
+   about the unexpected token YYTOKEN for the state stack whose top is
+   YYSSP.
+
+   Return 0 if *YYMSG was successfully written.  Return 1 if *YYMSG is
+   not large enough to hold the message.  In that case, also set
+   *YYMSG_ALLOC to the required number of bytes.  Return 2 if the
+   required number of bytes is too large to store.  */
+static int
+yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg,
+                yytype_int16 *yyssp, int yytoken)
 {
-  int yyn = yypact[yystate];
-
-  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
-    return 0;
-  else
+  YYSIZE_T yysize0 = yytnamerr (YY_NULL, yytname[yytoken]);
+  YYSIZE_T yysize = yysize0;
+  enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+  /* Internationalized format string. */
+  const char *yyformat = YY_NULL;
+  /* Arguments of yyformat. */
+  char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+  /* Number of reported tokens (one for the "unexpected", one per
+     "expected"). */
+  int yycount = 0;
+
+  /* There are many possibilities here to consider:
+     - Assume YYFAIL is not used.  It's too flawed to consider.  See
+       <http://lists.gnu.org/archive/html/bison-patches/2009-12/msg00024.html>
+       for details.  YYERROR is fine as it does not invoke this
+       function.
+     - If this state is a consistent state with a default action, then
+       the only way this function was invoked is if the default action
+       is an error action.  In that case, don't check for expected
+       tokens because there are none.
+     - The only way there can be no lookahead present (in yychar) is if
+       this state is a consistent state with a default action.  Thus,
+       detecting the absence of a lookahead is sufficient to determine
+       that there is no unexpected or expected token to report.  In that
+       case, just report a simple "syntax error".
+     - Don't assume there isn't a lookahead just because this state is a
+       consistent state with a default action.  There might have been a
+       previous inconsistent state, consistent state with a non-default
+       action, or user semantic action that manipulated yychar.
+     - Of course, the expected token list depends on states to have
+       correct lookahead information, and it depends on the parser not
+       to perform extra reductions after fetching a lookahead from the
+       scanner and before detecting a syntax error.  Thus, state merging
+       (from LALR or IELR) and default reductions corrupt the expected
+       token list.  However, the list is correct for canonical LR with
+       one exception: it will still contain any token that will not be
+       accepted due to an error action in a later state.
+  */
+  if (yytoken != YYEMPTY)
     {
-      int yytype = YYTRANSLATE (yychar);
-      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
-      YYSIZE_T yysize = yysize0;
-      YYSIZE_T yysize1;
-      int yysize_overflow = 0;
-      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
-      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
-      int yyx;
-
-# if 0
-      /* This is so xgettext sees the translatable formats that are
-	 constructed on the fly.  */
-      YY_("syntax error, unexpected %s");
-      YY_("syntax error, unexpected %s, expecting %s");
-      YY_("syntax error, unexpected %s, expecting %s or %s");
-      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
-      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
-# endif
-      char *yyfmt;
-      char const *yyf;
-      static char const yyunexpected[] = "syntax error, unexpected %s";
-      static char const yyexpecting[] = ", expecting %s";
-      static char const yyor[] = " or %s";
-      char yyformat[sizeof yyunexpected
-		    + sizeof yyexpecting - 1
-		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
-		       * (sizeof yyor - 1))];
-      char const *yyprefix = yyexpecting;
-
-      /* Start YYX at -YYN if negative to avoid negative indexes in
-	 YYCHECK.  */
-      int yyxbegin = yyn < 0 ? -yyn : 0;
-
-      /* Stay within bounds of both yycheck and yytname.  */
-      int yychecklim = YYLAST - yyn + 1;
-      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
-      int yycount = 1;
-
-      yyarg[0] = yytname[yytype];
-      yyfmt = yystpcpy (yyformat, yyunexpected);
-
-      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
-	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
-	  {
-	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
-	      {
-		yycount = 1;
-		yysize = yysize0;
-		yyformat[sizeof yyunexpected - 1] = '\0';
-		break;
-	      }
-	    yyarg[yycount++] = yytname[yyx];
-	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
-	    yysize_overflow |= (yysize1 < yysize);
-	    yysize = yysize1;
-	    yyfmt = yystpcpy (yyfmt, yyprefix);
-	    yyprefix = yyor;
-	  }
-
-      yyf = YY_(yyformat);
-      yysize1 = yysize + yystrlen (yyf);
-      yysize_overflow |= (yysize1 < yysize);
-      yysize = yysize1;
-
-      if (yysize_overflow)
-	return YYSIZE_MAXIMUM;
-
-      if (yyresult)
-	{
-	  /* Avoid sprintf, as that infringes on the user's name space.
-	     Don't have undefined behavior even if the translation
-	     produced a string with the wrong number of "%s"s.  */
-	  char *yyp = yyresult;
-	  int yyi = 0;
-	  while ((*yyp = *yyf) != '\0')
-	    {
-	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
-		{
-		  yyp += yytnamerr (yyp, yyarg[yyi++]);
-		  yyf += 2;
-		}
-	      else
-		{
-		  yyp++;
-		  yyf++;
-		}
-	    }
-	}
-      return yysize;
+      int yyn = yypact[*yyssp];
+      yyarg[yycount++] = yytname[yytoken];
+      if (!yypact_value_is_default (yyn))
+        {
+          /* Start YYX at -YYN if negative to avoid negative indexes in
+             YYCHECK.  In other words, skip the first -YYN actions for
+             this state because they are default actions.  */
+          int yyxbegin = yyn < 0 ? -yyn : 0;
+          /* Stay within bounds of both yycheck and yytname.  */
+          int yychecklim = YYLAST - yyn + 1;
+          int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+          int yyx;
+
+          for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+            if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR
+                && !yytable_value_is_error (yytable[yyx + yyn]))
+              {
+                if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+                  {
+                    yycount = 1;
+                    yysize = yysize0;
+                    break;
+                  }
+                yyarg[yycount++] = yytname[yyx];
+                {
+                  YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULL, yytname[yyx]);
+                  if (! (yysize <= yysize1
+                         && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
+                    return 2;
+                  yysize = yysize1;
+                }
+              }
+        }
     }
+
+  switch (yycount)
+    {
+# define YYCASE_(N, S)                      \
+      case N:                               \
+        yyformat = S;                       \
+      break
+      YYCASE_(0, YY_("syntax error"));
+      YYCASE_(1, YY_("syntax error, unexpected %s"));
+      YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s"));
+      YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s"));
+      YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s"));
+      YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"));
+# undef YYCASE_
+    }
+
+  {
+    YYSIZE_T yysize1 = yysize + yystrlen (yyformat);
+    if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
+      return 2;
+    yysize = yysize1;
+  }
+
+  if (*yymsg_alloc < yysize)
+    {
+      *yymsg_alloc = 2 * yysize;
+      if (! (yysize <= *yymsg_alloc
+             && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM))
+        *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM;
+      return 1;
+    }
+
+  /* Avoid sprintf, as that infringes on the user's name space.
+     Don't have undefined behavior even if the translation
+     produced a string with the wrong number of "%s"s.  */
+  {
+    char *yyp = *yymsg;
+    int yyi = 0;
+    while ((*yyp = *yyformat) != '\0')
+      if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount)
+        {
+          yyp += yytnamerr (yyp, yyarg[yyi++]);
+          yyformat += 2;
+        }
+      else
+        {
+          yyp++;
+          yyformat++;
+        }
+  }
+  return 0;
 }
 #endif /* YYERROR_VERBOSE */
-
-
 
 /*-----------------------------------------------.
@@ -3408,5 +3360,5 @@
 
       default:
-	break;
+        break;
     }
 }
@@ -3414,31 +3366,22 @@
 
 
-/* Prevent warnings from -Wmissing-prototypes.  */
-
-#ifdef YYPARSE_PARAM
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void *YYPARSE_PARAM);
-#else
-int yyparse ();
+
+/* The lookahead symbol.  */
+int yychar;
+
+
+#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+# define YY_IGNORE_MAYBE_UNINITIALIZED_END
 #endif
-#else /* ! YYPARSE_PARAM */
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void);
-#else
-int yyparse ();
+#ifndef YY_INITIAL_VALUE
+# define YY_INITIAL_VALUE(Value) /* Nothing. */
 #endif
-#endif /* ! YYPARSE_PARAM */
-
-
-
-/* The look-ahead symbol.  */
-int yychar;
-
-/* The semantic value of the look-ahead symbol.  */
-YYSTYPE yylval;
+
+/* The semantic value of the lookahead symbol.  */
+YYSTYPE yylval YY_INITIAL_VALUE(yyval_default);
 
 /* Number of syntax errors so far.  */
 int yynerrs;
-
 
 
@@ -3469,12 +3412,35 @@
 #endif
 {
-  
-  int yystate;
+    int yystate;
+    /* Number of tokens to shift before error messages enabled.  */
+    int yyerrstatus;
+
+    /* The stacks and their tools:
+       `yyss': related to states.
+       `yyvs': related to semantic values.
+
+       Refer to the stacks through separate pointers, to allow yyoverflow
+       to reallocate them elsewhere.  */
+
+    /* The state stack.  */
+    yytype_int16 yyssa[YYINITDEPTH];
+    yytype_int16 *yyss;
+    yytype_int16 *yyssp;
+
+    /* The semantic value stack.  */
+    YYSTYPE yyvsa[YYINITDEPTH];
+    YYSTYPE *yyvs;
+    YYSTYPE *yyvsp;
+
+    YYSIZE_T yystacksize;
+
   int yyn;
   int yyresult;
-  /* Number of tokens to shift before error messages enabled.  */
-  int yyerrstatus;
-  /* Look-ahead token as an internal (translated) token number.  */
+  /* Lookahead token as an internal (translated) token number.  */
   int yytoken = 0;
+  /* The variables used to return semantic value and location from the
+     action routines.  */
+  YYSTYPE yyval;
+
 #if YYERROR_VERBOSE
   /* Buffer for error messages, and its allocated size.  */
@@ -3484,32 +3450,5 @@
 #endif
 
-  /* Three stacks and their tools:
-     `yyss': related to states,
-     `yyvs': related to semantic values,
-     `yyls': related to locations.
-
-     Refer to the stacks thru separate pointers, to allow yyoverflow
-     to reallocate them elsewhere.  */
-
-  /* The state stack.  */
-  yytype_int16 yyssa[YYINITDEPTH];
-  yytype_int16 *yyss = yyssa;
-  yytype_int16 *yyssp;
-
-  /* The semantic value stack.  */
-  YYSTYPE yyvsa[YYINITDEPTH];
-  YYSTYPE *yyvs = yyvsa;
-  YYSTYPE *yyvsp;
-
-
-
 #define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N))
-
-  YYSIZE_T yystacksize = YYINITDEPTH;
-
-  /* The variables used to return semantic value and location from the
-     action routines.  */
-  YYSTYPE yyval;
-
 
   /* The number of symbols on the RHS of the reduced rule.
@@ -3517,4 +3456,8 @@
   int yylen = 0;
 
+  yyssp = yyss = yyssa;
+  yyvsp = yyvs = yyvsa;
+  yystacksize = YYINITDEPTH;
+
   YYDPRINTF ((stderr, "Starting parse\n"));
 
@@ -3522,14 +3465,5 @@
   yyerrstatus = 0;
   yynerrs = 0;
-  yychar = YYEMPTY;		/* Cause a token to be read.  */
-
-  /* Initialize stack pointers.
-     Waste one element of value and location stack
-     so that they stay on the same level as the state stack.
-     The wasted elements are never initialized.  */
-
-  yyssp = yyss;
-  yyvsp = yyvs;
-
+  yychar = YYEMPTY; /* Cause a token to be read.  */
   goto yysetstate;
 
@@ -3558,5 +3492,4 @@
 	yytype_int16 *yyss1 = yyss;
 
-
 	/* Each stack pointer address is followed by the size of the
 	   data in use in that stack, in bytes.  This used to be a
@@ -3566,5 +3499,4 @@
 		    &yyss1, yysize * sizeof (*yyssp),
 		    &yyvs1, yysize * sizeof (*yyvsp),
-
 		    &yystacksize);
 
@@ -3589,7 +3521,6 @@
 	if (! yyptr)
 	  goto yyexhaustedlab;
-	YYSTACK_RELOCATE (yyss);
-	YYSTACK_RELOCATE (yyvs);
-
+	YYSTACK_RELOCATE (yyss_alloc, yyss);
+	YYSTACK_RELOCATE (yyvs_alloc, yyvs);
 #  undef YYSTACK_RELOCATE
 	if (yyss1 != yyssa)
@@ -3602,5 +3533,4 @@
       yyvsp = yyvs + yysize - 1;
 
-
       YYDPRINTF ((stderr, "Stack size increased to %lu\n",
 		  (unsigned long int) yystacksize));
@@ -3611,4 +3541,7 @@
 
   YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+  if (yystate == YYFINAL)
+    YYACCEPT;
 
   goto yybackup;
@@ -3620,14 +3553,14 @@
 
   /* Do appropriate processing given the current state.  Read a
-     look-ahead token if we need one and don't already have one.  */
-
-  /* First try to decide what to do without reference to look-ahead token.  */
+     lookahead token if we need one and don't already have one.  */
+
+  /* First try to decide what to do without reference to lookahead token.  */
   yyn = yypact[yystate];
-  if (yyn == YYPACT_NINF)
+  if (yypact_value_is_default (yyn))
     goto yydefault;
 
-  /* Not known => get a look-ahead token if don't already have one.  */
-
-  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
+  /* Not known => get a lookahead token if don't already have one.  */
+
+  /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
   if (yychar == YYEMPTY)
     {
@@ -3655,12 +3588,9 @@
   if (yyn <= 0)
     {
-      if (yyn == 0 || yyn == YYTABLE_NINF)
-	goto yyerrlab;
+      if (yytable_value_is_error (yyn))
+        goto yyerrlab;
       yyn = -yyn;
       goto yyreduce;
     }
-
-  if (yyn == YYFINAL)
-    YYACCEPT;
 
   /* Count tokens shifted since error; after three, turn off error
@@ -3669,13 +3599,14 @@
     yyerrstatus--;
 
-  /* Shift the look-ahead token.  */
+  /* Shift the lookahead token.  */
   YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
 
-  /* Discard the shifted token unless it is eof.  */
-  if (yychar != YYEOF)
-    yychar = YYEMPTY;
+  /* Discard the shifted token.  */
+  yychar = YYEMPTY;
 
   yystate = yyn;
+  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
   *++yyvsp = yylval;
+  YY_IGNORE_MAYBE_UNINITIALIZED_END
 
   goto yynewstate;
@@ -3713,2816 +3644,2480 @@
   switch (yyn)
     {
-        case 8:
-#line 344 "fortran.y"
-    {yyerrok;yyclearin;;}
-    break;
-
-  case 13:
-#line 352 "fortran.y"
+        case 7:
+/* Line 1807 of yacc.c  */
+#line 319 "fortran.y"
+    {yyerrok;yyclearin;}
+    break;
+
+  case 18:
+/* Line 1807 of yacc.c  */
+#line 337 "fortran.y"
     {
-                     if (inmoduledeclare == 0 )
-                     {
-                        pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_curinclude,
-                                              pos_end-pos_curinclude);
-                     }
-                  ;}
-    break;
-
-  case 18:
-#line 368 "fortran.y"
+            if (inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
+            }
+        }
+    break;
+
+  case 20:
+/* Line 1807 of yacc.c  */
+#line 347 "fortran.y"
+    { pos_cur = setposcur(); }
+    break;
+
+  case 21:
+/* Line 1807 of yacc.c  */
+#line 350 "fortran.y"
+    { isrecursive = 0; }
+    break;
+
+  case 22:
+/* Line 1807 of yacc.c  */
+#line 351 "fortran.y"
+    { isrecursive = 1; }
+    break;
+
+  case 23:
+/* Line 1807 of yacc.c  */
+#line 354 "fortran.y"
+    { is_result_present = 0; }
+    break;
+
+  case 24:
+/* Line 1807 of yacc.c  */
+#line 355 "fortran.y"
+    { is_result_present = 1; }
+    break;
+
+  case 25:
+/* Line 1807 of yacc.c  */
+#line 359 "fortran.y"
     {
-            /* we should ignore the declaration until the keyword             */
-            /*    TOK_ENDDONOTTREAT                                           */
-            couldaddvariable = 0 ;
-            RemoveWordCUR_0(fortranout,-20,20);
-         ;}
-    break;
-
-  case 19:
-#line 375 "fortran.y"
+            insubroutinedeclare = 1;
+            if ( firstpass )
+                Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
+            else
+                WriteBeginof_SubLoop();
+        }
+    break;
+
+  case 26:
+/* Line 1807 of yacc.c  */
+#line 367 "fortran.y"
     {
-             couldaddvariable = 1 ;
-             RemoveWordCUR_0(fortranout,-24,24);
-          ;}
-    break;
-
-  case 22:
-#line 382 "fortran.y"
-    {pos_cur = setposcur();;}
+            insubroutinedeclare = 1;
+            inprogramdeclare = 1;
+            /* in the second step we should write the head of       */
+            /*    the subroutine sub_loop_<subroutinename>          */
+            if ( ! firstpass )
+                WriteBeginof_SubLoop();
+        }
     break;
 
   case 27:
-#line 394 "fortran.y"
-    {if (incom !=1) {strcpy(curbuf,"");incom=0;};}
+/* Line 1807 of yacc.c  */
+#line 376 "fortran.y"
+    {
+            insubroutinedeclare = 1;
+            strcpy(DeclType, "");
+            /* we should to list of the subroutine argument the  */
+            /*    name of the function which has to be defined   */
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1((yyvsp[(4) - (5)].l));
+                if ( ! is_result_present )
+                    Add_FunctionType_Var_1((yyvsp[(3) - (5)].na));
+            }
+            else
+            /* in the second step we should write the head of    */
+            /*    the subroutine sub_loop_<subroutinename>       */
+                WriteBeginof_SubLoop();
+        }
     break;
 
   case 28:
-#line 397 "fortran.y"
-    {isrecursive = 0;;}
-    break;
-
-  case 29:
-#line 399 "fortran.y"
-    {isrecursive = 1;;}
+/* Line 1807 of yacc.c  */
+#line 393 "fortran.y"
+    {
+            GlobalDeclaration = 0;
+            strcpy(curmodulename,(yyvsp[(2) - (2)].na));
+            strcpy(subroutinename,"");
+            Add_NameOfModule_1((yyvsp[(2) - (2)].na));
+            if ( inmoduledeclare == 0 )
+            {
+                /* To know if there are in the module declaration    */
+                inmoduledeclare = 1;
+                /* to know if a module has been met                  */
+                inmodulemeet = 1;
+                /* to know if we are after the keyword contains      */
+                aftercontainsdeclare = 0 ;
+            }
+        }
     break;
 
   case 31:
-#line 403 "fortran.y"
+/* Line 1807 of yacc.c  */
+#line 415 "fortran.y"
+    { strcpy((yyval.na), (yyvsp[(1) - (1)].na)); strcpy(subroutinename, (yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 32:
+/* Line 1807 of yacc.c  */
+#line 417 "fortran.y"
+    { Add_Include_1((yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 33:
+/* Line 1807 of yacc.c  */
+#line 419 "fortran.y"
+    { if ( firstpass ) (yyval.l)=NULL; }
+    break;
+
+  case 34:
+/* Line 1807 of yacc.c  */
+#line 420 "fortran.y"
+    { if ( firstpass ) (yyval.l)=NULL; }
+    break;
+
+  case 35:
+/* Line 1807 of yacc.c  */
+#line 421 "fortran.y"
+    { if ( firstpass ) (yyval.l)=(yyvsp[(2) - (3)].l); }
+    break;
+
+  case 38:
+/* Line 1807 of yacc.c  */
+#line 425 "fortran.y"
+    { if ( firstpass ) Add_SubroutineArgument_Var_1((yyvsp[(2) - (3)].l)); }
+    break;
+
+  case 39:
+/* Line 1807 of yacc.c  */
+#line 428 "fortran.y"
     {
-                      if ( couldaddvariable == 1)
-                      {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (4)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-
-                      }
-                      Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(1);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            writeheadnewsub_0(1);
-                      }
-                      }
-                   ;}
-    break;
-
-  case 32:
-#line 431 "fortran.y"
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar((yyvsp[(1) - (1)].na),NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                curlistvar = insertvar(NULL,curvar);
+                (yyval.l) = settype("",curlistvar);
+            }
+        }
+    break;
+
+  case 40:
+/* Line 1807 of yacc.c  */
+#line 440 "fortran.y"
     {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(2) - (2)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-
-                      }
-                      strcpy(subroutinename,(yyvsp[(2) - (2)].nac));
-                      /* Common case                                          */
-                      insubroutinedeclare = 1;
-                      /* in the second step we should write the head of       */
-                      /*    the subroutine sub_loop_<subroutinename>          */
-                      writeheadnewsub_0(1);
-                   ;}
-    break;
-
-  case 33:
-#line 449 "fortran.y"
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar((yyvsp[(3) - (3)].na),NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                (yyval.l) = insertvar((yyvsp[(1) - (3)].l),curvar);
+            }
+        }
+    break;
+
+  case 41:
+/* Line 1807 of yacc.c  */
+#line 451 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));  }
+    break;
+
+  case 42:
+/* Line 1807 of yacc.c  */
+#line 452 "fortran.y"
+    { strcpy((yyval.na),"*"); }
+    break;
+
+  case 44:
+/* Line 1807 of yacc.c  */
+#line 455 "fortran.y"
+    { inside_type_declare = 1; }
+    break;
+
+  case 45:
+/* Line 1807 of yacc.c  */
+#line 456 "fortran.y"
+    { inside_type_declare = 0; }
+    break;
+
+  case 47:
+/* Line 1807 of yacc.c  */
+#line 459 "fortran.y"
     {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (6)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,(yyvsp[(3) - (6)].nac));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(4) - (6)].l));
-                         strcpy(DeclType,"");
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            /* we should to list of the subroutine argument   */
-                            /* name of the function which has to be defined   */
-                            Add_SubroutineArgument_Var_1((yyvsp[(4) - (6)].l));
-                            strcpy(DeclType,"");
-                            Add_FunctionType_Var_1((yyvsp[(3) - (6)].nac));
-                            writeheadnewsub_0(2);
-                      }
-                   ;}
-    break;
-
-  case 34:
-#line 482 "fortran.y"
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1((yyvsp[(3) - (4)].l));
+                    else                        Add_GlobalParameter_Var_1((yyvsp[(3) - (4)].l));
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out, pos_cur_decl, pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+    break;
+
+  case 48:
+/* Line 1807 of yacc.c  */
+#line 476 "fortran.y"
     {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (4)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,(yyvsp[(3) - (4)].nac));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
-                         strcpy(DeclType,"");
-                         Add_FunctionType_Var_1((yyvsp[(3) - (4)].nac));
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            /* we should to list of the subroutine argument   */
-                            /* name of the function which has to be defined   */
-                            Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
-                            strcpy(DeclType,"");
-                            Add_FunctionType_Var_1((yyvsp[(3) - (4)].nac));
-                            writeheadnewsub_0(2);
-                      }
-                   ;}
-    break;
-
-  case 35:
-#line 516 "fortran.y"
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1((yyvsp[(2) - (2)].l));
+                    else                        Add_GlobalParameter_Var_1((yyvsp[(2) - (2)].l));
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+    break;
+
+  case 50:
+/* Line 1807 of yacc.c  */
+#line 494 "fortran.y"
     {
-                      GlobalDeclaration = 0;
-                      strcpy(curmodulename,(yyvsp[(2) - (2)].nac));
-                      strcpy(subroutinename,"");
-                      Add_NameOfModule_1((yyvsp[(2) - (2)].nac));
-                      if ( inmoduledeclare == 0 )
-                      {
-                         /* To know if there are in the module declaration    */
-                         inmoduledeclare = 1;
-                         /* to know if a module has been met                  */
-                         inmodulemeet = 1;
-                         /* to know if we are after the keyword contains      */
-                         aftercontainsdeclare = 0 ;
-                      }
-                   ;}
-    break;
-
-  case 36:
-#line 533 "fortran.y"
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave);
+        }
+    break;
+
+  case 52:
+/* Line 1807 of yacc.c  */
+#line 500 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));strcpy(subroutinename,(yyvsp[(1) - (1)].nac));
-                      }
-                   ;}
-    break;
-
-  case 38:
-#line 542 "fortran.y"
+            /* if the variable is a parameter we can suppose that is   */
+            /*    value is the same on each grid. It is not useless to */
+            /*    create a copy of it on each grid                     */
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    Add_Globliste_1((yyvsp[(1) - (1)].l));
+                    /* if variableparamlists has been declared in a subroutine   */
+                    if ( insubroutinedeclare )     Add_Dimension_Var_1((yyvsp[(1) - (1)].l));
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension);
+                }
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+        }
+    break;
+
+  case 53:
+/* Line 1807 of yacc.c  */
+#line 537 "fortran.y"
     {
-                      pos_curinclude = setposcur()-9;
-                   ;}
-    break;
-
-  case 39:
-#line 546 "fortran.y"
+            if (firstpass == 0)
+            {
+                if ((yyvsp[(1) - (1)].lnn))
+                {
+                    removeglobfromlist(&((yyvsp[(1) - (1)].lnn)));
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur);
+                    writelistpublic((yyvsp[(1) - (1)].lnn));
+                }
+            }
+        }
+    break;
+
+  case 62:
+/* Line 1807 of yacc.c  */
+#line 558 "fortran.y"
     {
-                      if ( couldaddvariable == 1 ) Add_Include_1((yyvsp[(1) - (1)].nac));
-                   ;}
-    break;
-
-  case 40:
-#line 550 "fortran.y"
+            /* we should remove the data declaration                */
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata);
+
+            if ( aftercontainsdeclare == 1  && firstpass == 0 )
+            {
+                ReWriteDataStatement_0(fortran_out);
+                pos_end = setposcur();
+            }
+        }
+    break;
+
+  case 64:
+/* Line 1807 of yacc.c  */
+#line 572 "fortran.y"
     {
-                      if ( firstpass == 1 && couldaddvariable == 1) (yyval.l)=NULL;
-                   ;}
-    break;
-
-  case 41:
-#line 553 "fortran.y"
+            PublicDeclare = 0 ;
+            PrivateDeclare = 0 ;
+        }
+    break;
+
+  case 102:
+/* Line 1807 of yacc.c  */
+#line 630 "fortran.y"
     {
-                      if ( firstpass == 1 && couldaddvariable == 1 ) (yyval.l)=NULL;
-                   ;}
-    break;
-
-  case 42:
-#line 557 "fortran.y"
+            /* if the variable is a parameter we can suppose that is*/
+            /*    value is the same on each grid. It is not useless */
+            /*    to create a copy of it on each grid               */
+            if ( ! inside_type_declare )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                ReWriteDeclarationAndAddTosubroutine_01((yyvsp[(1) - (2)].l));
+                pos_cur_decl = setposcur();
+                if ( firstpass == 0 && GlobalDeclaration == 0
+                                    && insubroutinedeclare == 0 )
+                {
+                    fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename);
+                    sprintf(ligne, "Module_Declar_%s.h", curmodulename);
+                    module_declar = open_for_write(ligne);
+                    GlobalDeclaration = 1 ;
+                    pos_cur_decl = setposcur();
+                }
+                (yyval.l) = (yyvsp[(1) - (2)].l);
+
+                if ( firstpass )
+                {
+                    Add_Globliste_1((yyvsp[(1) - (2)].l));
+                    if ( insubroutinedeclare )
+                    {
+                        if ( pointerdeclare ) Add_Pointer_Var_From_List_1((yyvsp[(1) - (2)].l));
+                        Add_Parameter_Var_1((yyvsp[(1) - (2)].l));
+                    }
+                    else
+                        Add_GlobalParameter_Var_1((yyvsp[(1) - (2)].l));
+
+                    /* If there's a SAVE declaration in module's subroutines we should    */
+                    /*    remove it from the subroutines declaration and add it in the    */
+                    /*    global declarations                                             */
+                    if ( aftercontainsdeclare && SaveDeclare )
+                    {
+                        if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1((yyvsp[(1) - (2)].l));
+                        else                Add_Save_Var_dcl_1((yyvsp[(1) - (2)].l));
+                    }
+                }
+            }
+            else
+            {
+                (yyval.l) = (listvar *) NULL;
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+            GlobalDeclarationType = 0;
+        }
+    break;
+
+  case 103:
+/* Line 1807 of yacc.c  */
+#line 696 "fortran.y"
     {
-                       if ( firstpass == 1 && couldaddvariable == 1 ) (yyval.l)=(yyvsp[(2) - (3)].l);
-                   ;}
-    break;
-
-  case 45:
-#line 564 "fortran.y"
+            insubroutinedeclare = 1;
+
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
+                Add_FunctionType_Var_1((yyvsp[(2) - (3)].na));
+            }
+            else
+                WriteBeginof_SubLoop();
+
+            strcpy(nameinttypename,"");
+        }
+    break;
+
+  case 104:
+/* Line 1807 of yacc.c  */
+#line 710 "fortran.y"
+    { functiondeclarationisdone = 1; }
+    break;
+
+  case 105:
+/* Line 1807 of yacc.c  */
+#line 712 "fortran.y"
+    { VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
+    break;
+
+  case 109:
+/* Line 1807 of yacc.c  */
+#line 724 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         Add_SubroutineArgument_Var_1((yyvsp[(2) - (3)].l));
-                      }
-                   ;}
-    break;
-
-  case 46:
-#line 571 "fortran.y"
+            createstringfromlistname(ligne,(yyvsp[(3) - (4)].lnn));
+            if (firstpass == 1) Add_Data_Var_1(&List_Data_Var,(yyvsp[(1) - (4)].na),ligne);
+            else                Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(1) - (4)].na),ligne);
+        }
+    break;
+
+  case 110:
+/* Line 1807 of yacc.c  */
+#line 730 "fortran.y"
     {
-                      if ( firstpass == 1  && couldaddvariable == 1)
-                      {
-                         strcpy(nameinttypenameback,nameinttypename);
-                         strcpy(nameinttypename,"");
-                         curvar=createvar((yyvsp[(1) - (1)].na),NULL);
-                        strcpy(nameinttypename,nameinttypenameback);
-                         curlistvar=insertvar(NULL,curvar);
-                         (yyval.l)=settype("",curlistvar);
-                      }
-                   ;}
-    break;
-
-  case 47:
-#line 583 "fortran.y"
+            if (firstpass == 1)  Add_Data_Var_Names_01(&List_Data_Var,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
+            else                 Add_Data_Var_Names_01(&List_Data_Var_Cur,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
+        }
+    break;
+
+  case 111:
+/* Line 1807 of yacc.c  */
+#line 735 "fortran.y"
     {
-                      if ( firstpass == 1  && couldaddvariable == 1)
-                      {
-                         strcpy(nameinttypenameback,nameinttypename);
-                         strcpy(nameinttypename,"");                      
-                         curvar=createvar((yyvsp[(3) - (3)].na),NULL);
-                         strcpy(nameinttypename,nameinttypenameback);                         
-                         (yyval.l)=insertvar((yyvsp[(1) - (3)].l),curvar);
-                      }
-                   ;}
-    break;
-
-  case 48:
-#line 594 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 49:
-#line 595 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),"*");;}
-    break;
-
-  case 50:
-#line 598 "fortran.y"
+            createstringfromlistname(ligne,(yyvsp[(7) - (8)].lnn));
+            printf("###################################################################################################################\n");
+            printf("## CONV Error : data_implied_do statements (R537) are not yet supported. Please complain to the proper authorities.\n");
+            printf("l.%4d -- data_stmt_set : ( lhs , dospec ) /data_stmt_value_list/ -- lhs=|%s| dospec=|%s| data_stmt_value_list=|%s|\n",
+                line_num_input,(yyvsp[(2) - (8)].na),(yyvsp[(4) - (8)].na),ligne);
+            printf("## But, are you SURE you NEED a DATA construct ?\n");
+            printf("###################################################################################################################\n");
+            exit(1);
+        }
+    break;
+
+  case 112:
+/* Line 1807 of yacc.c  */
+#line 748 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 113:
+/* Line 1807 of yacc.c  */
+#line 749 "fortran.y"
+    { (yyval.lnn) = Insertname((yyvsp[(3) - (3)].lnn),(yyvsp[(1) - (3)].na),1);   }
+    break;
+
+  case 118:
+/* Line 1807 of yacc.c  */
+#line 758 "fortran.y"
+    { pos_cursave = setposcur()-4; }
+    break;
+
+  case 120:
+/* Line 1807 of yacc.c  */
+#line 761 "fortran.y"
+    { if ( ! inside_type_declare ) Add_Save_Var_1((yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].d)); }
+    break;
+
+  case 121:
+/* Line 1807 of yacc.c  */
+#line 764 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 122:
+/* Line 1807 of yacc.c  */
+#line 765 "fortran.y"
+    { printf("l.%4d -- INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n",line_num_input); exit(0); }
+    break;
+
+  case 123:
+/* Line 1807 of yacc.c  */
+#line 766 "fortran.y"
+    { (yyval.lnn) = concat_listname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].lnn)); }
+    break;
+
+  case 124:
+/* Line 1807 of yacc.c  */
+#line 769 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));  }
+    break;
+
+  case 125:
+/* Line 1807 of yacc.c  */
+#line 770 "fortran.y"
+    { sprintf((yyval.na),"%s+%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 126:
+/* Line 1807 of yacc.c  */
+#line 771 "fortran.y"
+    { sprintf((yyval.na),"%s-%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 127:
+/* Line 1807 of yacc.c  */
+#line 772 "fortran.y"
+    { sprintf((yyval.na),"%s*%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 128:
+/* Line 1807 of yacc.c  */
+#line 773 "fortran.y"
+    { sprintf((yyval.na),"%s/%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 129:
+/* Line 1807 of yacc.c  */
+#line 775 "fortran.y"
+    { strcpy((yyval.na),""); }
+    break;
+
+  case 130:
+/* Line 1807 of yacc.c  */
+#line 776 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 135:
+/* Line 1807 of yacc.c  */
+#line 786 "fortran.y"
     {
-                      if ( VarTypepar == 1 )
-                      {
-                         couldaddvariable = 1 ;
-                         VarTypepar = 0;
-                      }
-                   ;}
-    break;
-
-  case 51:
-#line 606 "fortran.y"
+            positioninblock = 0;
+            pos_curdimension = setposcur()-9;
+        }
+    break;
+
+  case 136:
+/* Line 1807 of yacc.c  */
+#line 793 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         VarType = 1;
-                         couldaddvariable = 0 ;
-                      }
-                   ;}
-    break;
-
-  case 52:
-#line 614 "fortran.y"
+            printf("l.%4d -- dimension : before_dimension opt_comma TOK_NAME = |%s| -- MHCHECK\n",line_num_input,(yyvsp[(3) - (5)].na));
+            if ( inside_type_declare ) break;
+            curvar = createvar((yyvsp[(3) - (5)].na),(yyvsp[(4) - (5)].d));
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar=insertvar(NULL, curvar);
+            (yyval.l) = settype("",curlistvar);
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 137:
+/* Line 1807 of yacc.c  */
+#line 803 "fortran.y"
     {
-                      if ( VarType == 1 ) couldaddvariable = 1 ;
-                      VarType = 0;
-                      VarTypepar = 0;
-                   ;}
-    break;
-
-  case 54:
-#line 621 "fortran.y"
+            printf("l.%4d -- dimension : dimension ',' TOK_NAME dims lengspec = |%s| -- MHCHECK\n",line_num_input,(yyvsp[(3) - (5)].na));
+            if ( inside_type_declare ) break;
+            curvar = createvar((yyvsp[(3) - (5)].na),(yyvsp[(4) - (5)].d));
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar = insertvar((yyvsp[(1) - (5)].l), curvar);
+            (yyval.l) = curlistvar;
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 140:
+/* Line 1807 of yacc.c  */
+#line 818 "fortran.y"
+    { (yyval.lnn) = (listname *) NULL; }
+    break;
+
+  case 141:
+/* Line 1807 of yacc.c  */
+#line 819 "fortran.y"
+    { (yyval.lnn) = (yyvsp[(3) - (3)].lnn); }
+    break;
+
+  case 142:
+/* Line 1807 of yacc.c  */
+#line 822 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 143:
+/* Line 1807 of yacc.c  */
+#line 823 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 144:
+/* Line 1807 of yacc.c  */
+#line 824 "fortran.y"
+    { (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].na),0);   }
+    break;
+
+  case 145:
+/* Line 1807 of yacc.c  */
+#line 825 "fortran.y"
+    { (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].na),0);   }
+    break;
+
+  case 146:
+/* Line 1807 of yacc.c  */
+#line 829 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         if ( insubroutinedeclare == 0 )
-                         {
-                                                  Add_GlobalParameter_Var_1((yyvsp[(3) - (4)].l));
-                                                  }
-                         else Add_Parameter_Var_1((yyvsp[(3) - (4)].l));
-                         pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                    pos_end-pos_cur_decl);
-                      }
-                      VariableIsParameter =  0 ;
-                   ;}
-    break;
-
-  case 55:
-#line 636 "fortran.y"
+            if ( inside_type_declare ) break;
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+    break;
+
+  case 147:
+/* Line 1807 of yacc.c  */
+#line 835 "fortran.y"
     {
-                     if ( couldaddvariable == 1 )
-                     {
-                        if ( insubroutinedeclare == 0 )
-                                                  Add_GlobalParameter_Var_1((yyvsp[(2) - (2)].l));
-                         else Add_Parameter_Var_1((yyvsp[(2) - (2)].l));
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                    pos_end-pos_cur_decl);
-                      }
-                      VariableIsParameter =  0 ;
-                   ;}
-    break;
-
-  case 57:
-#line 650 "fortran.y"
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",(yyvsp[(2) - (3)].na));
+            Add_NameOfCommon_1((yyvsp[(2) - (3)].na),subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+    break;
+
+  case 148:
+/* Line 1807 of yacc.c  */
+#line 843 "fortran.y"
     {
-                     pos_end = setposcur();
-                     RemoveWordSET_0(fortranout,pos_cursave,
-                                                pos_end-pos_cursave);
-                  ;}
-    break;
-
-  case 59:
-#line 657 "fortran.y"
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",(yyvsp[(3) - (5)].na));
+            Add_NameOfCommon_1((yyvsp[(3) - (5)].na),subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+    break;
+
+  case 149:
+/* Line 1807 of yacc.c  */
+#line 852 "fortran.y"
+    { positioninblock = 0; pos_curcommon = setposcur()-6;   }
+    break;
+
+  case 150:
+/* Line 1807 of yacc.c  */
+#line 853 "fortran.y"
+    { positioninblock = 0; pos_curcommon = setposcur()-6-7; }
+    break;
+
+  case 151:
+/* Line 1807 of yacc.c  */
+#line 856 "fortran.y"
+    { if ( ! inside_type_declare ) Add_Common_var_1(); }
+    break;
+
+  case 152:
+/* Line 1807 of yacc.c  */
+#line 857 "fortran.y"
+    { if ( ! inside_type_declare ) Add_Common_var_1(); }
+    break;
+
+  case 153:
+/* Line 1807 of yacc.c  */
+#line 861 "fortran.y"
     {
-                   /* if the variable is a parameter we can suppose that is   */
-                   /*    value is the same on each grid. It is not useless to */
-                   /*    create a copy of it on each grid                     */
-                      if ( couldaddvariable == 1 )
-                      {
-                         Add_Globliste_1((yyvsp[(1) - (1)].l));
-                         /* if variableparamlists has been declared in a      */
-                         /*    subroutine                                     */
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            Add_Dimension_Var_1((yyvsp[(1) - (1)].l));
-                         }
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curdimension,
-                                                pos_end-pos_curdimension);
-                      }
-                      /*                                                      */
-                      PublicDeclare = 0;
-                      PrivateDeclare = 0;
-                      ExternalDeclare = 0;
-                      strcpy(NamePrecision,"");
-                      c_star = 0;
-                      strcpy(InitialValueGiven," ");
-                      strcpy(IntentSpec,"");
-                      VariableIsParameter =  0 ;
-                      Allocatabledeclare = 0 ;
-                      Targetdeclare = 0 ;
-                      SaveDeclare = 0;
-                      pointerdeclare = 0;
-                      optionaldeclare = 0 ;
-                      dimsgiven=0;
-                      c_selectorgiven=0;
-                      strcpy(nameinttypename,"");
-                      strcpy(c_selectorname,"");
-                   ;}
-    break;
-
-  case 60:
-#line 694 "fortran.y"
+            positioninblock = positioninblock + 1 ;
+            strcpy(commonvar,(yyvsp[(1) - (2)].na));
+            commondim = (yyvsp[(2) - (2)].d);
+        }
+    break;
+
+  case 154:
+/* Line 1807 of yacc.c  */
+#line 869 "fortran.y"
     {
-      if (firstpass == 0)
-      {
-      if ((yyvsp[(1) - (1)].lnn))
-      {
-      removeglobfromlist(&((yyvsp[(1) - (1)].lnn)));
-      pos_end = setposcur();
-           RemoveWordSET_0(fortranout,pos_cur,pos_end-pos_cur);
-      writelistpublic((yyvsp[(1) - (1)].lnn));
-      }
-      }
-      ;}
-    break;
-
-  case 70:
-#line 716 "fortran.y"
+            strcpy((yyval.na),"");
+            positioninblock=0;
+            strcpy(commonblockname,"");
+        }
+    break;
+
+  case 155:
+/* Line 1807 of yacc.c  */
+#line 875 "fortran.y"
     {
-                      /* we should remove the data declaration                */
-                      if ( couldaddvariable == 1 && aftercontainsdeclare != 2 )
-                      {
-                        pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_curdata,
-                                              pos_end-pos_curdata);
-                      }
-                      if ( couldaddvariable == 1 && aftercontainsdeclare == 1 )
-                      {
-                      if (firstpass == 0)
-                      {
-                        ReWriteDataStatement_0(fortranout);
-                        pos_end = setposcur();
-                  }
-                      }
-                  ;}
-    break;
-
-  case 72:
-#line 736 "fortran.y"
+            strcpy((yyval.na),(yyvsp[(2) - (3)].na));
+            positioninblock=0;
+            strcpy(commonblockname,(yyvsp[(2) - (3)].na));
+        }
+    break;
+
+  case 158:
+/* Line 1807 of yacc.c  */
+#line 885 "fortran.y"
+    { (yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v)); }
+    break;
+
+  case 159:
+/* Line 1807 of yacc.c  */
+#line 886 "fortran.y"
+    { (yyval.l)=insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v));   }
+    break;
+
+  case 160:
+/* Line 1807 of yacc.c  */
+#line 890 "fortran.y"
     {
-         PublicDeclare = 0 ;
-         PrivateDeclare = 0 ;
-      ;}
-    break;
-
-  case 110:
-#line 787 "fortran.y"
+            if ( inside_type_declare ) break;
+            curvar=(variable *) calloc(1,sizeof(variable));
+            Init_Variable(curvar);
+            curvar->v_VariableIsParameter = 1;
+            strcpy(curvar->v_nomvar,(yyvsp[(1) - (3)].na));
+            strcpy(curvar->v_subroutinename,subroutinename);
+            strcpy(curvar->v_modulename,curmodulename);
+            strcpy(curvar->v_initialvalue,(yyvsp[(3) - (3)].na));
+            strcpy(curvar->v_commoninfile,cur_filename);
+            Save_Length((yyvsp[(3) - (3)].na),14);
+            (yyval.v) = curvar;
+        }
+    break;
+
+  case 164:
+/* Line 1807 of yacc.c  */
+#line 913 "fortran.y"
     {
-                      /* if the variable is a parameter we can suppose that is*/
-                      /*    value is the same on each grid. It is not useless */
-                      /*    to create a copy of it on each grid               */
-                      if ( couldaddvariable == 1 )
-                      {
-                      pos_end = setposcur();
-                      /*if (insubroutinedeclare == 0)
-                        {   */
-                         RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                 pos_end-pos_cur_decl);
-                                         
-                       /* }
-                      else
-                       {*/
-                        ReWriteDeclarationAndAddTosubroutine_01((yyvsp[(1) - (2)].l));
-                        pos_cur_decl = setposcur();
-                        
-                       /*}*/
-                      if ( firstpass == 0 &&
-                           GlobalDeclaration == 0 &&
-                           insubroutinedeclare == 0 )
-                      {
-
-                         sprintf(ligne,"\n#include \"Module_Declar_%s.h\"\n"
-                                                                ,curmodulename);
-                         tofich(fortranout,ligne,1);
-                         sprintf (ligne, "Module_Declar_%s.h",curmodulename);
-                         module_declar = associate(ligne);
-                         sprintf (ligne, " ");
-                         tofich (module_declar, ligne,1);
-                         GlobalDeclaration = 1 ;
-                         pos_cur_decl = setposcur();
-
-                      }
-                         (yyval.l) = (yyvsp[(1) - (2)].l);
-                         Add_Globliste_1((yyvsp[(1) - (2)].l));
-                                                  
-                         if ( insubroutinedeclare == 0 )
-                                                  Add_GlobalParameter_Var_1((yyvsp[(1) - (2)].l));
-                         else
-                         {
-                            if ( pointerdeclare == 1 )
-                                                Add_Pointer_Var_From_List_1((yyvsp[(1) - (2)].l));
-                            Add_Parameter_Var_1((yyvsp[(1) - (2)].l));
-                         }
-
-                         /* if variables has been declared in a subroutine    */
-                         if ( insubroutinedeclare == 1 )
-                         { 
-                       /*    Add_SubroutineDeclaration_Var_1($1);*/
-                         }
-                         /* If there are a SAVE declarations in module's      */
-                         /*    subroutines we should remove it from the       */
-                         /*    subroutines declaration and add it in the      */
-                         /*    global declarations                            */
-                         if ( aftercontainsdeclare == 1 &&
-                              SaveDeclare == 1 && firstpass == 1 )
-                         {
-                              if ( inmodulemeet == 0 ) Add_Save_Var_dcl_1((yyvsp[(1) - (2)].l));
-                              else  Add_SubroutineDeclarationSave_Var_1((yyvsp[(1) - (2)].l));
-                         }
-                      }
-                      /*                                                      */
-                      PublicDeclare = 0;
-                      PrivateDeclare = 0;
-                      ExternalDeclare = 0;
-                      strcpy(NamePrecision,"");
-                      c_star = 0;
-                      strcpy(InitialValueGiven," ");
-                      strcpy(IntentSpec,"");
-                      VariableIsParameter =  0 ;
-                      Allocatabledeclare = 0 ;
-                      Targetdeclare = 0 ;
-                      SaveDeclare = 0;
-                      pointerdeclare = 0;
-                      optionaldeclare = 0 ;
-                      dimsgiven=0;
-                      c_selectorgiven=0;
-                      strcpy(nameinttypename,"");
-                      strcpy(c_selectorname,"");
-                      GlobalDeclarationType = 0; 
-                   ;}
-    break;
-
-  case 111:
-#line 871 "fortran.y"
-    {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(2) - (3)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,(yyvsp[(2) - (3)].nac));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
-                         Add_FunctionType_Var_1((yyvsp[(2) - (3)].nac));
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
-                         Add_FunctionType_Var_1((yyvsp[(2) - (3)].nac));
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      strcpy(nameinttypename,"");
-
-                   ;}
-    break;
-
-  case 112:
-#line 908 "fortran.y"
-    {
-                       functiondeclarationisdone = 1;
-                   ;}
-    break;
-
-  case 113:
-#line 914 "fortran.y"
-    {
-                      VariableIsParameter = 1;
-                      pos_curparameter = setposcur()-9;
-                   ;}
-    break;
-
-  case 114:
-#line 919 "fortran.y"
-    {
-                      pos_curdata = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                      Init_List_Data_Var();
-                   ;}
-    break;
-
-  case 115:
+            if ( insubroutinedeclare == 1 )
+            {
+                Add_ImplicitNoneSubroutine_1();
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_end-13,13);
+            }
+        }
+    break;
+
+  case 166:
+/* Line 1807 of yacc.c  */
 #line 924 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-/*                      if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
-                      else */
-/*                      sprintf(ligne,"%s",$3);*/
-                      createstringfromlistname(ligne,(yyvsp[(3) - (4)].lnn));
-                      if (firstpass == 1)
-                      Add_Data_Var_1(&List_Data_Var,(yyvsp[(1) - (4)].nac),ligne);
-                      else
-                      Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(1) - (4)].nac),ligne);
-                      }
-                   ;}
-    break;
-
-  case 116:
-#line 938 "fortran.y"
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar((yyvsp[(2) - (5)].na),curdim);
+                else                curvar = createvar((yyvsp[(2) - (5)].na),(yyvsp[(3) - (5)].d));
+                CreateAndFillin_Curvar(DeclType, curvar);
+                curlistvar = insertvar(NULL, curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                (yyval.l)=settype(DeclType,curlistvar);
+            }
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 167:
+/* Line 1807 of yacc.c  */
+#line 946 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                      /*if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
-                      else */
-                      /*sprintf(ligne,"%s",$5);   */
-                      createstringfromlistname(ligne,(yyvsp[(5) - (6)].lnn));                      
-                      if (firstpass == 1)                      
-                      Add_Data_Var_1(&List_Data_Var,(yyvsp[(3) - (6)].nac),ligne);
-                      else
-                      Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(3) - (6)].nac),ligne);                      
-                      }
-                   ;}
-    break;
-
-  case 117:
-#line 952 "fortran.y"
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar((yyvsp[(3) - (6)].na), curdim);
+                else                curvar = createvar((yyvsp[(3) - (6)].na), (yyvsp[(4) - (6)].d));
+                CreateAndFillin_Curvar((yyvsp[(1) - (6)].l)->var->v_typevar,curvar);
+                strcpy(curvar->v_typevar, (yyvsp[(1) - (6)].l)->var->v_typevar);
+                curvar->v_catvar = get_cat_var(curvar);
+                curlistvar = insertvar((yyvsp[(1) - (6)].l), curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                (yyval.l)=curlistvar;
+            }
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 168:
+/* Line 1807 of yacc.c  */
+#line 970 "fortran.y"
+    { dimsgiven = 0; }
+    break;
+
+  case 169:
+/* Line 1807 of yacc.c  */
+#line 972 "fortran.y"
+    { strcpy(DeclType,(yyvsp[(1) - (2)].na));  }
+    break;
+
+  case 170:
+/* Line 1807 of yacc.c  */
+#line 973 "fortran.y"
+    { strcpy(DeclType,"character");  }
+    break;
+
+  case 171:
+/* Line 1807 of yacc.c  */
+#line 974 "fortran.y"
+    { strcpy(DeclType,(yyvsp[(1) - (3)].na)); strcpy(nameinttypename,(yyvsp[(3) - (3)].na));  }
+    break;
+
+  case 172:
+/* Line 1807 of yacc.c  */
+#line 975 "fortran.y"
+    { strcpy(DeclType,"type"); GlobalDeclarationType = 1;  }
+    break;
+
+  case 174:
+/* Line 1807 of yacc.c  */
+#line 978 "fortran.y"
+    { c_selectorgiven = 1; strcpy(c_selectorname,(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 175:
+/* Line 1807 of yacc.c  */
+#line 979 "fortran.y"
+    { c_star = 1;}
+    break;
+
+  case 180:
+/* Line 1807 of yacc.c  */
+#line 987 "fortran.y"
+    { pos_cur_decl = setposcur()-9; }
+    break;
+
+  case 181:
+/* Line 1807 of yacc.c  */
+#line 990 "fortran.y"
+    { strcpy((yyval.na),"integer"); pos_cur_decl = setposcur()-7; }
+    break;
+
+  case 182:
+/* Line 1807 of yacc.c  */
+#line 991 "fortran.y"
+    { strcpy((yyval.na),"logical"); pos_cur_decl = setposcur()-7; }
+    break;
+
+  case 183:
+/* Line 1807 of yacc.c  */
+#line 992 "fortran.y"
+    { strcpy((yyval.na),"real");    pos_cur_decl = setposcur()-4; }
+    break;
+
+  case 184:
+/* Line 1807 of yacc.c  */
+#line 993 "fortran.y"
+    { strcpy((yyval.na),"complex"); pos_cur_decl = setposcur()-7; }
+    break;
+
+  case 185:
+/* Line 1807 of yacc.c  */
+#line 994 "fortran.y"
+    { strcpy((yyval.na),"double complex"); pos_cur_decl = setposcur()-14; }
+    break;
+
+  case 186:
+/* Line 1807 of yacc.c  */
+#line 995 "fortran.y"
+    { pos_cur_decl = setposcur()-16; strcpy((yyval.na),"real"); strcpy(nameinttypename,"8"); }
+    break;
+
+  case 188:
+/* Line 1807 of yacc.c  */
+#line 998 "fortran.y"
+    {strcpy(vallengspec,(yyvsp[(2) - (2)].na));}
+    break;
+
+  case 189:
+/* Line 1807 of yacc.c  */
+#line 1001 "fortran.y"
+    { sprintf((yyval.na),"*%s",(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 190:
+/* Line 1807 of yacc.c  */
+#line 1002 "fortran.y"
+    { strcpy((yyval.na),"*(*)"); }
+    break;
+
+  case 197:
+/* Line 1807 of yacc.c  */
+#line 1014 "fortran.y"
     {
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       if (firstpass == 1)
-                       Add_Data_Var_Names_01(&List_Data_Var,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
-                       else
-                       Add_Data_Var_Names_01(&List_Data_Var_Cur,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
-                   ;}
-    break;
-
-  case 118:
-#line 967 "fortran.y"
+            if ( strstr((yyvsp[(3) - (3)].na),"0.d0") )
+            {
+                strcpy(nameinttypename,"8");
+                strcpy(NamePrecision,"");
+            }
+            else
+                sprintf(NamePrecision,"%s = %s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));
+        }
+    break;
+
+  case 198:
+/* Line 1807 of yacc.c  */
+#line 1023 "fortran.y"
+    { strcpy(NamePrecision,(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 199:
+/* Line 1807 of yacc.c  */
+#line 1024 "fortran.y"
+    { strcpy(NamePrecision,(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 200:
+/* Line 1807 of yacc.c  */
+#line 1025 "fortran.y"
+    { strcpy(NamePrecision,(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 201:
+/* Line 1807 of yacc.c  */
+#line 1028 "fortran.y"
+    { strcpy(CharacterSize,(yyvsp[(1) - (1)].na));  strcpy((yyval.na),(yyvsp[(1) - (1)].na));  }
+    break;
+
+  case 202:
+/* Line 1807 of yacc.c  */
+#line 1029 "fortran.y"
+    { strcpy(CharacterSize,"*"); strcpy((yyval.na),"*"); }
+    break;
+
+  case 210:
+/* Line 1807 of yacc.c  */
+#line 1042 "fortran.y"
+    { VariableIsParameter = 1; }
+    break;
+
+  case 212:
+/* Line 1807 of yacc.c  */
+#line 1044 "fortran.y"
+    { Allocatabledeclare = 1; }
+    break;
+
+  case 213:
+/* Line 1807 of yacc.c  */
+#line 1045 "fortran.y"
+    { dimsgiven = 1; curdim = (yyvsp[(2) - (2)].d); }
+    break;
+
+  case 214:
+/* Line 1807 of yacc.c  */
+#line 1046 "fortran.y"
+    { ExternalDeclare = 1; }
+    break;
+
+  case 215:
+/* Line 1807 of yacc.c  */
+#line 1048 "fortran.y"
+    { strcpy(IntentSpec,(yyvsp[(3) - (4)].na)); }
+    break;
+
+  case 217:
+/* Line 1807 of yacc.c  */
+#line 1050 "fortran.y"
+    { optionaldeclare = 1 ; }
+    break;
+
+  case 218:
+/* Line 1807 of yacc.c  */
+#line 1051 "fortran.y"
+    { pointerdeclare = 1 ; }
+    break;
+
+  case 219:
+/* Line 1807 of yacc.c  */
+#line 1052 "fortran.y"
+    { SaveDeclare = 1 ; }
+    break;
+
+  case 220:
+/* Line 1807 of yacc.c  */
+#line 1053 "fortran.y"
+    { Targetdeclare = 1; }
+    break;
+
+  case 221:
+/* Line 1807 of yacc.c  */
+#line 1056 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 222:
+/* Line 1807 of yacc.c  */
+#line 1057 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 223:
+/* Line 1807 of yacc.c  */
+#line 1058 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 224:
+/* Line 1807 of yacc.c  */
+#line 1061 "fortran.y"
+    { PublicDeclare = 1;  }
+    break;
+
+  case 225:
+/* Line 1807 of yacc.c  */
+#line 1062 "fortran.y"
+    { PrivateDeclare = 1; }
+    break;
+
+  case 226:
+/* Line 1807 of yacc.c  */
+#line 1064 "fortran.y"
+    { (yyval.d) = (listdim*) NULL; }
+    break;
+
+  case 227:
+/* Line 1807 of yacc.c  */
+#line 1066 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0);
-                      }
-                   ;}
-    break;
-
-  case 119:
-#line 974 "fortran.y"
+            (yyval.d) = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  (yyval.d)=(yyvsp[(2) - (3)].d);
+        }
+    break;
+
+  case 228:
+/* Line 1807 of yacc.c  */
+#line 1074 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         (yyval.lnn) = Insertname((yyvsp[(3) - (3)].lnn),(yyvsp[(1) - (3)].na),1);
-                      }
-                   ;}
-    break;
-
-  case 124:
-#line 988 "fortran.y"
+            (yyval.d) = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  (yyval.d)=insertdim(NULL,(yyvsp[(1) - (1)].dim1));
+        }
+    break;
+
+  case 229:
+/* Line 1807 of yacc.c  */
+#line 1080 "fortran.y"
     {
-                     pos_cursave = setposcur()-4;
-                  ;}
-    break;
-
-  case 126:
-#line 994 "fortran.y"
+            (yyval.d) = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( (!inside_type_declare) && created_dimensionlist == 1 ) (yyval.d)=insertdim((yyvsp[(1) - (3)].d),(yyvsp[(3) - (3)].dim1));
+        }
+    break;
+
+  case 230:
+/* Line 1807 of yacc.c  */
+#line 1086 "fortran.y"
+    { strcpy((yyval.dim1).first,"1"); strcpy((yyval.dim1).last,(yyvsp[(1) - (1)].na)); Save_Length((yyvsp[(1) - (1)].na),1); }
+    break;
+
+  case 231:
+/* Line 1807 of yacc.c  */
+#line 1087 "fortran.y"
+    { strcpy((yyval.dim1).first,"");  strcpy((yyval.dim1).last,"");                    }
+    break;
+
+  case 232:
+/* Line 1807 of yacc.c  */
+#line 1088 "fortran.y"
+    { strcpy((yyval.dim1).first,(yyvsp[(1) - (2)].na));  Save_Length((yyvsp[(1) - (2)].na),2); strcpy((yyval.dim1).last,""); }
+    break;
+
+  case 233:
+/* Line 1807 of yacc.c  */
+#line 1089 "fortran.y"
+    { strcpy((yyval.dim1).first,"");  strcpy((yyval.dim1).last,(yyvsp[(2) - (2)].na)); Save_Length((yyvsp[(2) - (2)].na),1); }
+    break;
+
+  case 234:
+/* Line 1807 of yacc.c  */
+#line 1090 "fortran.y"
+    { strcpy((yyval.dim1).first,(yyvsp[(1) - (3)].na));  Save_Length((yyvsp[(1) - (3)].na),2); strcpy((yyval.dim1).last,(yyvsp[(3) - (3)].na)); Save_Length((yyvsp[(3) - (3)].na),1); }
+    break;
+
+  case 235:
+/* Line 1807 of yacc.c  */
+#line 1093 "fortran.y"
+    { strcpy((yyval.na),"*"); }
+    break;
+
+  case 236:
+/* Line 1807 of yacc.c  */
+#line 1094 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));  }
+    break;
+
+  case 237:
+/* Line 1807 of yacc.c  */
+#line 1096 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 238:
+/* Line 1807 of yacc.c  */
+#line 1097 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 239:
+/* Line 1807 of yacc.c  */
+#line 1098 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 240:
+/* Line 1807 of yacc.c  */
+#line 1099 "fortran.y"
+    { sprintf((yyval.na),"(%s)",(yyvsp[(2) - (3)].na)); }
+    break;
+
+  case 241:
+/* Line 1807 of yacc.c  */
+#line 1103 "fortran.y"
+    { sprintf((yyval.na),"SUM(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 242:
+/* Line 1807 of yacc.c  */
+#line 1104 "fortran.y"
+    { sprintf((yyval.na),"MAX(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 243:
+/* Line 1807 of yacc.c  */
+#line 1105 "fortran.y"
+    { sprintf((yyval.na),"TANH(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 244:
+/* Line 1807 of yacc.c  */
+#line 1106 "fortran.y"
+    { sprintf((yyval.na),"MAXVAL(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 245:
+/* Line 1807 of yacc.c  */
+#line 1107 "fortran.y"
+    { sprintf((yyval.na),"MIN(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 246:
+/* Line 1807 of yacc.c  */
+#line 1108 "fortran.y"
+    { sprintf((yyval.na),"MINVAL(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 247:
+/* Line 1807 of yacc.c  */
+#line 1109 "fortran.y"
+    { sprintf((yyval.na),"TRIM(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 248:
+/* Line 1807 of yacc.c  */
+#line 1110 "fortran.y"
+    { sprintf((yyval.na),"SQRT(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 249:
+/* Line 1807 of yacc.c  */
+#line 1111 "fortran.y"
+    { sprintf((yyval.na),"REAL(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 250:
+/* Line 1807 of yacc.c  */
+#line 1112 "fortran.y"
+    { sprintf((yyval.na),"NINT(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 251:
+/* Line 1807 of yacc.c  */
+#line 1113 "fortran.y"
+    { sprintf((yyval.na),"FLOAT(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 252:
+/* Line 1807 of yacc.c  */
+#line 1114 "fortran.y"
+    { sprintf((yyval.na),"EXP(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 253:
+/* Line 1807 of yacc.c  */
+#line 1115 "fortran.y"
+    { sprintf((yyval.na),"COS(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 254:
+/* Line 1807 of yacc.c  */
+#line 1116 "fortran.y"
+    { sprintf((yyval.na),"COSH(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 255:
+/* Line 1807 of yacc.c  */
+#line 1117 "fortran.y"
+    { sprintf((yyval.na),"ACOS(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 256:
+/* Line 1807 of yacc.c  */
+#line 1118 "fortran.y"
+    { sprintf((yyval.na),"SIN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 257:
+/* Line 1807 of yacc.c  */
+#line 1119 "fortran.y"
+    { sprintf((yyval.na),"SINH(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 258:
+/* Line 1807 of yacc.c  */
+#line 1120 "fortran.y"
+    { sprintf((yyval.na),"ASIN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 259:
+/* Line 1807 of yacc.c  */
+#line 1121 "fortran.y"
+    { sprintf((yyval.na),"LOG(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 260:
+/* Line 1807 of yacc.c  */
+#line 1122 "fortran.y"
+    { sprintf((yyval.na),"TAN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 261:
+/* Line 1807 of yacc.c  */
+#line 1123 "fortran.y"
+    { sprintf((yyval.na),"ATAN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 262:
+/* Line 1807 of yacc.c  */
+#line 1124 "fortran.y"
+    { sprintf((yyval.na),"ABS(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 263:
+/* Line 1807 of yacc.c  */
+#line 1125 "fortran.y"
+    { sprintf((yyval.na),"MOD(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 264:
+/* Line 1807 of yacc.c  */
+#line 1126 "fortran.y"
+    { sprintf((yyval.na),"SIGN(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 265:
+/* Line 1807 of yacc.c  */
+#line 1127 "fortran.y"
+    { sprintf((yyval.na),"MINLOC(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 266:
+/* Line 1807 of yacc.c  */
+#line 1128 "fortran.y"
+    { sprintf((yyval.na),"MAXLOC(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 267:
+/* Line 1807 of yacc.c  */
+#line 1130 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 268:
+/* Line 1807 of yacc.c  */
+#line 1131 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 269:
+/* Line 1807 of yacc.c  */
+#line 1133 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 270:
+/* Line 1807 of yacc.c  */
+#line 1134 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 271:
+/* Line 1807 of yacc.c  */
+#line 1135 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 272:
+/* Line 1807 of yacc.c  */
+#line 1136 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 273:
+/* Line 1807 of yacc.c  */
+#line 1137 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 274:
+/* Line 1807 of yacc.c  */
+#line 1138 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 275:
+/* Line 1807 of yacc.c  */
+#line 1140 "fortran.y"
+    { strcpy((yyval.na),"+"); }
+    break;
+
+  case 276:
+/* Line 1807 of yacc.c  */
+#line 1141 "fortran.y"
+    { strcpy((yyval.na),"-"); }
+    break;
+
+  case 277:
+/* Line 1807 of yacc.c  */
+#line 1145 "fortran.y"
+    { sprintf((yyval.na),"+%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 278:
+/* Line 1807 of yacc.c  */
+#line 1146 "fortran.y"
+    { sprintf((yyval.na),"-%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 279:
+/* Line 1807 of yacc.c  */
+#line 1147 "fortran.y"
+    { sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 280:
+/* Line 1807 of yacc.c  */
+#line 1148 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 281:
+/* Line 1807 of yacc.c  */
+#line 1149 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 282:
+/* Line 1807 of yacc.c  */
+#line 1150 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 283:
+/* Line 1807 of yacc.c  */
+#line 1151 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 284:
+/* Line 1807 of yacc.c  */
+#line 1152 "fortran.y"
+    { sprintf((yyval.na)," > %s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 285:
+/* Line 1807 of yacc.c  */
+#line 1153 "fortran.y"
+    { sprintf((yyval.na)," < %s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 286:
+/* Line 1807 of yacc.c  */
+#line 1154 "fortran.y"
+    { sprintf((yyval.na)," >= %s",(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 287:
+/* Line 1807 of yacc.c  */
+#line 1155 "fortran.y"
+    { sprintf((yyval.na)," <= %s",(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 288:
+/* Line 1807 of yacc.c  */
+#line 1156 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 289:
+/* Line 1807 of yacc.c  */
+#line 1157 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 290:
+/* Line 1807 of yacc.c  */
+#line 1158 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 291:
+/* Line 1807 of yacc.c  */
+#line 1159 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 292:
+/* Line 1807 of yacc.c  */
+#line 1160 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 293:
+/* Line 1807 of yacc.c  */
+#line 1161 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 294:
+/* Line 1807 of yacc.c  */
+#line 1162 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 295:
+/* Line 1807 of yacc.c  */
+#line 1163 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 296:
+/* Line 1807 of yacc.c  */
+#line 1164 "fortran.y"
+    { sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 297:
+/* Line 1807 of yacc.c  */
+#line 1165 "fortran.y"
+    { sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 298:
+/* Line 1807 of yacc.c  */
+#line 1167 "fortran.y"
+    { strcpy((yyval.na),""); }
+    break;
+
+  case 299:
+/* Line 1807 of yacc.c  */
+#line 1168 "fortran.y"
+    { sprintf((yyval.na),"/%s",(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 300:
+/* Line 1807 of yacc.c  */
+#line 1169 "fortran.y"
+    { sprintf((yyval.na),"/= %s",(yyvsp[(2) - (2)].na));}
+    break;
+
+  case 301:
+/* Line 1807 of yacc.c  */
+#line 1170 "fortran.y"
+    { sprintf((yyval.na),"//%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 302:
+/* Line 1807 of yacc.c  */
+#line 1173 "fortran.y"
+    { sprintf((yyval.na),"==%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 303:
+/* Line 1807 of yacc.c  */
+#line 1174 "fortran.y"
+    { sprintf((yyval.na),"= %s",(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 304:
+/* Line 1807 of yacc.c  */
+#line 1177 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 305:
+/* Line 1807 of yacc.c  */
+#line 1178 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 306:
+/* Line 1807 of yacc.c  */
+#line 1179 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 307:
+/* Line 1807 of yacc.c  */
+#line 1183 "fortran.y"
     {
-                     if ( couldaddvariable == 1 ) Add_Save_Var_1((yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].d));
-                  ;}
-    break;
-
-  case 127:
-#line 999 "fortran.y"
+            agrif_parentcall = 0;
+            if ( !strcasecmp(identcopy, "Agrif_Parent") )   agrif_parentcall = 1;
+            if ( Agrif_in_Tok_NAME(identcopy) )
+            {
+                inagrifcallargument = 1;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+    break;
+
+  case 308:
+/* Line 1807 of yacc.c  */
+#line 1194 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); if ( incalldeclare == 0 ) inagrifcallargument = 0;   }
+    break;
+
+  case 309:
+/* Line 1807 of yacc.c  */
+#line 1195 "fortran.y"
+    { sprintf((yyval.na)," %s %s ",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 310:
+/* Line 1807 of yacc.c  */
+#line 1196 "fortran.y"
+    { sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na)); }
+    break;
+
+  case 311:
+/* Line 1807 of yacc.c  */
+#line 1197 "fortran.y"
+    { sprintf((yyval.na)," %s ( %s ) %s ",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na)); }
+    break;
+
+  case 312:
+/* Line 1807 of yacc.c  */
+#line 1201 "fortran.y"
     {
-		(yyval.lnn)=Insertname(NULL,(yyvsp[(1) - (1)].nac),0);
-		;}
-    break;
-
-  case 128:
-#line 1003 "fortran.y"
+            if ( inside_type_declare ) break;
+            sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na));
+            ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].na));
+            agrif_parentcall = 0;
+        }
+    break;
+
+  case 313:
+/* Line 1807 of yacc.c  */
+#line 1210 "fortran.y"
     {
-      printf("INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n");
-      exit(0);
-      ;}
-    break;
-
-  case 129:
-#line 1008 "fortran.y"
-    {
-      (yyval.lnn) = concat_listname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].lnn));
-      ;}
-    break;
-
-  case 130:
-#line 1013 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].nac));;}
-    break;
-
-  case 131:
-#line 1015 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s+%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 132:
-#line 1017 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s-%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 133:
-#line 1019 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s*%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 134:
-#line 1021 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s/%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 135:
-#line 1024 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"");;}
-    break;
-
-  case 136:
-#line 1026 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 143:
-#line 1038 "fortran.y"
-    {
-	ininterfacedeclare = 1 ;
-	printf("INTEFACE entree\n");
-	;}
-    break;
-
-  case 144:
-#line 1043 "fortran.y"
-    {
-      ininterfacedeclare = 0;
-      ;}
-    break;
-
-  case 145:
-#line 1048 "fortran.y"
-    {
-                      positioninblock=0;
-                      pos_curdimension = setposcur()-9;
-                   ;}
-    break;
-
-  case 146:
-#line 1054 "fortran.y"
-    {
-         if ( couldaddvariable == 1 )
-         {
-            /*                                                                */
-            curvar=createvar((yyvsp[(3) - (5)].nac),(yyvsp[(4) - (5)].d));
-            /*                                                                */
-            CreateAndFillin_Curvar("",curvar);
-            /*                                                                */
-            curlistvar=insertvar(NULL,curvar);
-            /*                                                                */
-            (yyval.l)=settype("",curlistvar);
-            /*                                                                */
-            strcpy(vallengspec,"");
-         }
-      ;}
-    break;
-
-  case 147:
-#line 1070 "fortran.y"
-    {
-         if ( couldaddvariable == 1 )
-         {
-            /*                                                                */
-            curvar=createvar((yyvsp[(3) - (5)].nac),(yyvsp[(4) - (5)].d));
-            /*                                                                */
-            CreateAndFillin_Curvar("",curvar);
-            /*                                                                */
-            curlistvar=insertvar((yyvsp[(1) - (5)].l),curvar);
-            /*                                                                */
-            (yyval.l)=curlistvar;
-            /*                                                                */
-            strcpy(vallengspec,"");
-         }
-      ;}
-    break;
-
-  case 150:
-#line 1090 "fortran.y"
-    {
-        (yyval.lnn)=(listname *)NULL;
-        ;}
-    break;
-
-  case 151:
-#line 1094 "fortran.y"
-    {
-          (yyval.lnn)=(yyvsp[(3) - (3)].lnn);
-         ;}
-    break;
-
-  case 152:
-#line 1099 "fortran.y"
-    {
-           (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].nac),0);
-           ;}
-    break;
-
-  case 153:
-#line 1103 "fortran.y"
-    {
-          (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].nac),0);
-          ;}
-    break;
-
-  case 154:
-#line 1108 "fortran.y"
-    {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcommon,
-                                                  pos_end-pos_curcommon);
-                   ;}
-    break;
-
-  case 155:
-#line 1114 "fortran.y"
-    {
-                         if ( couldaddvariable == 1 )
-                         {
-                            sprintf(charusemodule,"%s",(yyvsp[(2) - (3)].nac));
-                            Add_NameOfCommon_1((yyvsp[(2) - (3)].nac),subroutinename);
-                            pos_end = setposcur();
-                            RemoveWordSET_0(fortranout,pos_curcommon,
-                                                       pos_end-pos_curcommon);
-                         }
-                   ;}
-    break;
-
-  case 156:
-#line 1125 "fortran.y"
-    {
-                         if ( couldaddvariable == 1 )
-                         {
-                            sprintf(charusemodule,"%s",(yyvsp[(3) - (5)].nac));
-                            Add_NameOfCommon_1((yyvsp[(3) - (5)].nac),subroutinename);
-                            pos_end = setposcur();
-                            RemoveWordSET_0(fortranout,pos_curcommon,
-                                                       pos_end-pos_curcommon);
-                         }
-                   ;}
-    break;
-
-  case 157:
-#line 1137 "fortran.y"
-    {
-                      positioninblock=0;
-                      pos_curcommon = setposcur()-6;
-                   ;}
-    break;
-
-  case 158:
-#line 1142 "fortran.y"
-    {
-                      positioninblock=0;
-                      pos_curcommon = setposcur()-6-7;
-                   ;}
-    break;
-
-  case 159:
-#line 1148 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) Add_Common_var_1();
-                   ;}
-    break;
-
-  case 160:
-#line 1153 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) Add_Common_var_1();
-                   ;}
-    break;
-
-  case 161:
-#line 1157 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         positioninblock = positioninblock + 1 ;
-                         strcpy(commonvar,(yyvsp[(1) - (2)].nac));
-                         commondim = (yyvsp[(2) - (2)].d);
-                      }
-                   ;}
-    break;
-
-  case 162:
-#line 1167 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy((yyval.nac),"");
-                         positioninblock=0;
-                         strcpy(commonblockname,"");
-                      }
-                   ;}
-    break;
-
-  case 163:
-#line 1176 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy((yyval.nac),(yyvsp[(2) - (3)].nac));
-                         positioninblock=0;
-                         strcpy(commonblockname,(yyvsp[(2) - (3)].nac));
-                      }
-                   ;}
-    break;
-
-  case 166:
-#line 1189 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) (yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v));
-                   ;}
-    break;
-
-  case 167:
-#line 1193 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) (yyval.l)=insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v));
-                   ;}
-    break;
-
-  case 168:
-#line 1198 "fortran.y"
-    {
-                     if ( couldaddvariable == 1 )
-                     {
-                         curvar=(variable *) malloc(sizeof(variable));
-                         /*                                                   */
-                         Init_Variable(curvar);
-                         /*                                                   */
-                         curvar->v_VariableIsParameter=1;
-                         strcpy(curvar->v_nomvar,(yyvsp[(1) - (3)].nac));
-                         Save_Length((yyvsp[(1) - (3)].nac),4);
-                         strcpy(curvar->v_subroutinename,subroutinename);
-                         Save_Length(subroutinename,11);
-                         strcpy(curvar->v_modulename,curmodulename);
-                         Save_Length(curmodulename,6);
-                         strcpy(curvar->v_initialvalue,(yyvsp[(3) - (3)].na));
-                         Save_Length((yyvsp[(3) - (3)].na),14);
-                         strcpy(curvar->v_commoninfile,mainfile);
-                         Save_Length(mainfile,10);
-                         (yyval.v)=curvar;
-                      }
-                   ;}
-    break;
-
-  case 172:
-#line 1226 "fortran.y"
-    {
-                       if ( insubroutinedeclare == 1 )
-                       {
-                          Add_ImplicitNoneSubroutine_1();
-                          pos_end = setposcur();
-                          RemoveWordSET_0(fortranout,pos_end-13,
-                                                             13);
-                       }
-                    ;}
-    break;
-
-  case 175:
+            sprintf((yyval.na)," %s %% %s ",(yyvsp[(1) - (4)].na),(yyvsp[(4) - (4)].na));
+            if ( incalldeclare == 0 ) inagrifcallargument = 0;
+        }
+    break;
+
+  case 314:
+/* Line 1807 of yacc.c  */
+#line 1216 "fortran.y"
+    { sprintf((yyval.na),"(/%s/)",(yyvsp[(2) - (3)].na)); }
+    break;
+
+  case 315:
+/* Line 1807 of yacc.c  */
+#line 1219 "fortran.y"
+    { strcpy((yyval.na)," "); }
+    break;
+
+  case 316:
+/* Line 1807 of yacc.c  */
+#line 1220 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 317:
+/* Line 1807 of yacc.c  */
+#line 1223 "fortran.y"
+    {  strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 318:
+/* Line 1807 of yacc.c  */
+#line 1224 "fortran.y"
+    {  sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 319:
+/* Line 1807 of yacc.c  */
+#line 1227 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 320:
+/* Line 1807 of yacc.c  */
+#line 1228 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 321:
+/* Line 1807 of yacc.c  */
+#line 1231 "fortran.y"
+    {  sprintf((yyval.na),"%s :%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));}
+    break;
+
+  case 322:
+/* Line 1807 of yacc.c  */
+#line 1232 "fortran.y"
+    {  sprintf((yyval.na),"%s :%s :%s",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));}
+    break;
+
+  case 323:
+/* Line 1807 of yacc.c  */
+#line 1233 "fortran.y"
+    {  sprintf((yyval.na),":%s :%s",(yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].na));}
+    break;
+
+  case 324:
+/* Line 1807 of yacc.c  */
+#line 1234 "fortran.y"
+    {  sprintf((yyval.na),": : %s",(yyvsp[(3) - (3)].na));}
+    break;
+
+  case 325:
+/* Line 1807 of yacc.c  */
+#line 1235 "fortran.y"
+    {  sprintf((yyval.na),":%s",(yyvsp[(2) - (2)].na));}
+    break;
+
+  case 326:
+/* Line 1807 of yacc.c  */
+#line 1236 "fortran.y"
+    {  sprintf((yyval.na),"%s :",(yyvsp[(1) - (2)].na));}
+    break;
+
+  case 327:
+/* Line 1807 of yacc.c  */
+#line 1237 "fortran.y"
+    {  sprintf((yyval.na),":");}
+    break;
+
+  case 328:
+/* Line 1807 of yacc.c  */
 #line 1240 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         /*                                                   */
-                         if (dimsgiven == 1)
-                         {
-                            curvar=createvar((yyvsp[(3) - (6)].nac),curdim);
-                            GlobalDeclarationType == 0;
-                         }
-                         else
-                         {
-                            curvar=createvar((yyvsp[(3) - (6)].nac),(yyvsp[(4) - (6)].d));
-                         }
-                         /*                                                   */
-                         CreateAndFillin_Curvar(DeclType,curvar);
-                         /*                                                   */
-                         curlistvar=insertvar(NULL,curvar);
-                         if (!strcasecmp(DeclType,"character"))
-                         {
-                            if (c_selectorgiven == 1)
+            if ( afterpercent == 0 )
+            {
+                if ( Agrif_in_Tok_NAME((yyvsp[(1) - (1)].na)) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+                if ( !strcasecmp((yyvsp[(1) - (1)].na),"Agrif_Parent") )   agrif_parentcall = 1;
+                if ( VariableIsFunction((yyvsp[(1) - (1)].na)) )
+                {
+                    if ( inagrifcallargument == 1 )
+                    {
+                        if ( !strcasecmp((yyvsp[(1) - (1)].na),identcopy) )
+                        {
+                            strcpy(sameagrifname,identcopy);
+                            sameagrifargument = 1;
+                        }
+                    }
+                    strcpy(identcopy,(yyvsp[(1) - (1)].na));
+                    pointedvar = 0;
+
+                    if (variscoupled_0((yyvsp[(1) - (1)].na))) strcpy(truename, getcoupledname_0((yyvsp[(1) - (1)].na)));
+                    else                    strcpy(truename, (yyvsp[(1) - (1)].na));
+
+                    if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) )
+                    {
+                        if ( inagrifcallargument == 1 || varispointer_0(truename) == 1 )
+                        {
+                            if ( (IsinListe(List_UsedInSubroutine_Var,(yyvsp[(1) - (1)].na)) == 1) || (inagrifcallargument == 1) )
                             {
-                               strcpy(c_selectordim.first,"1");
-                               strcpy(c_selectordim.last,c_selectorname);
-                               Save_Length(c_selectorname,1);
-                               change_dim_char
-                                     (insertdim(NULL,c_selectordim),curlistvar);
+                                if (varistyped_0(truename) == 0)    ModifyTheVariableName_0(truename,strlen((yyvsp[(1) - (1)].na)));
                             }
-                         }
-                         (yyval.l)=settype(DeclType,curlistvar);
-                      }
-                      strcpy(vallengspec,"");
-                   ;}
-    break;
-
-  case 176:
-#line 1273 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         if (dimsgiven == 1)
-                         {
-                            curvar=createvar((yyvsp[(4) - (7)].nac),curdim);
-                         }
-                         else
-                         {
-                            curvar=createvar((yyvsp[(4) - (7)].nac),(yyvsp[(5) - (7)].d));
-                         }
-                         /*                                                   */
-                         CreateAndFillin_Curvar((yyvsp[(1) - (7)].l)->var->v_typevar,curvar);
-                         /*                                                   */
-                         strcpy(curvar->v_typevar,((yyvsp[(1) - (7)].l)->var->v_typevar));
-                         Save_Length((yyvsp[(1) - (7)].l)->var->v_typevar,3);
-                         /*                                                   */
-                         curlistvar=insertvar((yyvsp[(1) - (7)].l),curvar);
-                         if (!strcasecmp(DeclType,"character"))
-                         {
-                            if (c_selectorgiven == 1)
-                            {
-                               strcpy(c_selectordim.first,"1");
-                               strcpy(c_selectordim.last,c_selectorname);
-                               Save_Length(c_selectorname,1);
-                               change_dim_char
-                                     (insertdim(NULL,c_selectordim),curlistvar);
-                            }
-                         }
-                         (yyval.l)=curlistvar;
-                      }
-                      strcpy(vallengspec,"");
-                   ;}
-    break;
-
-  case 177:
+                        }
+                        if ( inagrifcallargument != 1 || sameagrifargument ==1 )
+                        {
+                            Add_UsedInSubroutine_Var_1(truename);
+                        }
+                    }
+                    NotifyAgrifFunction_0(truename);
+                }
+            }
+            else
+            {
+                afterpercent = 0;
+            }
+        }
+    break;
+
+  case 329:
+/* Line 1807 of yacc.c  */
+#line 1285 "fortran.y"
+    { strcpy((yyval.na),".TRUE.");}
+    break;
+
+  case 330:
+/* Line 1807 of yacc.c  */
+#line 1286 "fortran.y"
+    { strcpy((yyval.na),".FALSE.");}
+    break;
+
+  case 331:
+/* Line 1807 of yacc.c  */
+#line 1287 "fortran.y"
+    { strcpy((yyval.na),"NULL()"); }
+    break;
+
+  case 332:
+/* Line 1807 of yacc.c  */
+#line 1288 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 333:
+/* Line 1807 of yacc.c  */
+#line 1289 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 334:
+/* Line 1807 of yacc.c  */
+#line 1290 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 335:
+/* Line 1807 of yacc.c  */
+#line 1292 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 337:
+/* Line 1807 of yacc.c  */
+#line 1296 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 339:
+/* Line 1807 of yacc.c  */
+#line 1298 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 340:
+/* Line 1807 of yacc.c  */
+#line 1299 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 341:
+/* Line 1807 of yacc.c  */
+#line 1301 "fortran.y"
+    { strcpy((yyval.na)," ");}
+    break;
+
+  case 342:
+/* Line 1807 of yacc.c  */
+#line 1302 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 343:
+/* Line 1807 of yacc.c  */
+#line 1305 "fortran.y"
+    { sprintf((yyval.na),"(%s :%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));}
+    break;
+
+  case 344:
+/* Line 1807 of yacc.c  */
 #line 1307 "fortran.y"
-    {dimsgiven=0;;}
-    break;
-
-  case 178:
-#line 1310 "fortran.y"
-    {strcpy(DeclType,(yyvsp[(1) - (2)].nac));;}
-    break;
-
-  case 179:
+    { strcpy((yyval.na)," ");}
+    break;
+
+  case 345:
+/* Line 1807 of yacc.c  */
+#line 1308 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 346:
+/* Line 1807 of yacc.c  */
+#line 1311 "fortran.y"
+    { strcpy((yyval.na)," ");}
+    break;
+
+  case 347:
+/* Line 1807 of yacc.c  */
 #line 1312 "fortran.y"
-    {
-                      strcpy(DeclType,"CHARACTER");
-                   ;}
-    break;
-
-  case 180:
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 348:
+/* Line 1807 of yacc.c  */
+#line 1314 "fortran.y"
+    { InitialValueGiven = 0; }
+    break;
+
+  case 349:
+/* Line 1807 of yacc.c  */
 #line 1316 "fortran.y"
     {
-                      strcpy(DeclType,(yyvsp[(1) - (3)].nac));
-                      strcpy(nameinttypename,(yyvsp[(3) - (3)].nac));
-                   ;}
-    break;
-
-  case 181:
-#line 1321 "fortran.y"
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,(yyvsp[(2) - (2)].na));
+            InitialValueGiven = 1;
+        }
+    break;
+
+  case 350:
+/* Line 1807 of yacc.c  */
+#line 1322 "fortran.y"
     {
-                      strcpy(DeclType,"TYPE");
-                      GlobalDeclarationType = 1
-                   ;}
-    break;
-
-  case 182:
-#line 1327 "fortran.y"
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,(yyvsp[(2) - (2)].na));
+            InitialValueGiven = 2;
+        }
+    break;
+
+  case 351:
+/* Line 1807 of yacc.c  */
+#line 1329 "fortran.y"
+    {sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 352:
+/* Line 1807 of yacc.c  */
+#line 1333 "fortran.y"
     {
-                 /*     if ( couldaddvariable == 1 ) VarTypepar = 1 ;
-                      couldaddvariable = 0 ;
-                      pos_cur_decl = setposcur()-5;*/
-                   pos_cur_decl = setposcur()-5;
-                   ;}
-    break;
-
-  case 184:
-#line 1336 "fortran.y"
-    {c_selectorgiven=1;strcpy(c_selectorname,(yyvsp[(2) - (2)].nac));;}
-    break;
-
-  case 185:
-#line 1337 "fortran.y"
-    {c_star = 1;;}
-    break;
-
-  case 190:
-#line 1345 "fortran.y"
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule, "%s", (yyvsp[(2) - (2)].na));
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (2)].na));
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuse_0((yyvsp[(2) - (2)].na));
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+    break;
+
+  case 353:
+/* Line 1807 of yacc.c  */
+#line 1353 "fortran.y"
     {
-                      pos_cur_decl = setposcur()-9;
-                   ;}
-    break;
-
-  case 191:
-#line 1349 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 192:
-#line 1352 "fortran.y"
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1((yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].lc));
+                    coupletmp = (yyvsp[(4) - (4)].lc);
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne, coupletmp->c_namevar);
+                        strcat(ligne, " => ");
+                        strcat(ligne, coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",(yyvsp[(2) - (4)].na));
+                }
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (4)].na));
+            }
+            if ( inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+            }
+        }
+    break;
+
+  case 354:
+/* Line 1807 of yacc.c  */
+#line 1380 "fortran.y"
     {
-                      strcpy((yyval.nac),"INTEGER");
-                      pos_cur_decl = setposcur()-7;
-                   ;}
-    break;
-
-  case 193:
-#line 1356 "fortran.y"
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].na));
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].na));
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuseonly_0((yyvsp[(2) - (6)].na));
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+    break;
+
+  case 355:
+/* Line 1807 of yacc.c  */
+#line 1400 "fortran.y"
     {
-                      strcpy((yyval.nac),"REAL");
-                      pos_cur_decl = setposcur()-4;
-                   ;}
-    break;
-
-  case 194:
-#line 1361 "fortran.y"
-    {strcpy((yyval.nac),"COMPLEX");
-                   pos_cur_decl = setposcur()-7;;}
-    break;
-
-  case 195:
-#line 1364 "fortran.y"
+            /* if variables has been declared in a subroutine      */
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1((yyvsp[(2) - (6)].na),(yyvsp[(6) - (6)].lc));
+                    coupletmp = (yyvsp[(6) - (6)].lc);
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne,coupletmp->c_namevar);
+                        if ( strcasecmp(coupletmp->c_namepointedvar,"") )   strcat(ligne," => ");
+                        strcat(ligne,coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].na));
+                }
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].na));
+            }
+            else /* if ( firstpass == 0 ) */
+            {
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                    if (oldfortran_out)  variableisglobalinmodule((yyvsp[(6) - (6)].lc),(yyvsp[(2) - (6)].na),oldfortran_out,pos_curuseold);
+                }
+                else
+                {
+                    /* if we are in the module declare and if the    */
+                    /* onlylist is a list of global variable         */
+                    variableisglobalinmodule((yyvsp[(6) - (6)].lc), (yyvsp[(2) - (6)].na), fortran_out,pos_curuse);
+                }
+            }
+        }
+    break;
+
+  case 356:
+/* Line 1807 of yacc.c  */
+#line 1440 "fortran.y"
     {
-                      pos_cur_decl = setposcur()-16;
-                      strcpy((yyval.nac),"REAL");
-                      strcpy(nameinttypename,"8");
-                   ;}
-    break;
-
-  case 196:
-#line 1370 "fortran.y"
-    {strcpy((yyval.nac),"DOUBLE COMPLEX");;}
-    break;
-
-  case 197:
-#line 1372 "fortran.y"
+            pos_curuse = setposcur()-strlen((yyvsp[(1) - (1)].na));
+            if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);
+        }
+    break;
+
+  case 357:
+/* Line 1807 of yacc.c  */
+#line 1447 "fortran.y"
     {
-                      strcpy((yyval.nac),"LOGICAL");
-                      pos_cur_decl = setposcur()-7;
-                   ;}
-    break;
-
-  case 199:
-#line 1378 "fortran.y"
-    {strcpy(vallengspec,(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 200:
-#line 1380 "fortran.y"
-    {sprintf((yyval.na),"*%s",(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 201:
-#line 1381 "fortran.y"
-    {strcpy((yyval.na),"*(*)");;}
-    break;
-
-  case 208:
-#line 1392 "fortran.y"
+            (yyval.lc) = (yyvsp[(1) - (1)].lc);
+        }
+    break;
+
+  case 358:
+/* Line 1807 of yacc.c  */
+#line 1451 "fortran.y"
     {
-                      if ( strstr((yyvsp[(3) - (3)].na),"0.d0") )
-                      {
-                         strcpy(nameinttypename,"8");
-                         sprintf(NamePrecision,"");
-                      }
-                      else sprintf(NamePrecision,"%s = %s",(yyvsp[(1) - (3)].nac),(yyvsp[(3) - (3)].na));
-                   ;}
-    break;
-
-  case 209:
-#line 1401 "fortran.y"
+            /* insert the variable in the list $1                 */
+            (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
+            (yyval.lc) = (yyvsp[(3) - (3)].lc);
+        }
+    break;
+
+  case 359:
+/* Line 1807 of yacc.c  */
+#line 1458 "fortran.y"
     {
-                      strcpy(NamePrecision,(yyvsp[(1) - (1)].nac));
-                   ;}
-    break;
-
-  case 210:
-#line 1405 "fortran.y"
+            coupletmp = (listcouple *) calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].na));
+            strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].na));
+            coupletmp->suiv = NULL;
+            (yyval.lc) = coupletmp;
+        }
+    break;
+
+  case 360:
+/* Line 1807 of yacc.c  */
+#line 1467 "fortran.y"
+    {  (yyval.lc) = (yyvsp[(1) - (1)].lc); }
+    break;
+
+  case 361:
+/* Line 1807 of yacc.c  */
+#line 1469 "fortran.y"
     {
-                      strcpy(NamePrecision,(yyvsp[(1) - (1)].nac));
-                   ;}
-    break;
-
-  case 211:
-#line 1409 "fortran.y"
-    {strcpy(CharacterSize,(yyvsp[(1) - (1)].na));
-                    strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 212:
-#line 1411 "fortran.y"
-    {strcpy(CharacterSize,"*");
-                    strcpy((yyval.na),"*");;}
-    break;
-
-  case 220:
-#line 1425 "fortran.y"
+            /* insert the variable in the list $1                 */
+            (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
+            (yyval.lc) = (yyvsp[(3) - (3)].lc);
+        }
+    break;
+
+  case 362:
+/* Line 1807 of yacc.c  */
+#line 1477 "fortran.y"
     {
-                      VariableIsParameter = 1;
-                   ;}
-    break;
-
-  case 222:
-#line 1430 "fortran.y"
-    {Allocatabledeclare = 1;;}
-    break;
-
-  case 223:
-#line 1432 "fortran.y"
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].na));
+            strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].na));
+            coupletmp->suiv = NULL;
+            (yyval.lc) = coupletmp;
+            pointedvar = 1;
+            Add_UsedInSubroutine_Var_1((yyvsp[(1) - (3)].na));
+        }
+    break;
+
+  case 363:
+/* Line 1807 of yacc.c  */
+#line 1487 "fortran.y"
     {
-                      dimsgiven=1;
-                      curdim=(yyvsp[(2) - (2)].d);
-                   ;}
-    break;
-
-  case 224:
-#line 1437 "fortran.y"
-    {ExternalDeclare = 1;;}
-    break;
-
-  case 225:
-#line 1439 "fortran.y"
-    {strcpy(IntentSpec,(yyvsp[(3) - (4)].nac));;}
-    break;
-
-  case 227:
-#line 1441 "fortran.y"
-    {optionaldeclare = 1 ;;}
-    break;
-
-  case 228:
-#line 1442 "fortran.y"
-    {pointerdeclare = 1 ;;}
-    break;
-
-  case 229:
-#line 1443 "fortran.y"
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,(yyvsp[(1) - (1)].na));
+            strcpy(coupletmp->c_namepointedvar,"");
+            coupletmp->suiv = NULL;
+            (yyval.lc) = coupletmp;
+        }
+    break;
+
+  case 380:
+/* Line 1807 of yacc.c  */
+#line 1522 "fortran.y"
+    { inallocate = 0; }
+    break;
+
+  case 381:
+/* Line 1807 of yacc.c  */
+#line 1523 "fortran.y"
+    { inallocate = 0; }
+    break;
+
+  case 388:
+/* Line 1807 of yacc.c  */
+#line 1531 "fortran.y"
     {
-/*                       if ( inmodulemeet == 1 )
-                       {*/
-                          SaveDeclare = 1 ;
-                     /*  }*/
-                    ;}
-    break;
-
-  case 230:
-#line 1450 "fortran.y"
-    {Targetdeclare = 1;;}
-    break;
-
-  case 231:
-#line 1452 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 232:
-#line 1453 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 233:
-#line 1454 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac)); ;}
-    break;
-
-  case 234:
-#line 1457 "fortran.y"
-    {PublicDeclare = 1;;}
-    break;
-
-  case 235:
-#line 1459 "fortran.y"
-    {PrivateDeclare = 1;;}
-    break;
-
-  case 236:
-#line 1461 "fortran.y"
-    {if ( created_dimensionlist == 1 )
-                       {
-                           (yyval.d)=(listdim *)NULL;
-                       }
-                   ;}
-    break;
-
-  case 237:
-#line 1467 "fortran.y"
-    {if ( created_dimensionlist == 1 ||
-                         agrif_parentcall      == 1 ) (yyval.d)=(yyvsp[(2) - (3)].d);;}
-    break;
-
-  case 238:
-#line 1470 "fortran.y"
-    {if ( created_dimensionlist == 1 ||
-                         agrif_parentcall      == 1 ) (yyval.d)=insertdim(NULL,(yyvsp[(1) - (1)].dim1));;}
-    break;
-
-  case 239:
-#line 1473 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                         if ( created_dimensionlist == 1 ) (yyval.d)=insertdim((yyvsp[(1) - (3)].d),(yyvsp[(3) - (3)].dim1));;}
-    break;
-
-  case 240:
-#line 1476 "fortran.y"
+            GlobalDeclaration = 0 ;
+            if ( firstpass == 0 && strcasecmp(subroutinename,"") )
+            {
+                if ( module_declar && insubroutinedeclare == 0 )    fclose(module_declar);
+            }
+            if ( strcasecmp(subroutinename,"") )
+            {
+                if ( inmodulemeet == 1 )
+                {
+                    /* we are in a module                                */
+                    if ( insubroutinedeclare == 1 )
+                    {
+                        /* it is like an end subroutine <name>            */
+                        insubroutinedeclare = 0 ;
+                        pos_cur = setposcur();
+                        closeandcallsubloopandincludeit_0(1);
+                        functiondeclarationisdone = 0;
+                    }
+                    else
+                    {
+                        /* it is like an end module <name>                */
+                        inmoduledeclare = 0 ;
+                        inmodulemeet = 0 ;
+                    }
+                }
+                else
+                {
+                    insubroutinedeclare = 0;
+                    pos_cur = setposcur();
+                    closeandcallsubloopandincludeit_0(2);
+                    functiondeclarationisdone = 0;
+                }
+            }
+            strcpy(subroutinename,"");
+        }
+    break;
+
+  case 389:
+/* Line 1807 of yacc.c  */
+#line 1568 "fortran.y"
     {
-                      strcpy((yyval.dim1).first,"1");
-                      strcpy((yyval.dim1).last,(yyvsp[(1) - (1)].na));
-                      Save_Length((yyvsp[(1) - (1)].na),1);
-                   ;}
-    break;
-
-  case 241:
-#line 1481 "fortran.y"
+            insubroutinedeclare = 0;
+            inprogramdeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(3);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+    break;
+
+  case 390:
+/* Line 1807 of yacc.c  */
+#line 1577 "fortran.y"
     {
-                      strcpy((yyval.dim1).first,"");
-                      strcpy((yyval.dim1).last,"");
-                   ;}
-    break;
-
-  case 242:
-#line 1485 "fortran.y"
+            if ( strcasecmp(subroutinename,"") )
+            {
+                insubroutinedeclare = 0;
+                pos_cur = setposcur();
+                closeandcallsubloopandincludeit_0(1);
+                functiondeclarationisdone = 0;
+                strcpy(subroutinename,"");
+            }
+        }
+    break;
+
+  case 391:
+/* Line 1807 of yacc.c  */
+#line 1588 "fortran.y"
     {
-                      strcpy((yyval.dim1).first,(yyvsp[(1) - (2)].na));
-                      Save_Length((yyvsp[(1) - (2)].na),2);
-                      strcpy((yyval.dim1).last,"");
-                   ;}
-    break;
-
-  case 243:
-#line 1490 "fortran.y"
+            insubroutinedeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(0);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+    break;
+
+  case 392:
+/* Line 1807 of yacc.c  */
+#line 1596 "fortran.y"
     {
-                      strcpy((yyval.dim1).first,"");
-                      strcpy((yyval.dim1).last,(yyvsp[(2) - (2)].na));
-                      Save_Length((yyvsp[(2) - (2)].na),1);
-                   ;}
-    break;
-
-  case 244:
-#line 1496 "fortran.y"
+            /* if we never meet the contains keyword               */
+            if ( firstpass == 0 )
+            {
+                RemoveWordCUR_0(fortran_out, strlen((yyvsp[(2) - (2)].na))+11);    // Remove word "end module"
+                if ( inmoduledeclare && ! aftercontainsdeclare )
+                {
+                    Write_Closing_Module(1);
+                }
+                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
+                if ( module_declar && insubroutinedeclare == 0 )
+                {
+                    fclose(module_declar);
+                }
+            }
+            inmoduledeclare = 0 ;
+            inmodulemeet = 0 ;
+            aftercontainsdeclare = 1;
+            strcpy(curmodulename, "");
+            GlobalDeclaration = 0 ;
+        }
+    break;
+
+  case 395:
+/* Line 1807 of yacc.c  */
+#line 1620 "fortran.y"
     {
-                      strcpy((yyval.dim1).first,(yyvsp[(1) - (3)].na));
-                      Save_Length((yyvsp[(1) - (3)].na),2);
-                      strcpy((yyval.dim1).last,(yyvsp[(3) - (3)].na));
-                      Save_Length((yyvsp[(3) - (3)].na),1);
-                   ;}
-    break;
-
-  case 245:
-#line 1503 "fortran.y"
-    {strcpy((yyval.na),"*");;}
-    break;
-
-  case 246:
-#line 1504 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 247:
-#line 1506 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 248:
-#line 1508 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 249:
-#line 1510 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 250:
-#line 1512 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 251:
-#line 1516 "fortran.y"
-    {sprintf((yyval.na),"SUM(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 252:
-#line 1518 "fortran.y"
-    {sprintf((yyval.na),"MAX(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 253:
-#line 1520 "fortran.y"
-    {sprintf((yyval.na),"TANH(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 254:
-#line 1522 "fortran.y"
-    {sprintf((yyval.na),"MAXVAL(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 255:
-#line 1524 "fortran.y"
-    {sprintf((yyval.na),"MIN(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 256:
-#line 1526 "fortran.y"
-    {sprintf((yyval.na),"MINVAL(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 257:
-#line 1528 "fortran.y"
-    {sprintf((yyval.na),"TRIM(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 258:
-#line 1530 "fortran.y"
-    {sprintf((yyval.na),"SQRT(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 259:
-#line 1532 "fortran.y"
-    {sprintf((yyval.na),"REAL(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 260:
-#line 1534 "fortran.y"
-    {sprintf((yyval.na),"NINT(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 261:
-#line 1536 "fortran.y"
-    {sprintf((yyval.na),"FLOAT(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 262:
-#line 1538 "fortran.y"
-    {sprintf((yyval.na),"EXP(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 263:
-#line 1540 "fortran.y"
-    {sprintf((yyval.na),"COS(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 264:
-#line 1542 "fortran.y"
-    {sprintf((yyval.na),"COSH(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 265:
-#line 1544 "fortran.y"
-    {sprintf((yyval.na),"ACOS(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 266:
-#line 1546 "fortran.y"
-    {sprintf((yyval.na),"SIN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 267:
-#line 1548 "fortran.y"
-    {sprintf((yyval.na),"SINH(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 268:
-#line 1550 "fortran.y"
-    {sprintf((yyval.na),"ASIN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 269:
-#line 1552 "fortran.y"
-    {sprintf((yyval.na),"LOG(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 270:
-#line 1554 "fortran.y"
-    {sprintf((yyval.na),"TAN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 271:
-#line 1556 "fortran.y"
-    {sprintf((yyval.na),"ATAN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 272:
-#line 1558 "fortran.y"
-    {sprintf((yyval.na),"ABS(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 273:
-#line 1560 "fortran.y"
-    {sprintf((yyval.na),"MOD(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 274:
-#line 1562 "fortran.y"
-    {sprintf((yyval.na),"SIGN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 275:
-#line 1564 "fortran.y"
-    {sprintf((yyval.na),"MINLOC(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 276:
-#line 1566 "fortran.y"
-    {sprintf((yyval.na),"MAXLOC(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 277:
-#line 1568 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 278:
-#line 1570 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                   { strcpy((yyval.na),(yyvsp[(1) - (3)].na));strcat((yyval.na),",");strcat((yyval.na),(yyvsp[(3) - (3)].na));};}
-    break;
-
-  case 279:
-#line 1573 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 280:
-#line 1575 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 281:
-#line 1577 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 282:
-#line 1579 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 283:
-#line 1581 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 284:
-#line 1583 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 285:
-#line 1585 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"+");;}
-    break;
-
-  case 286:
-#line 1586 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"-");;}
-    break;
-
-  case 287:
-#line 1589 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"+%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 288:
-#line 1591 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"-%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 289:
-#line 1593 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 290:
-#line 1595 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 291:
-#line 1597 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 292:
-#line 1599 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 293:
-#line 1601 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 294:
-#line 1603 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," > %s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 295:
-#line 1605 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 296:
-#line 1607 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," < %s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 297:
-#line 1609 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 298:
-#line 1611 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," >= %s",(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 299:
-#line 1613 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 300:
-#line 1615 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," <= %s",(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 301:
-#line 1617 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 302:
-#line 1619 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 303:
-#line 1621 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 304:
-#line 1623 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 305:
-#line 1625 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 306:
-#line 1627 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 307:
-#line 1629 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 308:
-#line 1631 "fortran.y"
-    {strcpy((yyval.na),"");;}
-    break;
-
-  case 309:
-#line 1633 "fortran.y"
-    {sprintf((yyval.na),"/%s",(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 310:
-#line 1635 "fortran.y"
-    {sprintf((yyval.na),"/= %s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 311:
-#line 1637 "fortran.y"
-    {sprintf((yyval.na),"//%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 312:
-#line 1640 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"==%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 313:
-#line 1642 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"= %s",(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 314:
-#line 1645 "fortran.y"
-    {if ( couldaddvariable == 1 )
-						{
-						printf("ident = %s\n",(yyvsp[(1) - (1)].nac));
-						strcpy((yyval.na),(yyvsp[(1) - (1)].nac));}
-						;}
-    break;
-
-  case 315:
-#line 1651 "fortran.y"
-    {if ( couldaddvariable == 1 ) {
-                   printf("struct = %s\n",(yyvsp[(1) - (1)].na));
-                   strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
-                   ;}
-    break;
-
-  case 316:
-#line 1656 "fortran.y"
-    {if ( couldaddvariable == 1 ) {
-                   printf("arrayref = %s\n",(yyvsp[(1) - (1)].na));
-                   strcpy((yyval.na),(yyvsp[(1) - (1)].na));
-                   };}
-    break;
-
-  case 317:
-#line 1661 "fortran.y"
+            if ( inside_type_declare ) break;
+            if ( inmoduledeclare )
+            {
+                if ( firstpass == 0 )
+                {
+                    RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
+                    Write_Closing_Module(0);
+                }
+                inmoduledeclare = 0 ;
+                aftercontainsdeclare = 1;
+            }
+            else if ( insubroutinedeclare )
+            {
+                incontainssubroutine = 1;
+                insubroutinedeclare  = 0;
+                incontainssubroutine = 0;
+                functiondeclarationisdone = 0;
+
+                if ( firstpass )
+                    List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0);
+                else
+                    closeandcallsubloop_contains_0();
+
+                strcpy(subroutinename, "");
+            }
+            else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input);
+        }
+    break;
+
+  case 483:
+/* Line 1807 of yacc.c  */
+#line 1898 "fortran.y"
     {
-                      agrif_parentcall =0;
-                      if (!strcasecmp(identcopy,"Agrif_Parent") )
-                                                            agrif_parentcall =1;
-                      if ( Agrif_in_Tok_NAME(identcopy) == 1 )
-                      {
-                         inagrifcallargument = 1;
-                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                      }
-                   ;}
-    break;
-
-  case 318:
-#line 1674 "fortran.y"
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+            functiondeclarationisdone = 0;
+        }
+    break;
+
+  case 484:
+/* Line 1807 of yacc.c  */
+#line 1906 "fortran.y"
     {
-                     strcpy((yyval.na),(yyvsp[(1) - (1)].na));
-                     if ( incalldeclare == 0 ) inagrifcallargument = 0;
-                   ;}
-    break;
-
-  case 319:
-#line 1679 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," %s %s ",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 320:
-#line 1681 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                                sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 321:
-#line 1684 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                         sprintf((yyval.na)," %s ( %s ) %s ",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
-    break;
-
-  case 322:
-#line 1688 "fortran.y"
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+        }
+    break;
+
+  case 485:
+/* Line 1807 of yacc.c  */
+#line 1913 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].nac),(yyvsp[(3) - (4)].na));
-                         ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].na));
-                         agrif_parentcall =0;
-                      }
-                   ;}
-    break;
-
-  case 323:
-#line 1698 "fortran.y"
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+        }
+    break;
+
+  case 486:
+/* Line 1807 of yacc.c  */
+#line 1920 "fortran.y"
     {
-                      sprintf((yyval.na)," %s %% %s ",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));
-                      if ( incalldeclare == 0 ) inagrifcallargument = 0;
-                   ;}
-    break;
-
-  case 324:
-#line 1704 "fortran.y"
-    {sprintf((yyval.na),"(/%s/)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 325:
-#line 1706 "fortran.y"
-    {strcpy((yyval.na)," ");;}
-    break;
-
-  case 326:
-#line 1708 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 327:
-#line 1710 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 328:
-#line 1712 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 329:
-#line 1714 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 330:
-#line 1715 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 331:
-#line 1718 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s :%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 332:
-#line 1720 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                               sprintf((yyval.na),"%s :%s :%s",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
-    break;
-
-  case 333:
-#line 1723 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":%s :%s",(yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].na));;}
-    break;
-
-  case 334:
-#line 1724 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),": : %s",(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 335:
-#line 1725 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 336:
-#line 1726 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s :",(yyvsp[(1) - (2)].na));;}
-    break;
-
-  case 337:
-#line 1727 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":");;}
-    break;
-
-  case 338:
-#line 1729 "fortran.y"
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+        }
+    break;
+
+  case 487:
+/* Line 1807 of yacc.c  */
+#line 1926 "fortran.y"
+    {strcpy((yyval.na),"");}
+    break;
+
+  case 488:
+/* Line 1807 of yacc.c  */
+#line 1927 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 489:
+/* Line 1807 of yacc.c  */
+#line 1930 "fortran.y"
+    { created_dimensionlist = 0; }
+    break;
+
+  case 490:
+/* Line 1807 of yacc.c  */
+#line 1934 "fortran.y"
     {
-                       if ( couldaddvariable == 1 && afterpercent == 0)
-                       {
-                       if ( Vartonumber((yyvsp[(1) - (1)].nac)) == 1 )
-                       {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                       if (!strcasecmp((yyvsp[(1) - (1)].nac),"Agrif_Parent") )
-                                                            agrif_parentcall =1;
-                       if ( VariableIsNotFunction((yyvsp[(1) - (1)].nac)) == 0 )
-                       {
-                       printf("var = %s\n",(yyvsp[(1) - (1)].nac));
-                          if ( inagrifcallargument == 1 )
-                          {
-                             if ( !strcasecmp((yyvsp[(1) - (1)].nac),identcopy) )
-                             {
-                                strcpy(sameagrifname,identcopy);
-                                sameagrifargument = 1;
-                             }
-                          }
-                          strcpy(identcopy,(yyvsp[(1) - (1)].nac));
-                          pointedvar=0;
-                          strcpy(truename,(yyvsp[(1) - (1)].nac));
-                          if (variscoupled_0((yyvsp[(1) - (1)].nac))) strcpy(truename,getcoupledname_0((yyvsp[(1) - (1)].nac)));
-
-                          if ( VarIsNonGridDepend(truename) == 0 &&
-                               Variableshouldberemove(truename) == 0 )
-                          {                      
-                             if ( inagrifcallargument == 1 ||
-                                  varispointer_0(truename) == 1 )
-                             {
-                             printf("var2 = %s\n",(yyvsp[(1) - (1)].nac));
-                            if ((IsinListe(List_UsedInSubroutine_Var,(yyvsp[(1) - (1)].nac)) == 1) || (inagrifcallargument == 1))
-                             {
-                              if (varistyped_0(truename) == 0)
-                                 {
-                                 ModifyTheVariableName_0(truename,strlen((yyvsp[(1) - (1)].nac)));
-                                 }
-                                 }
-                             }
-                             printf("ici3\n");
-                             if ( inagrifcallargument != 1 ||
-                                  sameagrifargument ==1 )
-                                  {
-                                  printf("ici5 %s\n",truename);
-                                  Add_UsedInSubroutine_Var_1(truename);
-                          }
-                          }
-                          NotifyAgrifFunction_0(truename);
-                       }
-                       }
-                       else
-                       {
-                       afterpercent = 0;
-                    }
-                    ;}
-    break;
-
-  case 339:
-#line 1788 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),".TRUE.");;}
-    break;
-
-  case 340:
-#line 1789 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),".FALSE.");;}
-    break;
-
-  case 341:
-#line 1790 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 342:
-#line 1791 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 343:
-#line 1792 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 344:
-#line 1793 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 345:
-#line 1795 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.nac),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].nac));;}
-    break;
-
-  case 347:
-#line 1799 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 349:
-#line 1802 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 350:
-#line 1804 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 351:
-#line 1806 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
-    break;
-
-  case 352:
-#line 1807 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 353:
-#line 1810 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s :%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 354:
-#line 1812 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
-    break;
-
-  case 355:
-#line 1813 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 356:
-#line 1815 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
-    break;
-
-  case 357:
-#line 1816 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 358:
-#line 1818 "fortran.y"
-    {   strcpy(InitialValueGiven," ");;}
-    break;
-
-  case 359:
-#line 1820 "fortran.y"
+            created_dimensionlist = 1;
+            if ( ((yyvsp[(3) - (4)].d) == NULL) || ((yyvsp[(4) - (4)].d) == NULL) ) break;
+            if  ( agrif_parentcall == 1 )
+            {
+                ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].d)->dim.last);
+                agrif_parentcall = 0;
+                fprintf(fortran_out," = ");
+            }
+        }
+    break;
+
+  case 491:
+/* Line 1807 of yacc.c  */
+#line 1945 "fortran.y"
     {
-                       if ( couldaddvariable == 1 )
-                       {
-                          strcpy(InitValue,(yyvsp[(3) - (3)].na));
-                          strcpy(InitialValueGiven,"=");
-                       }
-                    ;}
-    break;
-
-  case 360:
-#line 1828 "fortran.y"
+            created_dimensionlist = 1;
+        }
+    break;
+
+  case 496:
+/* Line 1807 of yacc.c  */
+#line 1958 "fortran.y"
     {
-                       if ( couldaddvariable == 1 )
-                       {
-                          strcpy(InitValue,(yyvsp[(3) - (3)].na));
-                          strcpy(InitialValueGiven,"=>");
-                       }
-                    ;}
-    break;
-
-  case 361:
-#line 1836 "fortran.y"
-    {pos_curinit = setposcur();;}
-    break;
-
-  case 362:
-#line 1839 "fortran.y"
-    {sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 363:
-#line 1842 "fortran.y"
+            inagrifcallargument = 0 ;
+            incalldeclare=0;
+            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
+                strcpy(subofagrifinitgrids,subroutinename);
+            }
+            Instanciation_0(sameagrifname);
+        }
+    break;
+
+  case 502:
+/* Line 1807 of yacc.c  */
+#line 1979 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                      /* if variables has been declared in a subroutine       */
-                      if (insubroutinedeclare == 1)
-                      {
-                         copyuse_0((yyvsp[(2) - (2)].nac));
-                      }
-                      sprintf(charusemodule,"%s",(yyvsp[(2) - (2)].nac));
-                      Add_NameOfModuleUsed_1((yyvsp[(2) - (2)].nac));
-
-                      if ( inmoduledeclare == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curuse,
-                                               pos_end-pos_curuse);
-                      }
-                      }
-                    ;}
-    break;
-
-  case 364:
-#line 1862 "fortran.y"
+            if (!strcasecmp((yyvsp[(2) - (2)].na),"MPI_Init") )    callmpiinit = 1;
+            else                                callmpiinit = 0;
+
+            if (!strcasecmp((yyvsp[(2) - (2)].na),"Agrif_Init_Grids") )
+            {
+                callagrifinitgrids = 1;
+                strcpy(meetagrifinitgrids,subroutinename);
+            }
+            else
+            {
+                callagrifinitgrids = 0;
+            }
+            if ( Vartonumber((yyvsp[(2) - (2)].na)) == 1 )
+            {
+                incalldeclare = 1;
+                inagrifcallargument = 1 ;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+    break;
+
+  case 503:
+/* Line 1807 of yacc.c  */
+#line 2000 "fortran.y"
+    { pos_curcall=setposcur()-4; }
+    break;
+
+  case 506:
+/* Line 1807 of yacc.c  */
+#line 2008 "fortran.y"
     {
-                       if ( couldaddvariable == 1 )
-                       {
-                      if (insubroutinedeclare == 1)
-                      {
-                         Add_CouplePointed_Var_1((yyvsp[(2) - (4)].nac),(yyvsp[(4) - (4)].lc));
-                      }
-                      if ( firstpass == 1 )
-                      {
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            coupletmp = (yyvsp[(4) - (4)].lc);
-                            strcpy(ligne,"");
-                            while ( coupletmp )
-                            {
-                               strcat(ligne,coupletmp->c_namevar);
-                               strcat(ligne," => ");
-                               strcat(ligne,coupletmp->c_namepointedvar);
-                               coupletmp = coupletmp->suiv;
-                               if ( coupletmp ) strcat(ligne,",");
-                            }
-                            sprintf(charusemodule,"%s",(yyvsp[(2) - (4)].nac));
-                         }
-                         Add_NameOfModuleUsed_1((yyvsp[(2) - (4)].nac));
-                      }
-                      if ( inmoduledeclare == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curuse,
-                                               pos_end-pos_curuse);
-                      }
-                      }
-                    ;}
-    break;
-
-  case 365:
-#line 1896 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                      /* if variables has been declared in a subroutine       */
-                      if (insubroutinedeclare == 1)
-                      {
-                         copyuseonly_0((yyvsp[(2) - (6)].nac));
-                      }
-                      sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].nac));
-                      Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].nac));
-
-                       if ( inmoduledeclare == 0 )
-                       {
-                          pos_end = setposcur();
-                          RemoveWordSET_0(fortranout,pos_curuse,
-                                                pos_end-pos_curuse);
-                       }
-                       }
-                    ;}
-    break;
-
-  case 366:
-#line 1916 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       /* if variables has been declared in a subroutine      */
-                       if (insubroutinedeclare == 1)
-                       {
-                          Add_CouplePointed_Var_1((yyvsp[(2) - (6)].nac),(yyvsp[(6) - (6)].lc));
-                       }
-                       if ( firstpass == 1 )
-                       {
-                         if ( insubroutinedeclare == 1 )
-                         {
-                             coupletmp = (yyvsp[(6) - (6)].lc);
-                             strcpy(ligne,"");
-                             while ( coupletmp )
-                             {
-                                strcat(ligne,coupletmp->c_namevar);
-                               if ( strcasecmp(coupletmp->c_namepointedvar,"") )
-                                                           strcat(ligne," => ");
-                                strcat(ligne,coupletmp->c_namepointedvar);
-                                coupletmp = coupletmp->suiv;
-                                if ( coupletmp ) strcat(ligne,",");
-                             }
-                             sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].nac));
-                          }
-                          Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].nac));
-                       }
-                       if ( firstpass == 0 )
-                       {
-                          if ( inmoduledeclare == 0 )
-                          {
-
-                            pos_end = setposcur();
-                             RemoveWordSET_0(fortranout,pos_curuse,
-                                                   pos_end-pos_curuse);
-                       if (oldfortranout) 
-                         variableisglobalinmodule((yyvsp[(6) - (6)].lc),(yyvsp[(2) - (6)].nac),oldfortranout,pos_curuseold);
-                        
-                          }
-                          else
-                          {
-
-                             /* if we are in the module declare and if the    */
-                             /* onlylist is a list of global variable         */
-                             variableisglobalinmodule((yyvsp[(6) - (6)].lc), (yyvsp[(2) - (6)].nac), fortranout,pos_curuse);
-                          }
-                       }
-                       }
-                    ;}
-    break;
-
-  case 367:
-#line 1967 "fortran.y"
-    {
-                      pos_curuse = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                     if (firstpass == 0 && oldfortranout) {
-                     pos_curuseold = setposcurname(oldfortranout);
-                     }
-                   ;}
-    break;
-
-  case 368:
-#line 1975 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 369:
-#line 1978 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 ) (yyval.lc) = (yyvsp[(1) - (1)].lc);
-                    ;}
-    break;
-
-  case 370:
-#line 1982 "fortran.y"
-    {
-                        if ( couldaddvariable == 1 )
-                        {
-                        /* insert the variable in the list $1                 */
-                        (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
-                        (yyval.lc) = (yyvsp[(3) - (3)].lc);
-                        }
-                    ;}
-    break;
-
-  case 371:
-#line 1992 "fortran.y"
-    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].nac));
-                       Save_Length((yyvsp[(1) - (3)].nac),21);
-                       strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].nac));
-                       Save_Length((yyvsp[(3) - (3)].nac),22);
-                       coupletmp->suiv = NULL;
-                       (yyval.lc) = coupletmp;
-                     ;}
-    break;
-
-  case 372:
-#line 2003 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 ) (yyval.lc) = (yyvsp[(1) - (1)].lc);
-                    ;}
-    break;
-
-  case 373:
-#line 2007 "fortran.y"
-    {
-                        if ( couldaddvariable == 1 )
-                        {
-                        /* insert the variable in the list $1                 */
-                        (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
-                        (yyval.lc) = (yyvsp[(3) - (3)].lc);
-                        }
-                    ;}
-    break;
-
-  case 374:
-#line 2017 "fortran.y"
-    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].nac));
-                       Save_Length((yyvsp[(1) - (3)].nac),21);
-                       strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].nac));
-                       Save_Length((yyvsp[(3) - (3)].nac),22);
-                       coupletmp->suiv = NULL;
-                       (yyval.lc) = coupletmp;
-                       pointedvar=1;
-                       Add_UsedInSubroutine_Var_1((yyvsp[(1) - (3)].nac));
-                    ;}
-    break;
-
-  case 375:
-#line 2028 "fortran.y"
-    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (1)].nac));
-                       Save_Length((yyvsp[(1) - (1)].nac),21);
-                       strcpy(coupletmp->c_namepointedvar,"");
-                       coupletmp->suiv = NULL;
-                       (yyval.lc) = coupletmp;
-                     ;}
-    break;
-
-  case 377:
-#line 2039 "fortran.y"
-    {
-                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     ;}
-    break;
-
-  case 378:
-#line 2045 "fortran.y"
-    {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                         curmodulename);
-                                                         inallocate = 0;
-                     ;}
-    break;
-
-  case 380:
-#line 2052 "fortran.y"
-    {
-                       GlobalDeclaration = 0 ;
-                       if ( firstpass == 0 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                          if ( module_declar && insubroutinedeclare == 0 )
-                          {
-                              fclose(module_declar);
-                          }
-                       }
-                       if ( couldaddvariable == 1 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                       if ( inmodulemeet == 1 )
-                       {
-                         /* we are in a module                                */
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            /* it is like an end subroutine <name>            */
-                            insubroutinedeclare = 0 ;
-                            /*                                                */
-                            pos_cur = setposcur();
-                            closeandcallsubloopandincludeit_0(1);
-                            functiondeclarationisdone = 0;
-                         }
-                         else
-                         {
-                            /* it is like an end module <name>                */
-                            inmoduledeclare = 0 ;
-                            inmodulemeet = 0 ;
-                         }
-                       }
-                       else
-                       {
-                          insubroutinedeclare = 0;
-                          /*                                                  */
-                          pos_cur = setposcur();                        
-                          closeandcallsubloopandincludeit_0(2);
-                            functiondeclarationisdone = 0;
-                          if ( firstpass == 0 )
-                          {
-                             if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                             else fprintf(paramout,"C\n");
-                             fclose(paramout);
-                           }
-                        }
-                      }
-                      strcpy(subroutinename,"");
-                    ;}
-    break;
-
-  case 381:
-#line 2102 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();                      
-                       closeandcallsubloopandincludeit_0(3);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    ;}
-    break;
-
-  case 382:
+            if ( callmpiinit == 1 )
+            {
+                strcpy(mpiinitvar,(yyvsp[(1) - (1)].na));
+                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
+            }
+        }
+    break;
+
+  case 532:
+/* Line 1807 of yacc.c  */
+#line 2056 "fortran.y"
+    { afterpercent = 1; }
+    break;
+
+  case 572:
+/* Line 1807 of yacc.c  */
+#line 2115 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 573:
+/* Line 1807 of yacc.c  */
+#line 2116 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 574:
+/* Line 1807 of yacc.c  */
+#line 2117 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 575:
+/* Line 1807 of yacc.c  */
+#line 2118 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 576:
+/* Line 1807 of yacc.c  */
+#line 2119 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 577:
+/* Line 1807 of yacc.c  */
 #line 2120 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();
-                                             
-                       closeandcallsubloopandincludeit_0(1);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    ;}
-    break;
-
-  case 383:
-#line 2140 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();
-
-                       closeandcallsubloopandincludeit_0(0);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    ;}
-    break;
-
-  case 384:
-#line 2159 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       /* if we never meet the contains keyword               */
-                      Remove_Word_end_module_0(strlen((yyvsp[(2) - (2)].nac)));
-                       if ( inmoduledeclare == 1 )
-                       {
-                          if ( aftercontainsdeclare == 0 )
-                          {
-                             Write_GlobalParameter_Declaration_0();
-                             Write_NotGridDepend_Declaration_0();
-                             Write_GlobalType_Declaration_0();
-                             if ( module_declar_type )
-                             {
-                             strcpy (ligne, "\n#include \"Module_DeclarType_");
-                             strcat (ligne, curmodulename);
-                             strcat (ligne, ".h\"\n");
-                             tofich(fortranout,ligne,1); 
-                             }
-                             Write_Alloc_Subroutine_For_End_0();
-                          }
-                       }
-                                           
-                       inmoduledeclare = 0 ;
-                       inmodulemeet = 0 ;
-
-                      Write_Word_end_module_0();
-                      strcpy(curmodulename,"");
-                      aftercontainsdeclare = 1;
-                      if ( firstpass == 0 )
-                      {
-                         if ( module_declar && insubroutinedeclare == 0)
-                         {
-                           fclose(module_declar);
-                         }
-                         if ( module_declar_type && insubroutinedeclare == 0)
-                         {
-                          fclose(module_declar_type);
-                          module_declar_type = 0;
-                         }
-                      }
-                      GlobalDeclaration = 0 ;
-                      }
-                  ;}
-    break;
-
-  case 398:
-#line 2217 "fortran.y"
-    {
-                      if (inmoduledeclare == 1 )
-                      {
-                         Remove_Word_Contains_0();
-                         Write_GlobalParameter_Declaration_0();
-                         Write_GlobalType_Declaration_0();
-                             if ( module_declar_type)
-                             {                         
-                             strcpy (ligne, "\n#include \"Module_DeclarType_");
-                             strcat (ligne, curmodulename);
-                             strcat (ligne, ".h\"\n");
-                             tofich(fortranout,ligne,1); 
-                             }
-                         Write_NotGridDepend_Declaration_0();
-                         Write_Alloc_Subroutine_0();
-                         inmoduledeclare = 0 ;
-                         aftercontainsdeclare = 1;
-                      }
-                      else
-                      {
-                      incontainssubroutine = 1;
-                      strcpy(previoussubroutinename,subroutinename);
-                       if ( couldaddvariable == 1 )
-                       {
-                          if ( firstpass == 1 ) List_ContainsSubroutine =
-                                                Addtolistnom(subroutinename,
-                                                     List_ContainsSubroutine,0);
-                          insubroutinedeclare = 0;
-                          /*                                                  */
-
-                          closeandcallsubloop_contains_0();
-                            functiondeclarationisdone = 0;
-                         if ( firstpass == 0 )
-                         {
-                            if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                            else fprintf(paramout,"C\n");
-                            fclose(paramout);
-                         }
-                         }
-                         strcpy(subroutinename,"");
-                      }
-                   ;}
-    break;
-
-  case 399:
-#line 2261 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       functiondeclarationisdone = 0;
-                       }
-                    ;}
-    break;
-
-  case 400:
-#line 2271 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       }
-                    ;}
-    break;
-
-  case 401:
-#line 2280 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       }
-                    ;}
-    break;
-
-  case 402:
-#line 2289 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       }
-                    ;}
-    break;
-
-  case 414:
-#line 2311 "fortran.y"
-    {strcpy((yyval.nac),"");;}
-    break;
-
-  case 415:
-#line 2312 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 425:
-#line 2332 "fortran.y"
-    {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     ;}
-    break;
-
-  case 426:
-#line 2338 "fortran.y"
-    {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     ;}
-    break;
-
-  case 432:
-#line 2349 "fortran.y"
-    {if ( couldaddvariable == 1 ) created_dimensionlist = 0;;}
-    break;
-
-  case 433:
-#line 2351 "fortran.y"
-    {
-                  created_dimensionlist = 1;
-                  if  ( agrif_parentcall == 1 )
-                  {
-                      ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].d)->dim.last);
-                      agrif_parentcall =0;
-                      fprintf(fortranout," = ");
-                  }
-              ;}
-    break;
-
-  case 434:
-#line 2361 "fortran.y"
-    {created_dimensionlist = 1;;}
-    break;
-
-  case 439:
-#line 2369 "fortran.y"
-    {
-                      inagrifcallargument = 0 ;
-                      incalldeclare=0;
-                      if ( oldfortranout &&
-                           !strcasecmp(meetagrifinitgrids,subroutinename) &&
-                           firstpass == 0 &&
-                           callmpiinit == 1)
-                      {
-                      /*   pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcall,
-                                               pos_end-pos_curcall);
-                         fprintf(oldfortranout,"      Call MPI_Init (%s) \n"
-                                                                   ,mpiinitvar);*/
-                      }
-                      if ( oldfortranout           &&
-                           callagrifinitgrids == 1 &&
-                           firstpass == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcall,
-                                               pos_end-pos_curcall);
-
-                         strcpy(subofagrifinitgrids,subroutinename);
-                      }
-                      Instanciation_0(sameagrifname);
-                   ;}
-    break;
-
-  case 444:
-#line 2403 "fortran.y"
-    {
-                       if (!strcasecmp((yyvsp[(2) - (2)].nac),"MPI_Init") )
-                       {
-                          callmpiinit = 1;
-                       }
-                       else
-                       {
-                          callmpiinit = 0;
-                       }
-                       if (!strcasecmp((yyvsp[(2) - (2)].nac),"Agrif_Init_Grids") )
-                       {
-                          callagrifinitgrids = 1;
-                          strcpy(meetagrifinitgrids,subroutinename);
-                       }
-                       else callagrifinitgrids = 0;
-                       if ( !strcasecmp((yyvsp[(2) - (2)].nac),"Agrif_Open_File") )
-                       {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                       if ( Vartonumber((yyvsp[(2) - (2)].nac)) == 1 )
-                       {
-                          incalldeclare=1;
-                          inagrifcallargument = 1 ;
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                    ;}
-    break;
-
-  case 445:
-#line 2433 "fortran.y"
-    {pos_curcall=setposcur()-4;;}
-    break;
-
-  case 448:
-#line 2438 "fortran.y"
-    {
-                  if ( callmpiinit == 1 )
-                  {
-                     strcpy(mpiinitvar,(yyvsp[(1) - (1)].na));
-                     if ( firstpass == 1 )
-                     {
-                        Add_UsedInSubroutine_Var_1 (mpiinitvar);
-/*                        curvar=createvar($1,NULL);
-                        curlistvar=insertvar(NULL,curvar);
-                        List_Subr outineArgument_Var = AddListvarToListvar
-                         (curlistvar,List_SubroutineAr gument_Var,1);*/
-                     }
-                  }
-               ;}
-    break;
-
-  case 520:
-#line 2562 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 521:
-#line 2563 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 522:
-#line 2564 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 523:
-#line 2567 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 524:
-#line 2569 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 525:
-#line 2571 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 526:
-#line 2573 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 527:
-#line 2575 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 528:
-#line 2577 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 529:
-#line 2578 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 530:
-#line 2579 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 531:
-#line 2582 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 532:
-#line 2584 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," (%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 533:
-#line 2586 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 534:
-#line 2588 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 535:
-#line 2590 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 536:
-#line 2594 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                              sprintf((yyval.na),"%s=%s,%s)",(yyvsp[(1) - (5)].nac),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
-    break;
-
-  case 537:
-#line 2597 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                        sprintf((yyval.na),"%s=%s,%s,%s)",(yyvsp[(1) - (7)].nac),(yyvsp[(3) - (7)].na),(yyvsp[(5) - (7)].na),(yyvsp[(7) - (7)].na));;}
-    break;
-
-  case 544:
-#line 2613 "fortran.y"
-    {Add_Allocate_Var_1((yyvsp[(1) - (1)].nac),curmodulename);;}
-    break;
-
-  case 547:
-#line 2618 "fortran.y"
-    {Add_Allocate_Var_1((yyvsp[(1) - (4)].nac),curmodulename);;}
-    break;
-
-  case 555:
-#line 2641 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-
-/* Line 1267 of yacc.c.  */
-#line 6522 "fortran.tab.c"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 578:
+/* Line 1807 of yacc.c  */
+#line 2121 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 579:
+/* Line 1807 of yacc.c  */
+#line 2122 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 580:
+/* Line 1807 of yacc.c  */
+#line 2123 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 581:
+/* Line 1807 of yacc.c  */
+#line 2124 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 582:
+/* Line 1807 of yacc.c  */
+#line 2127 "fortran.y"
+    { sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 583:
+/* Line 1807 of yacc.c  */
+#line 2128 "fortran.y"
+    { sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 584:
+/* Line 1807 of yacc.c  */
+#line 2129 "fortran.y"
+    { sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 585:
+/* Line 1807 of yacc.c  */
+#line 2131 "fortran.y"
+    { sprintf((yyval.na),"%s=%s,%s)",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));}
+    break;
+
+  case 586:
+/* Line 1807 of yacc.c  */
+#line 2132 "fortran.y"
+    { sprintf((yyval.na),"%s=%s,%s,%s)",(yyvsp[(1) - (7)].na),(yyvsp[(3) - (7)].na),(yyvsp[(5) - (7)].na),(yyvsp[(7) - (7)].na));}
+    break;
+
+  case 591:
+/* Line 1807 of yacc.c  */
+#line 2142 "fortran.y"
+    { Add_Allocate_Var_1((yyvsp[(1) - (1)].na),curmodulename); }
+    break;
+
+
+/* Line 1807 of yacc.c  */
+#line 6110 "fortran.tab.c"
       default: break;
     }
+  /* User semantic actions sometimes alter yychar, and that requires
+     that yytoken be updated with the new translation.  We take the
+     approach of translating immediately before every use of yytoken.
+     One alternative is translating here after every semantic action,
+     but that translation would be missed if the semantic action invokes
+     YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or
+     if it invokes YYBACKUP.  In the case of YYABORT or YYACCEPT, an
+     incorrect destructor might then be invoked immediately.  In the
+     case of YYERROR or YYBACKUP, subsequent parser actions might lead
+     to an incorrect destructor call or verbose syntax error message
+     before the lookahead is translated.  */
   YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
 
@@ -6532,5 +6127,4 @@
 
   *++yyvsp = yyval;
-
 
   /* Now `shift' the result of the reduction.  Determine what state
@@ -6553,4 +6147,8 @@
 `------------------------------------*/
 yyerrlab:
+  /* Make sure we have latest lookahead translation.  See comments at
+     user semantic actions for why this is necessary.  */
+  yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar);
+
   /* If not already recovering from an error, report this error.  */
   if (!yyerrstatus)
@@ -6560,35 +6158,34 @@
       yyerror (YY_("syntax error"));
 #else
+# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \
+                                        yyssp, yytoken)
       {
-	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
-	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
-	  {
-	    YYSIZE_T yyalloc = 2 * yysize;
-	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
-	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
-	    if (yymsg != yymsgbuf)
-	      YYSTACK_FREE (yymsg);
-	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
-	    if (yymsg)
-	      yymsg_alloc = yyalloc;
-	    else
-	      {
-		yymsg = yymsgbuf;
-		yymsg_alloc = sizeof yymsgbuf;
-	      }
-	  }
-
-	if (0 < yysize && yysize <= yymsg_alloc)
-	  {
-	    (void) yysyntax_error (yymsg, yystate, yychar);
-	    yyerror (yymsg);
-	  }
-	else
-	  {
-	    yyerror (YY_("syntax error"));
-	    if (yysize != 0)
-	      goto yyexhaustedlab;
-	  }
+        char const *yymsgp = YY_("syntax error");
+        int yysyntax_error_status;
+        yysyntax_error_status = YYSYNTAX_ERROR;
+        if (yysyntax_error_status == 0)
+          yymsgp = yymsg;
+        else if (yysyntax_error_status == 1)
+          {
+            if (yymsg != yymsgbuf)
+              YYSTACK_FREE (yymsg);
+            yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc);
+            if (!yymsg)
+              {
+                yymsg = yymsgbuf;
+                yymsg_alloc = sizeof yymsgbuf;
+                yysyntax_error_status = 2;
+              }
+            else
+              {
+                yysyntax_error_status = YYSYNTAX_ERROR;
+                yymsgp = yymsg;
+              }
+          }
+        yyerror (yymsgp);
+        if (yysyntax_error_status == 2)
+          goto yyexhaustedlab;
       }
+# undef YYSYNTAX_ERROR
 #endif
     }
@@ -6598,5 +6195,5 @@
   if (yyerrstatus == 3)
     {
-      /* If just tried and failed to reuse look-ahead token after an
+      /* If just tried and failed to reuse lookahead token after an
 	 error, discard it.  */
 
@@ -6615,5 +6212,5 @@
     }
 
-  /* Else will try to reuse look-ahead token after shifting the error
+  /* Else will try to reuse lookahead token after shifting the error
      token.  */
   goto yyerrlab1;
@@ -6649,5 +6246,5 @@
     {
       yyn = yypact[yystate];
-      if (yyn != YYPACT_NINF)
+      if (!yypact_value_is_default (yyn))
 	{
 	  yyn += YYTERROR;
@@ -6672,8 +6269,7 @@
     }
 
-  if (yyn == YYFINAL)
-    YYACCEPT;
-
+  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
   *++yyvsp = yylval;
+  YY_IGNORE_MAYBE_UNINITIALIZED_END
 
 
@@ -6699,5 +6295,5 @@
   goto yyreturn;
 
-#ifndef yyoverflow
+#if !defined yyoverflow || YYERROR_VERBOSE
 /*-------------------------------------------------.
 | yyexhaustedlab -- memory exhaustion comes here.  |
@@ -6710,7 +6306,12 @@
 
 yyreturn:
-  if (yychar != YYEOF && yychar != YYEMPTY)
-     yydestruct ("Cleanup: discarding lookahead",
-		 yytoken, &yylval);
+  if (yychar != YYEMPTY)
+    {
+      /* Make sure we have latest lookahead translation.  See comments at
+         user semantic actions for why this is necessary.  */
+      yytoken = YYTRANSLATE (yychar);
+      yydestruct ("Cleanup: discarding lookahead",
+                  yytoken, &yylval);
+    }
   /* Do not reclaim the symbols of the rule which action triggered
      this YYABORT or YYACCEPT.  */
@@ -6736,62 +6337,32 @@
 
 
-#line 2643 "fortran.y"
-
-
-void processfortran(char *fichier_entree)
+/* Line 2055 of yacc.c  */
+#line 2156 "fortran.y"
+
+
+void process_fortran(const char *input_file)
 {
-   extern FILE *fortranin;
-   extern FILE *fortranout;
-   char nomfile[LONG_C];
-   int c;
-   int confirmyes;
-
-/*   fortrandebug = 1;*/
-   if ( mark == 1 ) printf("Firstpass == %d \n",firstpass);
+    extern FILE *fortran_in;
+    extern FILE *fortran_out;
+
+    char output_file[LONG_FNAME];
+    char input_fullpath[LONG_FNAME];
+
+    if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass);
+
+     yydebug=0;
 /******************************************************************************/
-/*  1-  Open input and output files                                           */
+/*  1-  Open input file                                                       */
 /******************************************************************************/
-   strcpy(nomfile,commondirin);
-   strcat(nomfile,"/");
-   strcat(nomfile,fichier_entree);
-   fortranin=fopen( nomfile,"r");
-   if (! fortranin)
-   {
-      printf("Error : File %s does not exist\n",nomfile);
-      exit(1);
-   }
-
-   strcpy(curfile,nomfile);
-   strcpy(nomfile,commondirout);
-   strcat(nomfile,"/");
-   strcat(nomfile,fichier_entree);
-   strcpy(nomfileoutput,nomfile);
-   Save_Length(nomfileoutput,31);
-   if (firstpass == 1)
-   {
-      if (checkexistcommon == 1)
-      {
-         if (fopen(nomfile,"r"))
-         {
-            printf("Warning : file %s already exist\n",nomfile);
-            confirmyes = 0;
-            while (confirmyes==0)
-            {
-               printf("Override file %s ? [Y/N]\n",nomfile);
-               c=getchar();
-               getchar();
-               if (c==79 || c==110)
-               {
-                  printf("We stop\n");
-                  exit(1);
-               }
-               if (c==89 || c==121)
-               {
-                  confirmyes=1;
-               }
-            }
-         }
-      }
-   }
+
+    strcpy(cur_filename, input_file);
+    sprintf(input_fullpath, "%s/%s", input_dir, input_file);
+
+    fortran_in = fopen(input_fullpath, "r");
+    if (! fortran_in)
+    {
+        printf("Error : File %s does not exist\n", input_fullpath);
+        exit(1);
+    }
 
 /******************************************************************************/
@@ -6799,67 +6370,43 @@
 /******************************************************************************/
 
-   line_num_fortran_common=1;
-   line_num_fortran=1;
-   PublicDeclare = 0;
-   PrivateDeclare = 0;
-   ExternalDeclare = 0;
-   SaveDeclare = 0;
-   pointerdeclare = 0;
-   optionaldeclare = 0;
-   incalldeclare = 0;
-   VarType = 0;
-   VarTypepar = 0;
-   Allocatabledeclare = 0 ;
-   Targetdeclare = 0 ;
-   strcpy(NamePrecision," ");
-   VariableIsParameter =  0 ;
-   strcpy(NamePrecision,"");
-   c_star = 0 ;
-   functiondeclarationisdone = 0;
-   insubroutinedeclare = 0 ;
-   ininterfacedeclare = 0 ;   
-   strcpy(subroutinename," ");
-   isrecursive = 0;
-   strcpy(InitialValueGiven," ");
-   strcpy(EmptyChar," ");
-   inmoduledeclare = 0;
-   incontainssubroutine = 0;
-   module_declar_type = 0;
-   GlobalDeclarationType = 0;
-   colnum=0;
-   incom=0;
-   couldaddvariable=1;
-   afterpercent = 0;
-   aftercontainsdeclare = 1;
-   strcpy(nameinttypename,"");
-   /* Name of the file without format                                         */
-   tmp = strchr(fichier_entree, '.');
-   strncpy(curfilename,fichier_entree,strlen(fichier_entree)-strlen(tmp));
-   Save_Length(curfilename,30);
+    line_num_input = 1;
+    PublicDeclare = 0;
+    PrivateDeclare = 0;
+    ExternalDeclare = 0;
+    SaveDeclare = 0;
+    pointerdeclare = 0;
+    optionaldeclare = 0;
+    incalldeclare = 0;
+    inside_type_declare = 0;
+    Allocatabledeclare = 0 ;
+    Targetdeclare = 0 ;
+    VariableIsParameter =  0 ;
+    strcpy(NamePrecision,"");
+    c_star = 0 ;
+    functiondeclarationisdone = 0;
+    insubroutinedeclare = 0 ;
+    strcpy(subroutinename," ");
+    isrecursive = 0;
+    InitialValueGiven = 0 ;
+    GlobalDeclarationType = 0;
+    inmoduledeclare = 0;
+    incontainssubroutine = 0;
+    afterpercent = 0;
+    aftercontainsdeclare = 1;
+    strcpy(nameinttypename,"");
+
 /******************************************************************************/
 /*  3-  Parsing of the input file (1 time)                                    */
 /******************************************************************************/
-   if (firstpass == 0 )
-   {
-      fortranout=fopen(nomfileoutput,"w");
-
-/*      NewModule_Creation_0();*/
-   }
-
-   fortranparse();
-
-   if (firstpass == 0 )
-   {
-   NewModule_Creation_0();
-   }
-   
-   strcpy(curfile,mainfile);
-
-   if (firstpass == 0 )
-   {
-   fclose(fortranout);
-   }
+
+    sprintf(output_file, "%s/%s", output_dir, input_file);
+
+    if (firstpass == 0) fortran_out = fopen(output_file,"w");
+
+    fortran_parse();
+
+    if (firstpass == 0) NewModule_Creation_0();
+    if (firstpass == 0) fclose(fortran_out);
 }
-
 #line 2 "fortran.yy.c"
 
@@ -6870,22 +6417,22 @@
 /* A lexical scanner generated by flex */
 
-#define yy_create_buffer fortran_create_buffer
-#define yy_delete_buffer fortran_delete_buffer
-#define yy_flex_debug fortran_flex_debug
-#define yy_init_buffer fortran_init_buffer
-#define yy_flush_buffer fortran_flush_buffer
-#define yy_load_buffer_state fortran_load_buffer_state
-#define yy_switch_to_buffer fortran_switch_to_buffer
-#define yyin fortranin
-#define yyleng fortranleng
-#define yylex fortranlex
-#define yylineno fortranlineno
-#define yyout fortranout
-#define yyrestart fortranrestart
-#define yytext fortrantext
-#define yywrap fortranwrap
-#define yyalloc fortranalloc
-#define yyrealloc fortranrealloc
-#define yyfree fortranfree
+#define yy_create_buffer fortran__create_buffer
+#define yy_delete_buffer fortran__delete_buffer
+#define yy_flex_debug fortran__flex_debug
+#define yy_init_buffer fortran__init_buffer
+#define yy_flush_buffer fortran__flush_buffer
+#define yy_load_buffer_state fortran__load_buffer_state
+#define yy_switch_to_buffer fortran__switch_to_buffer
+#define yyin fortran_in
+#define yyleng fortran_leng
+#define yylex fortran_lex
+#define yylineno fortran_lineno
+#define yyout fortran_out
+#define yyrestart fortran_restart
+#define yytext fortran_text
+#define yywrap fortran_wrap
+#define yyalloc fortran_alloc
+#define yyrealloc fortran_realloc
+#define yyfree fortran_free
 
 #define FLEX_SCANNER
@@ -6930,4 +6477,5 @@
 typedef int32_t flex_int32_t;
 typedef uint32_t flex_uint32_t;
+typedef uint64_t flex_uint64_t;
 #else
 typedef signed char flex_int8_t;
@@ -7018,5 +6566,5 @@
 
 /* Special action meaning "start processing a new file". */
-#define YY_NEW_FILE fortranrestart(fortranin  )
+#define YY_NEW_FILE fortran_restart(fortran_in  )
 
 #define YY_END_OF_BUFFER_CHAR 0
@@ -7041,7 +6589,7 @@
 #endif
 
-extern yy_size_t fortranleng;
-
-extern FILE *fortranin, *fortranout;
+extern yy_size_t fortran_leng;
+
+extern FILE *fortran_in, *fortran_out;
 
 #define EOB_ACT_CONTINUE_SCAN 0
@@ -7055,5 +6603,5 @@
 	do \
 		{ \
-		/* Undo effects of setting up fortrantext. */ \
+		/* Undo effects of setting up fortran_text. */ \
         int yyless_macro_arg = (n); \
         YY_LESS_LINENO(yyless_macro_arg);\
@@ -7061,5 +6609,5 @@
 		YY_RESTORE_YY_MORE_OFFSET \
 		(yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
-		YY_DO_BEFORE_ACTION; /* set up fortrantext again */ \
+		YY_DO_BEFORE_ACTION; /* set up fortran_text again */ \
 		} \
 	while ( 0 )
@@ -7124,6 +6672,6 @@
 	 *
 	 * When we actually see the EOF, we change the status to "new"
-	 * (via fortranrestart()), so that the user can continue scanning by
-	 * just pointing fortranin at a new input file.
+	 * (via fortran_restart()), so that the user can continue scanning by
+	 * just pointing fortran_in at a new input file.
 	 */
 #define YY_BUFFER_EOF_PENDING 2
@@ -7152,8 +6700,8 @@
 #define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
 
-/* yy_hold_char holds the character lost when fortrantext is formed. */
+/* yy_hold_char holds the character lost when fortran_text is formed. */
 static char yy_hold_char;
 static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
-yy_size_t fortranleng;
+yy_size_t fortran_leng;
 
 /* Points to current character in buffer. */
@@ -7162,39 +6710,39 @@
 static int yy_start = 0;	/* start state number */
 
-/* Flag which is used to allow fortranwrap()'s to do buffer switches
- * instead of setting up a fresh fortranin.  A bit of a hack ...
+/* Flag which is used to allow fortran_wrap()'s to do buffer switches
+ * instead of setting up a fresh fortran_in.  A bit of a hack ...
  */
 static int yy_did_buffer_switch_on_eof;
 
-void fortranrestart (FILE *input_file  );
-void fortran_switch_to_buffer (YY_BUFFER_STATE new_buffer  );
-YY_BUFFER_STATE fortran_create_buffer (FILE *file,int size  );
-void fortran_delete_buffer (YY_BUFFER_STATE b  );
-void fortran_flush_buffer (YY_BUFFER_STATE b  );
-void fortranpush_buffer_state (YY_BUFFER_STATE new_buffer  );
-void fortranpop_buffer_state (void );
-
-static void fortranensure_buffer_stack (void );
-static void fortran_load_buffer_state (void );
-static void fortran_init_buffer (YY_BUFFER_STATE b,FILE *file  );
-
-#define YY_FLUSH_BUFFER fortran_flush_buffer(YY_CURRENT_BUFFER )
-
-YY_BUFFER_STATE fortran_scan_buffer (char *base,yy_size_t size  );
-YY_BUFFER_STATE fortran_scan_string (yyconst char *yy_str  );
-YY_BUFFER_STATE fortran_scan_bytes (yyconst char *bytes,yy_size_t len  );
-
-void *fortranalloc (yy_size_t  );
-void *fortranrealloc (void *,yy_size_t  );
-void fortranfree (void *  );
-
-#define yy_new_buffer fortran_create_buffer
+void fortran_restart (FILE *input_file  );
+void fortran__switch_to_buffer (YY_BUFFER_STATE new_buffer  );
+YY_BUFFER_STATE fortran__create_buffer (FILE *file,int size  );
+void fortran__delete_buffer (YY_BUFFER_STATE b  );
+void fortran__flush_buffer (YY_BUFFER_STATE b  );
+void fortran_push_buffer_state (YY_BUFFER_STATE new_buffer  );
+void fortran_pop_buffer_state (void );
+
+static void fortran_ensure_buffer_stack (void );
+static void fortran__load_buffer_state (void );
+static void fortran__init_buffer (YY_BUFFER_STATE b,FILE *file  );
+
+#define YY_FLUSH_BUFFER fortran__flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE fortran__scan_buffer (char *base,yy_size_t size  );
+YY_BUFFER_STATE fortran__scan_string (yyconst char *yy_str  );
+YY_BUFFER_STATE fortran__scan_bytes (yyconst char *bytes,yy_size_t len  );
+
+void *fortran_alloc (yy_size_t  );
+void *fortran_realloc (void *,yy_size_t  );
+void fortran_free (void *  );
+
+#define yy_new_buffer fortran__create_buffer
 
 #define yy_set_interactive(is_interactive) \
 	{ \
 	if ( ! YY_CURRENT_BUFFER ){ \
-        fortranensure_buffer_stack (); \
+        fortran_ensure_buffer_stack (); \
 		YY_CURRENT_BUFFER_LVALUE =    \
-            fortran_create_buffer(fortranin,YY_BUF_SIZE ); \
+            fortran__create_buffer(fortran_in,YY_BUF_SIZE ); \
 	} \
 	YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
@@ -7204,7 +6752,7 @@
 	{ \
 	if ( ! YY_CURRENT_BUFFER ){\
-        fortranensure_buffer_stack (); \
+        fortran_ensure_buffer_stack (); \
 		YY_CURRENT_BUFFER_LVALUE =    \
-            fortran_create_buffer(fortranin,YY_BUF_SIZE ); \
+            fortran__create_buffer(fortran_in,YY_BUF_SIZE ); \
 	} \
 	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
@@ -7215,16 +6763,19 @@
 /* Begin user sect3 */
 
+#define fortran_wrap(n) 1
+#define YY_SKIP_YYWRAP
+
 typedef unsigned char YY_CHAR;
 
-FILE *fortranin = (FILE *) 0, *fortranout = (FILE *) 0;
+FILE *fortran_in = (FILE *) 0, *fortran_out = (FILE *) 0;
 
 typedef int yy_state_type;
 
-extern int fortranlineno;
-
-int fortranlineno = 1;
-
-extern char *fortrantext;
-#define yytext_ptr fortrantext
+extern int fortran_lineno;
+
+int fortran_lineno = 1;
+
+extern char *fortran_text;
+#define yytext_ptr fortran_text
 
 static yy_state_type yy_get_previous_state (void );
@@ -7234,9 +6785,9 @@
 
 /* Done after the current pattern has been matched and before the
- * corresponding action - sets up fortrantext.
+ * corresponding action - sets up fortran_text.
  */
 #define YY_DO_BEFORE_ACTION \
 	(yytext_ptr) = yy_bp; \
-	fortranleng = (size_t) (yy_cp - yy_bp); \
+	fortran_leng = (yy_size_t) (yy_cp - yy_bp); \
 	(yy_hold_char) = *yy_cp; \
 	*yy_cp = '\0'; \
@@ -7252,133 +6803,130 @@
 	flex_int32_t yy_nxt;
 	};
-static yyconst flex_int16_t yy_accept[1162] =
+static yyconst flex_int16_t yy_accept[1132] =
     {   0,
         0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-        0,    0,  177,  176,  165,  161,  164,  175,  152,  151,
-      155,  167,  152,  154,  154,  154,  157,  153,  137,  150,
-      156,  159,  158,  160,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  165,  161,  164,  175,  150,  145,  145,  145,
-      145,  145,  145,  176,  176,  173,  176,  176,  176,  161,
-      161,  154,  145,    0,    0,  165,    0,  166,    0,  164,
-      175,  175,  175,    0,  141,    0,    0,  167,  167,  167,
-      167,    0,    0,    0,  140,    0,    0,  132,   26,    0,
-
-      146,    0,    0,    0,    0,    0,    0,    0,  133,    0,
-      150,   25,    0,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-       43,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,   85,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  165,  163,    0,  163,    0,    0,    0,    0,
-        0,    0,  166,  162,  163,    0,  175,  174,  175,  175,
-      175,  163,  150,    4,  145,  145,  145,  145,   85,  145,
-
-      145,    0,  173,    0,    0,    0,    0,    0,    0,    0,
-      169,   26,    0,    0,    4,    0,  145,  145,  145,  145,
-      145,  145,    0,    0,    0,  175,  175,    0,    0,  167,
-      167,    0,    0,    0,    0,  139,    0,    0,    0,    0,
-        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-        0,  149,  146,    0,    0,    0,  142,    0,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  115,  145,  145,  145,    0,  145,  145,  145,  145,
-      145,   16,  145,  145,  145,  114,  145,  145,  145,  145,
-      145,    0,  145,    0,   96,  145,  145,  145,  145,  145,
-
-      121,  145,  145,  126,  145,  145,  145,  145,  145,  145,
-      145,   89,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  118,  145,  145,  145,
-      145,  145,  122,  145,  145,  145,  145,  145,  165,  163,
-        0,  166,    0,    0,    0,    0,    0,    0,    0,    0,
-      163,    0,  163,  175,  175,  175,  150,    4,    4,    4,
-        4,  145,  145,  145,  145,  145,  145,  145,    0,    0,
-        0,    0,  170,    0,    0,  169,    0,    0,    4,    4,
-        4,    4,  142,    0,  145,  145,    0,  145,  145,  145,
-      145,    0,    0,    0,  175,  175,    0,    0,  167,  167,
-
-        0,    0,    0,    0,  147,    0,  146,    0,  148,    0,
-       28,    0,   30,   29,   32,   31,   34,    0,    0,   36,
-        0,  146,    0,  147,    0,  146,    0,  148,    0,  142,
-        0,  125,  117,  145,  145,  120,  123,  145,  145,   22,
-      145,  145,  145,  145,  145,  116,  145,  145,  145,    0,
-      145,  145,  145,   94,    0,  108,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,    0,  109,  145,  145,  145,
-      145,  145,  145,  145,    0,   88,  145,  145,  145,  145,
-      145,  145,  145,    0,   98,  145,  145,    0,  111,  145,
-      145,  145,  145,  112,   21,  145,   60,   74,  145,  145,
-
-      145,  145,  145,  145,  145,  145,   79,   44,  145,  145,
-      145,  145,   69,  145,  127,  119,  145,   72,   54,  145,
-        0,   97,   99,  145,   92,  101,  145,  145,  165,  163,
-      166,    0,    0,    0,    0,    0,    0,    0,  163,    0,
-      163,  175,  175,  175,  150,    4,    4,  145,  145,  145,
-      145,  145,  145,   18,    0,    0,    0,    0,    0,  170,
-        0,    0,    4,    4,    0,  142,    0,  145,  145,  145,
-      145,    0,    0,    0,  175,  175,    0,    0,  167,  167,
-        0,    0,   38,   27,    0,   35,   37,    0,  142,    0,
-      142,  145,  145,  145,  145,  145,   49,  145,  145,  145,
-
-      124,  145,  145,    0,  145,  145,  145,    0,  145,  145,
-        0,    0,    0,    0,    0,    0,    0,    0,   42,  145,
-       95,  145,  145,  145,  145,  145,  145,  145,  145,   76,
-       76,   76,   76,  145,    0,  107,  113,  145,  145,   88,
-      145,  145,   90,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,   52,  145,   77,
-      145,  145,  145,    0,  145,  145,  145,  145,  145,  102,
-      145,  145,   55,   81,  165,  163,  166,    0,    0,    0,
-        0,    0,    0,  163,    0,  163,  175,  175,  175,  150,
-        4,    3,    0,  104,  145,  145,   86,  145,  145,   70,
-
-       71,   70,    0,    0,    0,    0,    4,    3,    0,  142,
-        0,  142,  145,   49,  145,  124,    0,   23,    0,  175,
-       23,    0,   23,   23,  167,   23,    0,   23,   23,   23,
-       33,  145,  145,   23,   23,   23,  145,  145,   63,  145,
-      145,  145,  145,    0,  145,  145,  138,    0,    0,   93,
-      145,   42,    0,   95,    0,    0,    0,    0,    0,    0,
-      145,  145,  145,  145,  145,  145,  145,  145,    0,  110,
-      145,  145,  145,  145,  145,  145,  145,   66,  145,  145,
-      129,  100,  128,  130,   39,  145,  145,  145,  145,  145,
-      145,  145,   83,    0,  145,   11,   75,   19,  145,  145,
-
-       82,  165,  163,  166,    0,    0,    0,    0,  163,  175,
-      175,   23,    4,    3,    3,  145,  145,  145,  145,    0,
-        0,    0,   23,    4,    3,    3,  145,   23,   23,   23,
-       24,    0,  168,   24,   24,   24,   24,   24,   24,   24,
-       24,   24,   24,  145,  145,  145,   58,  145,  145,  145,
-        0,    0,  145,  145,   40,   93,    0,  145,    0,    0,
-        0,    0,    0,    0,    0,  145,  145,  145,  145,  145,
-       73,  145,  145,  145,    0,    0,  145,  145,   17,   50,
-       45,  145,   46,    0,  145,  145,    9,  145,  145,   67,
-       84,    7,    0,    0,  145,    0,  145,  145,    0,    0,
-
-        0,    0,  175,   24,    4,  145,  145,   64,  145,    0,
-        0,   24,    4,   24,   24,   24,  145,    8,  145,  145,
-       87,  145,  145,   40,    0,    0,  145,  145,    0,  145,
-        0,    0,    0,    0,    0,   73,    0,  145,  145,  145,
-      145,  145,   56,  145,   65,    0,    0,    0,    0,  134,
-       12,   20,  145,    0,  145,   80,   68,  145,    0,  145,
-        0,  145,  145,    0,    0,    0,  175,    4,  145,   59,
-      145,    0,    0,    4,  145,  131,   47,  145,   51,    0,
-        0,  145,  145,    0,   57,    0,    0,    0,    0,    0,
-       56,  145,   41,  145,  106,  145,  145,    0,    0,    0,
-
-        0,    0,  134,   91,    0,  145,   61,    0,   62,    0,
-      145,  145,    0,   59,    0,  175,    4,    4,  145,  143,
-        0,    0,    4,    4,  145,   10,    0,    0,  145,  145,
-       57,    0,   41,    0,  106,    0,  145,   14,  145,  145,
-        0,    0,    0,  145,    0,    0,  103,    6,    0,  143,
-      175,    4,    4,  145,    0,    0,    4,    4,   48,    0,
-        0,  145,  145,    0,   14,    0,   15,  145,   53,    0,
-        0,    0,  145,    0,  103,    0,  175,    4,    2,  105,
-        0,    0,    4,    2,    0,    0,  145,  145,   15,    0,
-      145,    0,    0,    0,  145,    0,  105,  175,    4,    0,
-
-        0,    4,    0,    0,  136,  145,    0,   13,    0,    0,
-        0,  145,    0,  175,    1,    0,    0,  144,    1,  136,
-        0,  145,   13,    0,    0,    0,    0,  145,    0,  175,
-        0,    0,  135,    0,    0,    0,   78,    5,  175,    0,
-      135,   78,  175,    0,  175,    0,  175,    0,  175,    0,
-      175,    0,  175,  171,    0,    0,    0,    0,    0,  172,
+        0,    0,  177,  176,  166,  164,  175,  176,  155,  158,
+      176,  176,  157,  157,  157,  160,  156,  144,  154,  157,
+      159,  162,  161,  163,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  166,  164,  166,  175,  154,  151,
+      151,  151,  151,  151,  151,  176,  176,  172,  176,  176,
+      176,  157,  151,    0,    0,  166,    0,    0,  175,  175,
+      175,    0,  148,    0,    0,    0,  168,    0,    0,    0,
+        0,    0,  147,    0,    0,  141,   25,    0,  153,    0,
+
+        0,    0,    0,    0,    0,    0,  142,    0,  154,    0,
+      140,   23,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,   42,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  100,  151,   89,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,    0,  166,  166,    0,  167,    0,
+        0,    0,    0,    0,    0,  165,  166,    0,  175,  174,
+      175,  175,  175,  167,  154,    0,  151,  151,  151,  151,
+
+       89,  151,  151,    0,  172,    0,    0,    0,    0,    0,
+        0,  173,   25,    0,    0,    0,  151,  151,  151,  151,
+      151,    0,    0,    0,  175,  175,    0,    0,    0,    0,
+        0,    0,    0,    0,  146,    0,    0,    0,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,    0,  152,  152,
+        0,  153,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  123,  151,  151,  151,
+      151,  151,  151,  151,   14,  151,  151,  151,  151,  122,
+      151,  151,  151,  151,  151,  151,  151,    0,  151,  151,
+      151,  151,  151,  151,  129,  151,  151,  134,  151,  151,
+
+      151,  151,  151,  151,  151,  151,   93,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  126,  151,  151,  151,  151,  151,  130,  151,  151,
+      151,  151,  151,  151,  151,    0,  166,  166,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,  166,    0,  167,
+      175,  175,  175,  154,    0,  151,  151,  151,  151,  151,
+      151,  151,    0,    0,    0,    0,  173,    0,    0,    0,
+      151,  151,  151,  151,  151,    0,    0,    0,  175,  175,
+        0,    0,    0,    0,    0,    0,    0,    0,  153,    0,
+       27,    0,   29,   28,   31,   30,   33,    0,    0,   35,
+
+        0,    0,  133,  125,  151,  151,  128,  151,  131,  151,
+      151,   20,  151,  151,  151,  151,  151,  151,  124,  151,
+      151,  151,  151,  151,  151,   98,    0,  115,  151,  151,
+      151,  151,  151,  151,  151,  151,    0,  116,  151,    0,
+      117,  151,  151,  151,  151,  151,  151,    0,  113,  151,
+      151,    0,   92,  151,  151,  151,  151,  151,  151,  151,
+        0,  102,  151,  151,    0,  119,  151,  151,  151,  151,
+      120,    0,  114,   19,  151,   63,   77,  151,  151,  151,
+      151,  151,  151,  151,  151,   82,   43,  151,  151,  151,
+      151,   72,  151,  151,  127,  151,   76,   57,  151,    0,
+
+      101,  103,  151,   96,  105,  151,  151,  151,  151,   47,
+      166,  166,    0,    0,    0,    0,    0,    0,    0,  166,
+        0,  167,  175,  175,  175,  154,    0,  108,  151,  151,
+      151,  151,  151,   16,    0,    0,    0,    0,    0,    0,
+      151,  151,  151,  151,    0,    0,    0,  175,  175,    0,
+        0,    0,    0,    0,    0,   37,   26,    0,   34,   36,
+      151,  151,  151,  151,  151,  151,   52,  151,  151,  151,
+      151,  132,  151,  151,  151,  151,  151,    0,  151,  151,
+        0,    0,    0,    0,    0,    0,    0,    0,   41,  151,
+       99,  151,  151,  151,  151,  151,  151,  151,  151,   79,
+
+       79,  151,    0,  111,  121,   85,  151,  151,   92,  151,
+      151,   94,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,    0,    0,  151,  151,  151,   55,  151,
+       80,  151,  151,  151,    0,  151,  151,  151,  151,  151,
+        0,  135,  106,  151,  151,    0,  112,   58,   39,   84,
+      166,  166,  108,    0,    0,    0,    0,    0,  166,    0,
+      167,  175,  175,  175,  154,    0,  108,  151,   90,  151,
+      151,   74,   73,   74,    0,    0,    0,    0,    0,  151,
+       52,  151,  132,    0,   21,    0,  175,   21,    0,   21,
+       21,    0,   21,    0,   21,   21,   21,   32,  151,  151,
+
+      151,   21,  151,  151,   66,  151,  151,  151,  151,  151,
+      151,  151,  145,    0,    0,   97,  151,   41,    0,   99,
+        0,    0,    0,    0,    0,    0,  151,  151,  151,  151,
+      151,  151,  151,  151,    0,  118,  151,  151,  151,  151,
+      151,  151,  151,   69,  151,  151,  137,  104,  136,  138,
+       38,  151,    0,    6,  151,  151,  151,  151,  151,  151,
+       87,    0,  151,    8,   78,   17,  151,  151,   86,  166,
+      166,    0,    0,    0,  166,  175,  175,   21,    0,  151,
+      151,  151,    0,    0,    0,   21,    0,  151,   21,   22,
+        0,  169,   22,   22,   22,   22,   22,   22,   22,   22,
+
+      151,  151,  151,  151,   50,  151,  151,  151,  109,  151,
+        0,  151,  151,   97,    0,  151,    0,    0,    0,    0,
+        0,    0,    0,  151,  151,  151,  151,  151,   75,  151,
+      151,  151,    0,    0,  151,  151,   15,   53,   44,  151,
+       45,    0,  151,  151,    5,  151,  151,   70,   88,    3,
+        0,    0,  151,    0,  151,  151,    0,    0,    0,  175,
+       22,    0,  151,   67,  151,    0,    0,   22,    0,   22,
+      151,    4,  151,  151,  151,  151,   91,  151,  151,    0,
+        0,  151,  151,    0,  151,    0,    0,    0,    0,    0,
+       75,    0,  151,  151,  151,  151,  151,   59,  151,   68,
+
+        0,    0,    0,    0,  143,    9,   18,  151,    0,  151,
+       83,   71,  151,    0,  151,    0,  151,  151,    0,    0,
+      175,    0,   62,  151,    0,    0,    0,  151,  151,  139,
+       46,  151,  151,   54,    0,    0,  151,  151,    0,   61,
+        0,    0,    0,    0,    0,   59,  151,   11,  151,  110,
+      151,  151,    0,    0,    0,    0,    0,  143,   95,    0,
+      151,   64,    0,   65,    0,  151,  151,   62,    0,  175,
+        0,  149,    0,    0,    0,  151,  151,   40,    7,    0,
+        0,  151,  151,   61,    0,   60,    0,   11,    0,  110,
+        0,  151,   10,  151,  151,    0,    0,    0,  151,    0,
+
+        0,  107,    2,  149,  175,    0,    0,    0,    0,   51,
+        0,    0,    0,    0,  151,  151,    0,   10,    0,   13,
+      151,   56,    0,    0,    0,  151,    0,  107,  175,    0,
+        0,    0,    0,    0,    0,    0,    0,  151,  151,   13,
+        0,  151,    0,    0,    0,  151,    0,  175,    0,    0,
+        0,    0,    0,   24,    0,    0,   49,  151,    0,   12,
+        0,    0,    0,  151,    0,  175,    0,    0,    0,  150,
+        0,   49,    0,  151,   12,    0,    0,    0,    0,  151,
+        0,  175,    0,    0,    0,    0,   48,    0,    0,    0,
+       81,    1,  175,    0,    0,    0,   48,   81,  175,    0,
+
+        0,    0,  175,    0,    0,    0,  175,    0,    0,    0,
+      175,    0,    0,    0,  175,    0,    0,    0,  175,  170,
+        0,  170,    0,    0,  170,    0,    0,    0,    0,  171,
         0
     } ;
@@ -7399,5 +6947,5 @@
        68,   69,   70,   71,   72,   44,   73,   74,   75,   76,
        77,   78,   79,   80,   81,   82,   83,   84,   85,   86,
-       87,   88,   89,   89,   89,    1,    1,    1,    1,    1,
+       87,   88,    1,   89,    1,    1,    1,    1,    1,    1,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
@@ -7418,1313 +6966,736 @@
 static yyconst flex_int32_t yy_meta[90] =
     {   0,
-        1,    2,    3,    2,    1,    4,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    5,    1,    6,
-        6,    6,    6,    6,    6,    6,    6,    6,    6,    1,
-        1,    1,    1,    1,    7,    8,    8,    9,    9,    5,
-       10,   11,    8,    8,    8,   10,   10,   10,    7,    8,
-        9,   10,   10,    5,   10,    8,   12,    8,    8,    8,
-        1,    1,    8,    7,    8,    8,    9,    9,    5,   10,
-       11,    8,    8,   10,   10,   10,    7,    8,    9,   10,
-       10,    5,   10,    8,   12,    8,    8,    8,    4
+        1,    1,    2,    1,    1,    3,    1,    1,    1,    1,
+        1,    4,    1,    1,    1,    1,    1,    3,    1,    5,
+        5,    5,    5,    5,    5,    5,    5,    5,    5,    1,
+        1,    1,    1,    1,    6,    7,    7,    5,    5,    8,
+        9,   10,   11,   11,   11,    9,   11,    9,   12,   11,
+       13,    9,    9,    9,    9,   11,   11,   11,   11,   11,
+        1,    1,   11,    6,    7,    7,    5,    5,    8,    9,
+       10,   11,   11,    9,   11,    9,   12,   11,   13,    9,
+        9,    9,    9,   11,   11,   11,   11,   11,    3
     } ;
 
-static yyconst flex_int16_t yy_base[1215] =
+static yyconst flex_int16_t yy_base[1171] =
     {   0,
-        0,   88,    0,    0,    0,    0, 1215,   93, 1196,   91,
-        0,    0, 1179,   64,   97,  117,  132,   87,  124,   98,
-       99,  142,  173,  154,  108,  135,  134,  254,  172,  179,
-      175,  178,  219,  180,  323,  388,  384,  318,  386,  319,
-      186,  128,  250,  256,  392,  404,  438,  428,  204,  455,
-      432,  465,  544,  120,  537,  548,  627,  624,  622,  544,
-      644,  658,  251, 9159, 1175, 9159,  267,   99,  162,  569,
-      572,  620,  745,  164,  107,  262,  307,  335,  376,  522,
-        0,  167,  157, 1162, 9159,  278,  321, 1160, 1118,  372,
-      304,  532,  593,  567, 9159,  633,  832, 9159, 9159,  911,
-
-      798,  318,  319,  450,  799,  552,  320,  354, 9159,  978,
-      834, 9159,  865,  860,  862,  866,  914,  863,  973,  980,
-      974, 1013, 1024, 1045,  869, 1049, 1075, 1095, 1098, 1101,
-     1182, 1177, 1161, 1181, 1214, 1212, 1237, 1239, 1235, 1270,
-     1290, 1316, 1325, 1293, 1346, 1323, 1366, 1368, 1391, 1399,
-     1403, 1429, 1430, 1455, 1452, 1478, 1498, 1482, 1523, 1521,
-     1554, 1548, 1579, 1586, 1606, 1629, 1649, 1675, 1681, 1698,
-     1707, 1729,  871, 1114, 1109,  140, 1023,  187,  372,  403,
-      553,  401, 1095,  565, 1792, 1818, 1083, 9159,  643,  669,
-      589, 1844, 1870, 1580, 1865, 1867, 1868, 1905, 1926, 1922,
-
-     1925, 1078, 9159,  837,  437,  677,  249,  660, 1072,  712,
-     9159, 1062,  844,  625, 1874, 1993, 2022, 1042,  864,  473,
-      904,  621,  506,  651,  721,  798,  791,  890,  912,  936,
-      907,  725, 1029, 1143,  729, 9159, 1114, 1179, 2097, 2112,
-     2127,  229,  937, 1033, 1012, 1006,  994,  943,  883,  974,
-      891, 9159, 1476, 2142, 2157, 2172, 2182, 2202, 2178, 2180,
-     2200, 2203, 2223, 2243, 2246, 2244, 2276, 2269, 2299, 2307,
-     2301, 2324, 2344, 2351, 2377,  901, 1018, 2374, 2394, 2397,
-     2414, 2495, 2434, 2440, 2465, 2472, 2518, 2521, 2515, 2548,
-     2556, 1138, 2564,  968, 9159, 2581, 2597, 2604, 2627, 2649,
-
-     2650, 2690, 2693, 2686, 2726, 2738, 2746, 2747, 2763, 2783,
-     2799, 2800, 2803, 2820, 2840, 2843, 2870, 2891, 2895, 2903,
-     2926, 2928, 2935, 2961, 2981, 2958, 2984, 2978, 3004, 3011,
-     3027, 3052, 3048, 3059, 3085, 3068, 3105, 3111,  196,  203,
-      976,  383,  974,  988, 1018, 1014, 1025, 1029, 1042,  253,
-     3174, 3200, 3226, 1067, 1182, 1172, 3252,    0,  418,  288,
-     1096, 3228, 3229, 3231, 3251, 3267, 3287, 3290, 1188, 1566,
-      973,  740, 9159,  938,  866, 9159, 1268, 1178,  931, 1170,
-     1241, 1299, 3354, 3381,    0,  903, 3408, 1148, 1116, 1177,
-     1322, 1145,  410, 1415, 1235,  460, 1292, 1218, 1323, 1022,
-
-      963, 1520, 1662, 3418, 3430, 3440, 3450, 3460, 3470,  889,
-     9159,  865, 9159, 9159, 9159, 9159, 9159, 1239,  853, 9159,
-      846, 2472, 3480, 3490, 3500, 3510, 3520, 3530, 3545, 3555,
-     3575, 9159, 3289, 3553, 3573, 3551, 3574, 3590, 3596, 3612,
-     3628, 3634, 3635, 3655, 3671, 3651, 3687, 3688, 3696,  459,
-     3728, 3736, 3740, 3784, 3868, 9159, 3780, 3776, 3807, 3811,
-     3850, 3912, 3872, 3920, 3921, 1351, 9159, 3828, 4005, 4060,
-     4095, 3904, 4063, 4069, 1258, 4096, 4104, 4126, 4134, 4156,
-     4165, 4196, 4205, 1409, 9159, 4208, 4197, 1476, 9159, 4235,
-     4241, 4257, 4261, 4273, 4284, 4293, 4305, 4309, 4332, 4336,
-
-     4353, 4316, 4359, 4362, 4384, 4407, 4385, 4416, 4423, 4448,
-     4455, 4456, 4486, 4494, 4488, 4511, 4527, 4519, 4531, 4554,
-     1498, 9159, 4552, 4575, 4584, 4587, 4607, 4610,  493,  529,
-      551,  476, 1287,  816,  953, 1119, 1293,  841, 4678, 4704,
-     4730, 1607, 1346, 1458, 4756, 1362, 1397, 4733, 4732, 4759,
-     4627, 4768, 4817,  733, 1619, 1594, 1406,  728, 1537, 9159,
-     1571, 1651, 1625, 1613, 4839, 4867, 4894, 1627, 1658, 1686,
-     1714, 1394,    0, 1756, 1574,    0, 1668,  724, 1709,  724,
-     1763, 1775, 9159, 9159,  708, 9159, 9159, 4904, 4916, 4926,
-     4936, 4771, 4931, 5013, 4934, 5068, 5069, 5071, 5075, 5072,
-
-     5120, 5121, 5123, 1725, 5127, 5153, 5176, 1832, 5175, 5179,
-     1458, 1493, 1739, 1516, 1519, 1873, 1592, 1739, 5201, 5224,
-     5202, 5241, 5240, 5257, 5278, 5280, 5301, 5284, 5352, 9159,
-     5351, 5346, 5349, 5353, 1802, 9159, 5355, 5385, 5401, 9159,
-     5405, 5408, 5412, 5428, 5449, 5451, 5458, 5460, 5495, 5501,
-     5531, 5527, 5539, 5571, 5564, 5575, 5591, 5602, 5623, 5614,
-     5634, 5635, 5660,  693, 5666, 5667, 5692, 5703, 5715, 9159,
-     5723, 5719, 5740, 5746,  846, 1103, 1234, 1788, 1768, 1386,
-     1788, 1615, 1847, 1854,  236,  590, 1781, 1913,  715, 5809,
-     1790, 1645, 2264, 9159, 5785, 5805, 1690, 5806, 5807, 2344,
-
-     9159, 1951, 1858, 1924, 2256,  679, 1930, 1879, 5870, 5880,
-     5907, 5917, 1811,  658, 5946,  624,    0, 9159, 6034,    0,
-        0,  613,  609, 9159,  604,  586, 2245, 2364, 2389, 9159,
-     9159, 6063, 6118, 6139, 6138, 6134, 6135, 6141, 6161, 6173,
-     6184, 6209, 6217, 1654, 6260, 6248, 6216, 1844, 1864, 6239,
-     6280, 9159, 1689, 9159, 1930, 1750, 1763, 1934, 1933, 2077,
-     6300, 6292, 6317, 6337, 6338, 6344, 6369, 6376, 2212, 9159,
-     6360, 6413, 6392, 6412, 6424, 6433, 6456, 6435, 6465, 6476,
-     6488, 6497, 6508, 6509, 6552, 6529, 6540, 6549, 6560, 6585,
-     6593, 6605, 6628, 2392, 6636, 6637, 6648, 6659, 6694, 6685,
-
-     6686, 6775, 2286,  518, 2092, 2103, 1938, 2148, 2420, 2303,
-      472,  442, 2196,    0, 1803, 6692, 6717, 6768, 6756, 2424,
-     2334,  426,  422, 2432,  378, 1883, 6858, 6945, 6974,  337,
-     9159, 1922, 9159,    0,  328, 9159,  314, 2481, 2510, 9159,
-     6929, 6757, 7029, 7031, 7037, 7040, 7033, 7077, 7070, 7086,
-     2264, 2842, 7093, 7097, 7118, 9159, 2372, 7129, 2384, 2060,
-     2411, 2418, 2078, 2421, 2139, 7138, 7149, 7170, 7179, 7195,
-     7201, 7227, 7234, 7236, 2483, 3160, 7259, 7257, 7279, 7280,
-     7282, 7302, 7318, 2564, 7325, 7319, 7345, 7356, 7377, 7357,
-     7368, 7388, 2513, 2467, 7400, 2603, 7389, 7425, 2468, 2371,
-
-     2235, 2479,  361,  296,  182, 7409, 7432, 2249, 7455,  622,
-     2529,  227, 1008, 7505,    0,  207, 7482, 7503, 7505, 7514,
-     7535, 7536, 7544, 9159, 2413, 2526, 7567, 7571, 2546, 7593,
-     2547, 2562, 2567, 2526, 2575, 9159, 2526, 7587, 7625, 7594,
-     7631, 7632, 7648, 7657, 7668, 3179, 3203, 2672, 3229, 3335,
-     7684, 7688, 7709, 2597, 7705, 7725, 7732, 7736,  178, 7758,
-     2596, 7775, 7769, 2619, 2617, 2641, 2696, 2668, 7795, 7801,
-     7807, 2677, 2720, 3150, 7827, 7818, 7834, 7867, 7850, 2625,
-     2685, 7870, 7890, 2688, 7859, 2699, 2731, 2741, 2661, 2665,
-     9159, 7911, 7907, 7910, 7927, 7933, 7963, 2822, 3360, 3384,
-
-     3411, 4103, 4220, 7959, 2702, 7970, 7966, 2741, 7986, 2738,
-     8003, 8019, 2758, 9159, 2765, 2781, 2809, 2818, 8030, 8026,
-     2900, 2883, 2903, 2951, 8042, 8051, 2820, 2829, 8063, 8086,
-     9159, 2838, 9159, 2846, 9159, 2846, 8088, 8090, 8113, 8134,
-     3067, 4430, 2880, 8136,  175, 2911, 8125, 8156, 2877, 9159,
-     1190, 2938, 2908, 8157, 3034, 3081, 3049, 3028, 8173, 2959,
-     2985, 8189, 8182, 3029, 9159, 3039, 8205, 8212, 8214, 3241,
-     4684, 3056, 8235, 3049, 9159, 3056, 3212, 3072,    0, 8237,
-     1210, 3169, 3157,  144, 3103, 3103, 8257, 8260, 9159, 3110,
-     8283, 3255, 4708, 3110, 8290,  123, 9159, 3235, 3207, 3329,
-
-     3387, 3558, 3232, 3256, 8306, 8313, 3278, 8315, 8396, 4870,
-     3259, 8391, 3280, 3664,    0, 3349, 3414, 9159,  103, 9159,
-     3346, 8392, 9159, 3745, 4900, 8473, 3347, 8450,   90, 1237,
-     1328, 3570, 8470, 4973, 4977, 3380, 8471, 9159, 3676, 3645,
-     9159, 9159, 3693, 3608, 3764, 3684, 3616, 1433, 3705, 3782,
-     3810, 3774, 3875, 9159, 3852, 3697, 3910, 3892, 3896, 9159,
-     9159, 8553, 8565, 8577, 8589, 8601, 8613, 8621, 8623, 8635,
-     8647, 8659, 8671, 8678, 8687, 8699, 8711, 8723, 8735, 8747,
-     8754, 8762, 8774, 8786, 8798, 8810, 8822, 8834, 8846, 8858,
-     8870, 8882, 8894, 8906, 8918, 8930, 8942, 8954, 8966, 8978,
-
-     8990, 9002, 9014, 9026, 9038, 9050, 9062, 9074, 9086, 9098,
-     9110, 9122, 9134, 9146
+        0,   88,    0,    0,    0,    0,  984,   93,    0,   85,
+        0,    0,  891,   64,   98,  103,   80,  129,   96,   99,
+      134,  137,  145,  133,  168,  135,  249,  180,  318,  136,
+      156,  172,  212,  239,  246,  297,  366,  341,  414,  461,
+      247,  294,  398,  334,  407,  476,  506,  517,  459,  566,
+      572,  522,  571,  367,  653,  226,  656,  658,  737,  638,
+      785,  655,  698,  806,  652, 4012,  878, 4012,  241,  116,
+      124,  455,  893,   59,   76,  229,  253,  256,    0,  122,
+      127,  872, 4012,  157,  188,  869,  866,  327,  302,  349,
+      740,  416, 4012,  768,  592, 4012, 4012,  981,  730,  147,
+
+      184,  438,  495,  328,  184,  190, 4012, 1048,  335,  969,
+     4012, 4012,    0,  269,  315,  149,  319,  486,  462,  248,
+      318,  325,  269,  426,  736,  336,  767,  470,  500,  518,
+      512,  403,  516,  525,  535,  801,  544,  620,  565,  570,
+      589,  768,  483,  589,  810,  592,  613,  638,  650,  664,
+      678,  736,  737,  740,  741,  949,  736,  788,  646,  956,
+      756,  999,  739,  753,  804,  749, 1043,  972,  962,  769,
+      813,  963,  972,  969,    0, 1057,    0,  839,  238, 1044,
+      986,  789,  956, 1030,  965,  429, 1109, 1136,  830, 4012,
+     1061, 1087, 1091, 1162, 1188,  990, 1095, 1120, 1006, 1042,
+
+     1170, 1050, 1046,  823, 4012, 1201, 1099, 1115, 1190,  797,
+      483, 4012,  790, 1167, 1100, 1194, 1269, 1358, 1255, 1254,
+     1195, 1103, 1098,  625, 1148, 1163, 1217, 1237, 1222, 1238,
+     1095, 1305, 1325, 1234, 4012, 1334, 1302, 1326, 1107, 1182,
+      738,  735,  731,  730, 1244, 1166,  713, 1242, 4012, 1428,
+     1374, 1389, 1419, 1244, 1252, 1261, 1263, 1192, 1266, 1301,
+     1333, 1333, 1352, 1352, 1387, 1392, 1388, 1389, 1390, 1404,
+     1401, 1405, 1407, 1404, 1506, 1471, 1417, 1476, 1430,    0,
+     1422, 1437, 1442, 1432, 1484, 1440, 1454, 1497, 1444, 1448,
+     1451, 1443, 1445, 1475, 1459, 1530, 1536, 1464, 1477, 1470,
+
+     1531, 1490, 1491, 1482, 1509, 1511,    0, 1526, 1513, 1519,
+     1524, 1527, 1524, 1555, 1516, 1519, 1522, 1546, 1557, 1564,
+     1558, 1565, 1555, 1557, 1562, 1561, 1615, 1573, 1575, 1573,
+     1576, 1570, 1574, 1582, 1576,  719,  351,  666, 1572,  713,
+     1580, 1587, 1584, 1593, 1589, 1596, 1608, 1658, 1684, 1710,
+     1652, 1645, 1661, 1741, 1626, 1629, 1635, 1634, 1637, 1703,
+     1653,  709, 1654, 1744,  707,  998, 4012, 1712, 1674, 1715,
+     1664, 1708, 1725, 1738, 1749, 1622, 1684, 1379, 1672, 1735,
+     1743, 1771, 1723, 1772, 1787, 1804, 1815, 1807, 1821,  656,
+     4012,  646, 4012, 4012, 4012, 4012, 4012, 1735,  614, 4012,
+
+      613, 1849, 4012,    0, 1741, 1751,    0, 1796,    0, 1799,
+     1799,    0, 1820, 1819, 1811, 1816, 1808, 1821,    0, 1826,
+     1822, 1814, 1822, 1825, 1819, 1871, 1955, 4012, 1825, 1821,
+     1837, 1830, 1829, 1850, 1823, 1844, 1899, 4012, 1836, 1909,
+     4012, 1841, 2040, 1856, 1915, 1858, 1874, 1920, 4012, 1886,
+     1872, 1878,    0, 1886, 1879, 1881, 1888, 1896, 1895, 1902,
+     1967, 4012, 1897, 1906, 1971, 4012, 1900, 1912, 1906, 1915,
+        0, 1980, 4012,    0, 1988,    0,    0, 1929, 1939, 1926,
+     1933, 1936, 1946, 1939, 1953,    0,  602, 1949, 1958, 1955,
+     1963,    0, 1960, 2063,    0,  598,    0,    0, 1985, 2064,
+
+     4012,    0, 1960,    0,    0, 2019, 2022, 2024, 2025, 4012,
+      792,  880, 2030, 2023, 2043, 2043, 2041, 2042,  581, 2092,
+     2118, 2144, 2079, 2080, 2084, 2170, 2045, 1005, 2060, 1022,
+     2071, 2134, 2199,  574, 2082, 2174, 2108, 2147, 2148, 2101,
+     2154, 2184, 2187, 2190, 2087,    0, 1422, 2144,    0, 2200,
+      138, 2202,  571, 2221, 2233, 4012, 4012,  514, 4012, 4012,
+     2174, 2192, 2051, 2289, 2080, 2193,    0, 2109, 2194, 2193,
+     2199,    0, 2201, 2207, 2204, 2195, 2198, 2270, 2240, 2240,
+     2215, 2229, 2246, 2239, 2258, 2275, 2258, 2276,    0, 2276,
+        0, 2287, 2279, 2283, 2295, 2283, 2295, 2300, 2335, 4012,
+
+        0, 2293, 2342, 4012,    0,    0, 2294, 2293, 4012, 2316,
+     2321,    0, 2297, 2323, 2312, 2319, 2335, 2334, 2327, 2337,
+     2333, 2341, 2338,  197,  451, 2343, 2337, 2347,    0, 2348,
+        0, 2335, 2355, 2355,  477, 2343, 2343, 2350, 2355, 2348,
+     2275, 4012, 4012, 2349, 2351, 2404, 4012,    0,    0,    0,
+     1140, 1249, 1797, 2376, 2082, 2379, 2366, 2432, 2263,  424,
+      569, 2417, 2420,  499, 2486, 2384, 2087, 2385, 2427, 2389,
+     2398, 2437, 4012, 2448, 2444, 2439, 2452,  479, 2451, 2431,
+     2410, 2565, 2416,    0, 4012, 2653,    0,    0,  475,  445,
+     4012,  441,  436, 2458, 2462, 2468, 4012, 4012, 2682, 2404,
+
+     2428,    0, 2441, 2444,    0, 2442, 2449, 2447, 2480, 2465,
+     2479, 2553,    0, 2487, 2489,    0, 2493, 4012, 2486, 4012,
+     2497, 2509, 2513, 2527, 2535, 2549, 2552, 2538, 2550, 2555,
+     2548, 2562, 2552, 2559, 2604, 4012, 2572, 2480, 2561, 2568,
+     2573, 2575, 2564,    0, 2569, 2578,    0,    0,    0,    0,
+     2660, 2572,  508, 4012, 2583, 2594, 2591, 2650, 2664, 2658,
+        0, 2536, 2663,    0,    0,    0, 2715, 2654,    0, 2539,
+     2479, 2668, 2663, 2678, 2644, 2682,  426,  421, 2680, 2677,
+     2540, 2686, 2701, 2720,  411,  365, 2721, 2790, 2691, 4012,
+     2725, 4012,    0,  343, 4012,  307, 2753, 2755, 4012,    0,
+
+     2747, 2692, 2702, 2706,    0, 2707, 2709, 2719,    0, 2685,
+     2776, 2708, 2732, 4012, 2748, 2737, 2773, 2763, 2773, 2780,
+     2773, 2788, 2777, 2776, 2785, 2780, 2796, 2786,    0, 2797,
+     2798, 2794, 2647, 2867, 2796, 2791,    0,    0,    0, 2795,
+        0, 2845, 2798, 2801,    0, 2815, 2825,    0,    0,    0,
+     2872, 2840, 2825, 2883, 2847, 2843, 2840, 2548, 2855,  827,
+      303,  239, 2841, 2765, 2855, 1020, 2888,  288, 1687, 2861,
+     2861,    0, 2851, 2861, 2850, 2855,    0, 2851, 2858, 2858,
+     2856, 2863, 2873, 2862, 2878, 2870, 2882, 2880, 2881, 2888,
+     4012, 2904, 2901, 2906, 2913, 2885, 2895,    0, 2903,    0,
+
+     2951, 2978, 2955, 2982, 2994,    0,    0, 2933, 2910, 2917,
+        0,    0, 2923,  248, 2932, 2941, 2930, 2939, 2936, 2956,
+     2998, 2964,    0, 2967, 3005, 3006, 3007, 2966, 2959,    0,
+        0, 2960, 2979,    0, 2973, 2982, 2973, 2987, 2986, 3025,
+     2983, 2989, 2995, 2978, 2978, 4012, 2985,    0, 2991,    0,
+     2985, 3006, 3066, 3074, 3078, 3090, 3094, 3106,    0, 3009,
+     3019,    0, 3041,    0, 3018, 3050, 3056, 4012, 3062, 3076,
+     3056,    0, 3087, 3103, 3099, 3072, 3111,    0,    0, 3064,
+     3080, 3075, 3079, 3124, 3125, 4012, 3082, 4012, 3085, 4012,
+     3080, 3093,    0, 3096, 3104, 3152, 3171, 3113, 3118,  245,
+
+     3119,    0,    0, 4012, 1737,  184, 3142, 3141, 1922,    0,
+     3181, 3186, 3115, 3122, 3127, 3111, 3122, 4012, 3128,    0,
+     3129,    0, 3208, 3211, 3152, 3158, 3150, 4012, 3194, 3154,
+     2097, 3179, 3201, 3224, 3231, 3169, 3153, 3159, 3179, 4012,
+     3183, 3184, 3251, 3258, 3191, 3183,  207, 3229, 3207, 3237,
+      194, 3233, 3261, 4012, 3209, 3200,    0, 3220, 3211,    0,
+     3309, 3283, 3218, 3228, 3221, 3285, 3236, 3273,  142, 4012,
+     3286, 4012, 3243, 3250, 4012, 3339, 3342, 3367, 3248, 3286,
+      108, 2482,   40, 2606, 2838, 3273,    0, 3395, 3399, 3290,
+        0, 4012, 3302, 3294, 3311, 3350, 4012, 4012, 3299, 3320,
+
+     3357, 3358, 3375, 3318, 3359, 3380, 3404, 3376, 3300, 3412,
+     3362, 3363, 3370, 3415, 3418, 3423, 3420, 3426, 3433, 4012,
+     3447, 4012, 3428, 3451, 4012, 3430, 3439, 3454, 3457, 4012,
+     4012, 3521, 3534, 3547, 3560, 3573, 3586, 3595, 3608, 3621,
+     3634, 3647, 3656, 3669, 3678, 3686, 3699, 3712, 3725, 3738,
+     3751, 3764, 3777, 3790, 3803, 3816, 3829, 3842, 3855, 3868,
+     3881, 3894, 3907, 3920, 3933, 3946, 3959, 3972, 3985, 3998
     } ;
 
-static yyconst flex_int16_t yy_def[1215] =
+static yyconst flex_int16_t yy_def[1171] =
     {   0,
-     1161,    1, 1162, 1162,    1,    2, 1163, 1163,    1,    2,
-        1,    2, 1161, 1161, 1161, 1161, 1161, 1164, 1165, 1161,
-     1161, 1166, 1167, 1161, 1161, 1161, 1161, 1161, 1161, 1168,
-     1161, 1161, 1161, 1161, 1169, 1169,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36, 1161, 1161,   53, 1170, 1161,   36,   36,   36,
-       36,   36,   36, 1161, 1171, 1161, 1171, 1171, 1171, 1161,
-     1161, 1172, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1164, 1164, 1164, 1165, 1161, 1165, 1165, 1166, 1161, 1166,
-     1166, 1167, 1173, 1167, 1161, 1167, 1167, 1161, 1161, 1161,
-
-     1174, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1175,
-     1161, 1161, 1161,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-     1169,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   53,  173, 1176, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161,  173, 1161,  173, 1161, 1170, 1161, 1170, 1170,
-     1170, 1161, 1161, 1177,   36,   36,   36,   36,   36,   36,
-
-       36, 1171, 1161, 1171, 1171, 1171, 1171, 1178, 1179, 1179,
-     1161, 1179, 1179, 1179, 1180, 1179, 1161,  217,  217,  217,
-      217,  217, 1161, 1161, 1161, 1164, 1164, 1165, 1165, 1166,
-     1166, 1173, 1173, 1173, 1173, 1161, 1167, 1167, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1181, 1161, 1161, 1161, 1161, 1161,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36, 1182,  131,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36, 1161,   36, 1161, 1161,   36,   36,   36,   36,   36,
-
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,  173,  173,
-     1161,  173, 1176, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-      185, 1161, 1161, 1170, 1170, 1170, 1161, 1177, 1177, 1177,
-     1177,   36,   36,   36,   36,   36,   36,   36, 1171, 1171,
-     1183, 1183, 1161, 1179, 1179, 1161, 1179, 1179, 1180, 1180,
-     1180, 1180, 1179, 1179,  217,  217, 1179,  217,  217,  217,
-      217, 1161, 1161, 1161, 1164, 1164, 1165, 1165, 1166, 1166,
-
-     1173, 1167, 1167, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1181, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36, 1161,
-       36,   36,   36,   36, 1161, 1161,   36,   36,   36,   36,
-       36,   36,   36,   36,   36, 1161, 1161,   36, 1161,   36,
-       36,   36,   36,   36, 1161,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161, 1161,   36,   36, 1161, 1161,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-     1161, 1161,   36,   36,   36,   36,   36,   36,  173,  173,
-      173, 1161, 1161, 1161, 1161, 1161, 1161, 1161,  185, 1161,
-     1161, 1170, 1170, 1170, 1161, 1177, 1177,   36,   36,   36,
-       36,   36,   36, 1161, 1171, 1171, 1171, 1183, 1183, 1161,
-     1179, 1179, 1180, 1180, 1179, 1179, 1179,  217,  217,  217,
-      217, 1161, 1184, 1161, 1164, 1185, 1165, 1186, 1187, 1188,
-     1189, 1190, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
-
-       36,   36,   36, 1161,   36,   36,   36, 1161,   36,   36,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36, 1161,
-     1161,   36,   36,   36, 1161, 1161,   36,   36,   36, 1161,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36,   36,   36, 1161,
-       36,   36,   36,   36,  173,  173,  173, 1161, 1161, 1161,
-     1161, 1161, 1161,  173, 1161, 1161, 1170, 1170, 1191, 1161,
-     1177, 1192, 1161, 1161,   36,   36, 1161,   36,   36, 1161,
-
-     1161, 1161, 1171, 1171, 1179, 1193, 1180, 1194, 1179, 1179,
-     1179, 1179,  217,  217, 1161,  217, 1195, 1161, 1161, 1196,
-     1197, 1198, 1199, 1161, 1200, 1201, 1202, 1203, 1203, 1161,
-     1161, 1161,   36, 1161,   36,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36, 1161, 1161,   36,
-       36, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-       36,   36,   36,   36,   36,   36,   36,   36, 1161, 1161,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
-
-       36, 1161,  802,  802, 1161, 1161, 1161, 1161,  802, 1204,
-     1205, 1204, 1206, 1207, 1207,   36,   36,   36,   36, 1208,
-     1208, 1209, 1210, 1211, 1212, 1212, 1161, 1210, 1161,  829,
-     1161, 1161, 1161, 1197, 1199, 1161, 1201, 1203, 1203, 1161,
-     1161,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-     1161, 1161,   36,   36,   36, 1161, 1161,   36, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161,   36,   36,   36,   36,   36,
-       36,   36,   36,   36, 1161, 1213,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
-       36,   36, 1161, 1161,   36, 1161,   36,   36, 1161, 1161,
-
-     1161, 1161, 1204, 1204, 1206,   36,   36, 1161,   36, 1208,
-     1208, 1210, 1211, 1210,  829,  829,   36,   36,   36,   36,
-       36,   36,   36, 1161, 1161, 1161,   36,   36, 1161,   36,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161,   36,   36,   36,
-       36,   36,   36,   36,   36, 1213, 1213, 1161, 1214, 1213,
-       36,   36,   36, 1161,   36,   36,   36,   36, 1161,   36,
-     1161,   36,   36, 1161, 1161, 1161, 1204, 1206,   36,   36,
-       36, 1208, 1208, 1211,   36,   36,   36,   36,   36, 1161,
-     1161,   36,   36, 1161,   36, 1161, 1161, 1161, 1161, 1161,
-     1161,   36,   36,   36,   36,   36,   36, 1161, 1214, 1214,
-
-     1213, 1214, 1214,   36, 1161,   36,   36, 1161,   36, 1161,
-       36,   36, 1161, 1161, 1161, 1204, 1206, 1206,   36,   36,
-     1208, 1208, 1211, 1211,   36,   36, 1161, 1161,   36,   36,
-     1161, 1161, 1161, 1161, 1161, 1161,   36,   36,   36,   36,
-     1161, 1213, 1161,   36, 1161, 1161,   36,   36, 1161, 1161,
-     1204, 1206, 1206,   36, 1208, 1208, 1211, 1211,   36, 1161,
-     1161,   36,   36, 1161, 1161, 1161,   36,   36,   36, 1161,
-     1213, 1161,   36, 1161, 1161, 1161, 1204, 1206, 1206,   36,
-     1208, 1208, 1211, 1211, 1161, 1161,   36,   36, 1161, 1161,
-       36, 1161, 1213, 1161,   36, 1161, 1161, 1204, 1206, 1208,
-
-     1208, 1211, 1161, 1161,   36,   36, 1161,   36, 1161, 1213,
-     1161,   36, 1161, 1204, 1206, 1208, 1208, 1161, 1211, 1161,
-     1161,   36, 1161, 1161, 1213, 1213, 1161,   36, 1161, 1204,
-     1208, 1161,   36, 1213, 1214, 1161,   36, 1161, 1204, 1208,
-     1161, 1161, 1204, 1208, 1204, 1208, 1204, 1208, 1204, 1208,
-     1204, 1208, 1204, 1161, 1208, 1208, 1208, 1208, 1208, 1161,
-        0, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161
+     1131,    1, 1132, 1132,    1,    2, 1133, 1133,    1,    2,
+        1,    2, 1131, 1131, 1131, 1131, 1134, 1135, 1131, 1131,
+     1136, 1137, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138,   40, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1131,   55, 1139, 1131,   37,
+     1138, 1138, 1138, 1138, 1138, 1131, 1140, 1131, 1140, 1140,
+     1140, 1141, 1131, 1131, 1131, 1131, 1131, 1131, 1134, 1134,
+     1134, 1135, 1131, 1135, 1135, 1136, 1131, 1136, 1136, 1137,
+     1142, 1137, 1131, 1137, 1137, 1131, 1131, 1131, 1143, 1131,
+
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1144,   29, 1131,
+     1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1145,   55,  176, 1146, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131,  176, 1131, 1139, 1131,
+     1139, 1139, 1139, 1131, 1131, 1131, 1138, 1138, 1138, 1138,
+
+     1138, 1138, 1138, 1140, 1131, 1140, 1140, 1140, 1140, 1147,
+     1147, 1131, 1147, 1147, 1147, 1147, 1148, 1148,  218,  218,
+      218, 1131, 1131, 1131, 1134, 1134, 1135, 1135, 1136, 1136,
+     1142, 1142, 1142, 1142, 1131, 1137, 1137, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1144,
+     1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1145,  176,  176, 1131, 1146,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131,  187, 1131, 1131,
+     1139, 1139, 1139, 1131, 1131, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1140, 1140, 1147, 1147, 1131, 1147, 1147, 1147,
+      218,  218,  218,  218,  218, 1131, 1131, 1131, 1134, 1134,
+     1135, 1135, 1136, 1136, 1142, 1137, 1137, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+
+     1131, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1131, 1131, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1131, 1131, 1138, 1131,
+     1131, 1138, 1149, 1138, 1138, 1138, 1138, 1131, 1131, 1138,
+     1138, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1131, 1131, 1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+
+     1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+      176,  176, 1131, 1131, 1131, 1131, 1131, 1131, 1131,  187,
+     1131, 1131, 1139, 1139, 1139, 1131, 1131, 1138, 1138, 1138,
+     1138, 1138, 1138, 1131, 1140, 1140, 1140, 1147, 1147, 1147,
+      218,  218,  218,  218, 1131, 1150, 1131, 1134, 1151, 1135,
+     1152, 1136, 1153, 1137, 1154, 1131, 1131, 1131, 1131, 1131,
+     1138, 1138, 1138, 1155, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131, 1138, 1138,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+
+     1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138, 1131, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1138, 1138, 1138, 1138, 1138,
+     1131, 1131, 1131, 1138, 1138, 1131, 1131, 1138, 1138, 1138,
+      176,  176, 1131, 1131, 1131, 1131, 1131, 1131,  176, 1131,
+     1131, 1139, 1139, 1156, 1131, 1131, 1131, 1138, 1131, 1138,
+     1138, 1131, 1131, 1131, 1140, 1140, 1147, 1157, 1147,  218,
+      218, 1158,  218, 1159, 1131, 1131, 1160, 1134, 1161, 1135,
+     1131, 1162, 1136, 1163, 1137, 1137, 1131, 1131, 1164, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1131, 1131, 1138, 1138, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,  176,
+      176, 1131, 1131, 1131,  176, 1139, 1165, 1139, 1131, 1138,
+     1138, 1138, 1140, 1140, 1166, 1147, 1147, 1167,  218, 1131,
+     1131, 1131, 1134, 1135, 1131, 1136, 1137, 1137, 1131, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1131, 1138, 1138, 1131, 1131, 1138, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1131, 1168, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1131, 1131, 1138, 1131, 1138, 1138, 1131, 1131, 1131, 1139,
+     1139, 1131, 1138, 1131, 1138, 1140, 1140, 1147, 1147,  218,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+     1131, 1138, 1138, 1131, 1138, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+
+     1168, 1168, 1131, 1169, 1168, 1138, 1138, 1138, 1131, 1138,
+     1138, 1138, 1138, 1131, 1138, 1131, 1138, 1138, 1131, 1131,
+     1139, 1131, 1138, 1138, 1140, 1140, 1147, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1131, 1138, 1138, 1131, 1138,
+     1131, 1131, 1131, 1131, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1138, 1131, 1169, 1169, 1168, 1169, 1169, 1138, 1131,
+     1138, 1138, 1131, 1138, 1131, 1138, 1138, 1131, 1131, 1139,
+     1131, 1138, 1140, 1140, 1147, 1138, 1138, 1138, 1138, 1131,
+     1131, 1138, 1138, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1138, 1138, 1138, 1138, 1131, 1168, 1131, 1138, 1131,
+
+     1131, 1138, 1138, 1131, 1139, 1131, 1140, 1140, 1147, 1138,
+     1131, 1131, 1131, 1131, 1138, 1138, 1131, 1131, 1131, 1138,
+     1138, 1138, 1131, 1168, 1131, 1138, 1131, 1131, 1139, 1131,
+     1140, 1140, 1147, 1131, 1131, 1131, 1131, 1138, 1138, 1131,
+     1131, 1138, 1131, 1168, 1131, 1138, 1131, 1139, 1131, 1140,
+     1170, 1147, 1131, 1131, 1131, 1131, 1138, 1138, 1131, 1138,
+     1131, 1168, 1131, 1138, 1131, 1139, 1131, 1140, 1170, 1131,
+     1147, 1131, 1131, 1138, 1131, 1131, 1168, 1168, 1131, 1138,
+     1131, 1139, 1131, 1140, 1147, 1131, 1138, 1168, 1169, 1131,
+     1138, 1131, 1139, 1131, 1140, 1147, 1131, 1131, 1139, 1131,
+
+     1140, 1147, 1139, 1131, 1140, 1147, 1139, 1131, 1140, 1147,
+     1139, 1131, 1140, 1147, 1139, 1131, 1140, 1147, 1139, 1131,
+     1131, 1131, 1140, 1147, 1131, 1140, 1140, 1140, 1140, 1131,
+        0, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131
     } ;
 
-static yyconst flex_int16_t yy_nxt[9249] =
+static yyconst flex_int16_t yy_nxt[4102] =
     {   0,
-       14,   15,   16,   17,   18,   19,   14,   20,   21,   22,
-       23,   24,   25,   26,   25,   27,   25,   28,   29,   30,
-       30,   30,   30,   30,   30,   30,   30,   30,   30,   25,
+       14,   15,   16,   15,   17,   18,   14,   19,   20,   21,
+       22,   23,   24,   25,   24,   26,   24,   27,   28,   29,
+       29,   29,   29,   29,   29,   29,   29,   29,   29,   30,
        31,   32,   33,   34,   35,   36,   37,   38,   39,   40,
        41,   42,   43,   42,   42,   44,   45,   46,   47,   48,
-       42,   49,   50,   51,   42,   42,   52,   42,   42,   42,
-       25,   25,   42,   35,   36,   37,   38,   39,   40,   41,
+       42,   49,   50,   51,   52,   42,   53,   42,   42,   54,
+       24,   24,   42,   35,   36,   37,   38,   39,   40,   41,
        42,   43,   42,   44,   45,   46,   47,   48,   42,   49,
-       50,   51,   42,   42,   52,   42,   42,   42,   14,   53,
-       54,   55,   56,   71,   67,   66,   67,   68,   76,   77,
-
-       78,  203, 1138,   74,   72,  211,  206,   57,   57,   57,
-       57,   57,   57,   57,   57,   57,   57,   75,   79,   77,
-       79,   79,   77,   79,   58,   59,   82,   73,   60,   85,
-       61,   69,   74,   78,   77,   80,   74,   74,   74, 1113,
-       83,   62,   63,  176,   89,   75,  211,   74,   99,  176,
-       75,   75,   75,   58,   59,   82,   73,   60,  224,   61,
-       69,   75,  115,   86,  203,   74,   74,   74,   83,   62,
-       63,   74,   98,   74,   74,   93,   74,   87,   75,   75,
-       75,   90,   94,   95,  109,   75,  224,   75,   75,   75,
-     1074,  115,   86,   74, 1008,   91,  110,  529,  223,  530,
-
-       74,  226,   74,   74,  531,   87,  530,   75,  227,  207,
-       90,   74,   96,   75,   74,   75,   75,   74,   74,   74,
-      115,  346,   74,   91,  387,   75,   97,  223,   75,  211,
-      226,   75,   75,   75,  142,   75,  227,  207,  115,  176,
-       74,   96,  161,   74,  968,  176,   74,   74,   74,  115,
-      346,  203,  112,   75,   97,  100,   75,  100,   74,   75,
-       75,   75,  142,   76,   77,   78,  410,  115,  204,  203,
-      204,  161,   75,  101,  101,  101,  101,  101,  101,  101,
-      101,  101,  101,   85,  115,  115,  370,   74,  102,  143,
-      115,  538,  103,   74,  104,  410,  144,  145,  188,  105,
-
-       75,  106,  107,  201,  146,  205,   89,   75,   79,   77,
-       79,  108,  228,  115,  115,  370,   89,  102,  143,  115,
-      538,  103,   74,  104,  144,  145,   85,  105,  546,  106,
-      107,  201,  146,   85,  205,   75,   78,   77,   78,  108,
-      113,  228,  114,  114,  114,  114,  114,  114,  114,  114,
-      114,  114,  115,  115,  387,  231,  129,  546,  116,  117,
-      130,  138,  118,  188,  139,  242,  131,  140,  119,  243,
-      132,  250,  229,  141,   89,  120,  121,  225,   77,  225,
-      211,  115,  115,  231,  531,  129,  530,  116,  117,  130,
-      138,  118,  139,  242,  131,  140,  119,  243,  132,  250,
-
-      229,  141,  251,  120,  121,  113,  230,  114,  114,  114,
-      114,  114,  114,  114,  114,  114,  114,  347,  124,  359,
-      115,  359,  122,  967,  211,  125,  147,  118,  211,  126,
-      251,  133,  127,  134,  148,  230,  135,  136,  150,  203,
-      149,  123,  128,  137,  188,  347,  151,  124,  573,  115,
-      348,  122,  152,  350,  125,  147,  118,  126,  153,  133,
-      127,  134,  157,  148,  135,  136,  168,  150,  149,  123,
-      128,  137,  115,  169,  188,  151,  158,  573,  348,  159,
-      152,  350,  160,  170,  207,  154,  153,  155,  244,  162,
-      387,  157,  156,  163,  675,  168,  676,  164,  576,  115,
-
-      604,  115,  169,  245,  158,  165,  171,  159,  166,  167,
-      160,  170,  207,  154,  678,  155,  172,  244,  162,  804,
-      156,  389,  163,   78,   77,   80,  164,  576,  115,  604,
-      677,  245,  676,  165,   93,  171,  166,  167,  183,  184,
-      185,   94,   95,  678,  172,  173,   77,  174,  175,  389,
-      188,  392,  677,  176,  676,  189,  186,  186,  186,  186,
-      186,  186,  186,  186,  186,  186,   79,   77,   79,   93,
-       79,   77,   79,   79,   77,   79,   94,   95,  115,  392,
-      177,  178,  208,   74,  179,  208,  180,  190,   89,  198,
-      248,  188,  142,  176,  233,  234,  233,  181,  182,  176,
-
-      249,  191,  235,  236,  224,  208,   89,  115,  208,  177,
-      178,  349,   74,  179,   85,  180,  190,  198,  836,  248,
-      142,  210,  211,  210,  203,  181,  182,  211,  249,  191,
-      192,  194,  224,  212,  208,   93,  176,  208,  387,  349,
-      356,  387,   94,   95,  110,  188,  193,  193,  193,  193,
-      193,  193,  193,  193,  193,  193,  197,  391,  195,  213,
-      129,  372,  373,  372,  130,  125,   74,  237,  356,  126,
-      131,  188,  196,  214,  132,  387,  378,  354,  115,  203,
-       75,  211,  128,  143,  972,  197,  391,  195,  213,  129,
-      144,  199,  168,  130,  125,   74,  237,  126,  131,  169,
-
-      196,  214,  132,  355,  378,  393,  354,  115,   75,  170,
-      128,  369,  143,  375,  376,  375,  200,  188,  144,  199,
-      794,  168,  394,   77,  394,  731,   89,  234,  169,  724,
-      373,  234,  355,  393,  401,  236,  554,  170,  401,  236,
-      369,  559,  560,  559,  200,  209,  210,  211,  210,  209,
-      209,  209,  215,  209,  209,  209,  209,  209,  209,  209,
-      209,  209,  216,  209,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  209,  209,  209,  209,  209,  195,
-      218,  218,  218,  218,  219,  218,  125,  218,  218,  218,
-      220,  218,  218,  196,  218,  218,  218,  218,  221,  218,
-
-      218,  218,  218,  222,  218,  209,  209,  218,  195,  218,
-      218,  218,  218,  219,  218,  125,  218,  218,  220,  218,
-      218,  196,  218,  218,  218,  218,  221,  218,  218,  218,
-      218,  222,  218,  209,   93,  239,  240,  246,  204,  203,
-      204,   94,   95,  395,  554,  396,  211,  802,  241,  803,
-      680,  110,  247,  111,  111,  111,  111,  111,  111,  111,
-      111,  111,  111,  587,  239,  240,  246,  375,  376,  375,
-      586,  395,  339,  396,  340,  205,  241,  258,  377,  680,
-      247,  387,  584,  238,  257,  257,  257,  257,  257,  257,
-      257,  257,  257,  257,  115,   85,  115,  261,  388,  115,
-
-      115,  115,  115,  268,  205,  115,  583,  377,  115,   89,
-     1161,  238,  100,  115,  100,  115,  115,   85,  259,  115,
-      387,  387,  115,  115,  341,  115,  261,  388,  115,  115,
-      115,  115,  268,  211,  115,  397,  419,  115,   89, 1161,
-      211,  115,  421,  115,  115,  102,  259,  115,  115,  103,
-      115,  104,  341,  115,  411,  390,  105,  450,  106,  107,
-      417,  400,  260,  397,  419,  234,  398,  115,  108,  294,
-      421,  294,  401,  236,  102,  373,  188,  115,  103,  295,
-      104,  399,  115,  390,  105,  450,  106,  107,  681,  400,
-      260,  420,  412,  418,  398,  115,  108,  253,  253,  253,
-
-      253,  253,  253,  253,  253,  253,  253,  115,  264,  399,
-      211,  416,  115,  115,  115,  254,  255,  681,  262,  115,
-      412,  418,  263,  415,   89,  265,  115,  115,  256,  414,
-      233,  234,  233,  115,  349,  258,  115,  264,  235,  236,
-      532,  115,  115,  115,  254,  255,  262,  115,  115,  266,
-      413,  263,  115,  265,  115,  115,  256,  344,  115,  387,
-      580,  115,  349,  115,  211,  533,  115,  534,  532,  188,
-      974,  345,  115,  535,  211,  265,  115,  115,  266,  115,
-      203,  115,  536,  115,  115,  188,  344,  115,  115,  580,
-      267,  537,  115,  533,  115,  534,  342,  269,  115,  345,
-
-      115,  535,  115,  265,  804,  115,  803,  542,  115,  115,
-      536,  188,  115,  115,  115,  342,   93,  115,  267,  537,
-       89,  270,  271,   94,   95,  269,  115,  272,  115,  115,
-      115,  273,  274,  387,  115,  115,  542,  115,  115,  292,
-      115,  292,  547,  115,  233,  234,  233,  275,  115,  270,
-      271,  115,  235,  236,  115,  272,  115,  682,  115,  402,
-      273,  274,   89,  115,  115,  387,  115,   85,  569,  115,
-      547,  380,  211,  380,  188,  275,  115,  203, 1161,  115,
-      211,   93,  115,  276,  188,  276,  682,  402,   94,   95,
-      203,  475,  188,  568,  387,  115,  569,  572,   70,  113,
-
-      115,  277,  277,  277,  277,  277,  277,  277,  277,  277,
-      277,  115,  203,  281,  115,  115,  115,   66,  282,  475,
-      115,  568,  280,   85,  115,  572,  544,  543,  555,  115,
-      115,  570,  562,  403,  115,  804,  278,  803,  279,  188,
-      115,  281,  115,  211,  115,  115,  115,  282,  115,  115,
-      280,  115, 1077,  115,  544,  543,  578,  555,  115,  570,
-      562,  403,  115,  284,  278,  115,  279,  115,  283,  115,
-      211,  115, 1100,  115,  115,  115,  115,  115,  115,  285,
-      115,  563,  115,  289,  288,  578,  286,  575,  115, 1161,
-      287,  284,  115,  115,  585,  115,  283,   85,  115, 1139,
-
-      115,  211,  115,  115,  115,  115,  640,  115,  285,  115,
-      563,  289,  288,  561,  286,  575,  115,  292,  287,  292,
-      115,  290,  585,  115,  115,   89,  294,  115,  294,  115,
-      203,  683,  115,  115,  640, 1161,  295,  291,  115,  387,
-      679,  561,  296,  115,  577,  564,  115, 1161,  188,  290,
-      115,  115,  466,  115,  466,  115,  115,  115,  115,  261,
-      683,  115,  115,  301,  115,  291, 1161,  571,  679,  293,
-      296,  115,  577,  564,  115,  579,  115, 1161,  115,  115,
-      115, 1161,  297,  467,  115,  115,  115,  697,  261,  697,
-     1140,  115,  301,  115,  298,  571,  299,  293,  688,  300,
-
-      115, 1161,  115,  579,  115,  115,  115,  115,  203,  115,
-      484,  297,  484,  691,  115,  303,  574,   77,  574,  115,
-      485,  115,  298,  302,  299,  115,  688,  300,  304,  115,
-      115,  115,  717,  115,  115,  203,  115,  115,  115, 1161,
-     1161,  691,  115,  303,  115,  305,  692,  115, 1161,  115,
-      306,  302,  115,  704,  115, 1161,  115,  304, 1161,  115,
-      188,  717,  115,  115,  115, 1161,  115,  115,  115,  115,
-     1161,  115,  115,  305,  692,  308,  307,  488,  306,  488,
-      115,  704,  115,  115,  115, 1161,  115,  489, 1161,  115,
-      310,  115,  115,  115,  115, 1150,  689,  115,  115,  521,
-
-      309,  521, 1161,  308,  307,  311,  752, 1161,  115,  522,
-      115,  115,  115,  239,  240,  115,  115,  115,  115,  310,
-      115,  115,   93,  115,  315,  689,  241, 1161,  309,   94,
-       95,  312,  115,  311,  752,  115,  115,  115,  559,  560,
-      559,  115,  239,  240, 1161,  115,  115,  753, 1161,  313,
-      115,  115,  314,  315,  241,  115,  318,  115, 1161,  312,
-      115,  115,  115,  115,  755,  316,  115,  556,  203,  556,
-      756,  317,  581,  211,  115,  753,  115,  313, 1161,  115,
-      314,  359,  115,  359,  115,  318,  115,  115,  319,  115,
-      320,  115,  755,  115,  316,  556,  203,  556,  756,  317,
-
-      581,  115,  115,  324,  115, 1161,  321,  322,  557,  188,
-      323,  115,  720,  115,  360,  211,  115,  319,  115,  320,
-      115,  203,  115,  705,  325,  115,  326,  211,  361,  115,
-     1161,  324,  115,  327,  321,  322,  557,  557,  323,  115,
-      115,  720,  115,  360,  387,  115,  815,  115,  815,  115,
-      759,  705,  325,  211,  115,  326,  361,  328,  687,  115,
-      115,  327,  708,  329,   93,  557,  808,  115,  115,  115,
-      703,   94,   95,   85,  115,  387,  707,  330,  759,  713,
-      265, 1161,  115,  115,  331,  328,  687,  115,  115,  706,
-      708,  697,  329,  697,  808,  332,  714,  115,  703,  851,
-
-      582, 1161,  115,  387,  707,  330,  722,  713,  265,  115,
-      115,   89,  115,  331,  115,  115, 1161,  115,  706,  335,
-      115, 1161,  333,  332,  715,  714,  334,  851,  115,  582,
-      115,  387,  115, 1161,  115,  722,  859,  115,  115, 1161,
-      336,  115, 1161,  115,  115,  337,  115,  725,  335,  115,
-      333,  115,  716,  715,  334, 1161,  115,  719,   77,  719,
-      115,  115,  115,  115,  859,   93,  115,  744,  115,  336,
-      115,  338,   94,   95,  337,  115,  725,   93,  754,  115,
-      760,  716,  115,  188,  729,  730, 1161, 1161,  115,  693,
-     1161,  693,  115,  342,  184,  351,  744,  115,  861,  694,
-
-      338,  727,  806,  635,  815,  635,  815,  754,  862,  760,
-      115,  352,  352,  352,  352,  352,  352,  352,  352,  352,
-      352,  353,  807,  810, 1161,  805,  861,  176,  387, 1161,
-      727,  806,  813,  608,  636,  608,  862,  352,  352,  352,
-      352,  352,  352,  352,  352,  352,  352,  353,  700,  827,
-      700,  807,  810,  176,  805,  804,  184,  809,  701, 1161,
-      203,  813,  702,  352,  352,  352,  352,  352,  352,  352,
-      352,  352,  352,  353,  748,  380,  211,  380,  827,  176,
-      826,  211,  826,  856,  826,  211,  826,  110,  749,  357,
-      357,  357,  357,  357,  357,  357,  357,  357,  357,  115,
-
-      820,  115,  115,  748,  115,  857,  115,  115,  381, 1161,
-      267,  757,  856,  270,  363,  188,  749,  362,  115,  272,
-      115,  364,  382,  832,   77,  832,  203,  758,  115,  820,
-      115,  115,  211,  115,  857,  115,  115,  381,  267,  115,
-      757,  270,  363, 1161,  115,  362,  115,  272,  115,  364,
-      382,  811,  702,  365,  702,  758,  115, 1161,  115,  115,
-      115,  115,  297,  368,  115,  115,  702,  860,  115,  863,
-     1161,  367,  824,  115,  298,  115,  299,  821,  115,  366,
-      811,  365,  864,  901, 1161,  115,  115, 1161,  115,  115,
-      115,  297,  368,  115,  115,  211,  860, 1161,  863,  367,
-
-     1161,  824,  298,  115,  299,  821,  115,  366, 1161, 1161,
-      864,  901,  383,  383,  383,  383,  383,  383,  383,  383,
-      383,  383,  374,  374,  211,  374,  374,  374,  374,  374,
-      374,  374,  374,  374,  374,  374,  374,  374,  374,  384,
-      374,  385,  385,  385,  385,  385,  385,  385,  385,  385,
-      385,  374,  374,  374,  374,  374,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  374,  374,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      374,  404, 1161,  404,  932,  865,  405,  405,  405,  405,
-      405,  405,  405,  405,  405,  405,  406, 1161,  406,  935,
-      899,  407,  407,  407,  407,  407,  407,  407,  407,  407,
-      407,  408,  932,  408,  865,  900,  409,  409,  409,  409,
-      409,  409,  409,  409,  409,  409,  423,  935,  423,  899,
-     1161,  424,  424,  424,  424,  424,  424,  424,  424,  424,
-      424,  425, 1161,  425,  900, 1161,  426,  426,  426,  426,
-      426,  426,  426,  426,  426,  426,  427,  902,  427,  432,
-      937,  428,  428,  428,  428,  428,  428,  428,  428,  428,
-
-      428,  257,  257,  257,  257,  257,  257,  257,  257,  257,
-      257, 1161,  115,  769,  115,  769,  902,  115,  937,  115,
-      429,  430,  430,  430,  430,  430,  430,  430,  430,  430,
-      430,  115,  433,  115,  115,  905,  908,  115,  908,  115,
-      431,  115,  115,  115,  770,  434,  115,   93,  115,  429,
-      908,  435,  908,  115,  839,  840,  115,  115,  211,  115,
-      433,  115,  115,  115,  905,  693,  115,  693,  115,  431,
-      436,  115, 1161,  434, 1161,  694,  115,  115,  115,  435,
-      115,  115,  115,  115,  115,  115,  115,  804,  439,  803,
-      437,  115, 1161, 1161,  822,  176,  115,  115,  436,  115,
-
-      438,  805,  924,  115,  115,  188,  115,  115,  115,  115,
-      115,  115,  115, 1161,  115,  115,  439, 1161,  437, 1161,
-      441,  440,  115,  822,  115,  115, 1161,  115,  438,  115,
-      805,  924,  115,  115, 1161,  115,  203,  115,  115,  115,
-      115,  115,  903, 1161,  115,  700,  115,  700,  441,  440,
-      115,  442,  115,  443,  445,  701,  444,  115,  115,  702,
-      115, 1161,  115,  115,  115,  446,   93,  115, 1161,  115,
-      115,  903,  911,   94,   95,  115, 1161,  115,  115,  442,
-      115,  443,  445,  115,  444,  115, 1161,  115,  115,  447,
-      115,   93,  115,  893,  446,  893,  448,  115,   94,   95,
-
-     1161,  911, 1161,  894,  115,  115, 1161,  115,  115,  451,
-      929,  115,  115,  115,  115,  449,  115,  447,  965,  115,
-      931,  804,  184,  809,  448,  115,  203,  115,  115,  176,
-      115,  453,  115,  115,  211,  452,  115,  115,  451,  929,
-      115,  466,  115,  466,  449,  115,  965,  115,  115,  931,
-      115,  933,  454,  115, 1161,  115,  934,  115,  115,  936,
-      453,  980,  115,  910,  452,  115, 1161,  115,  115, 1161,
-     1161,  913,  467,  115,  115,  115,  465,  115,  115,  115,
-      933,  454,  115,   93,  875,  934,  875,  115,  936,  980,
-       94,   95,  910,  115,  876,  115,  455,  115,  455,  115,
-
-      913,  959,  115,  115,  115,  465,  115,  964,  115,  239,
-      240,  115,   93,  966,  893,  115,  893,  468,  469,   94,
-       95,  115,  241, 1161,  894,  115, 1161,  456,  115,  115,
-      959,  203,  457,  115,  458,  115,  964,  459,  239,  240,
-      115,  460,  966, 1161,  461,  468,  469,  462,  463,  472,
-      241,  464,  115,  115,  115,  115,  470,  115,  115,  471,
-      115,  457,  989,  458,  991,  884,  459,  884,  115,  460,
-     1161,  115,  461, 1161,  115,  462,  463,  981,  472,  464,
-      973,  115,  115,  115,  115,  470,  115,  115,  471,  115,
-      115,  989,  474,  991,  473,  115,  115,  984,  115,  115,
-
-      986,  115,  115,  115,  896,  981,  896,  987,  973,  115,
-     1161,  115,  476,  954, 1161,  115,  115,  115,  988,  115,
-      115,  474,  473,  990,  115,  984,  477,  115,  986,  115,
-     1010,  115,  115, 1161,  115,  987,  115,  115,  115,  961,
-      476,  954,  478,  115,  115,  115,  988, 1161, 1005,  115,
-      115,  990, 1161, 1013,  477, 1161, 1161,  115,  479, 1010,
-      115,  115,  115, 1161, 1161,  115,  115,  115,  961, 1014,
-      478, 1027,  115,  998,  948,  998, 1005, 1015,  115,  203,
-      115,  480, 1013,  115,  115,  115,  479,  481,  115,  115,
-      115,  484,  483,  484,  488,  115,  488, 1014,  188, 1027,
-
-      482,  485,  115,  115,  489, 1017, 1015, 1018,  115,  480,
-     1161, 1161,  115,  115, 1035, 1021,  481,  115,  115, 1036,
-      115,  483,  203, 1028,  115,  115, 1031,  115,  482,  115,
-      115,  115,  115, 1016, 1017,  486, 1018, 1161,  490,  115,
-      492, 1032, 1035,  115, 1021,  487,  115, 1036,  491,  115,
-     1043, 1161, 1028,  115,  115, 1031,  115, 1161,  115, 1022,
-      115,  115, 1016,  486,  493,  115,  490,  115,  492, 1033,
-     1032,  115,  115,  487,  115, 1034,  491,  115, 1043,  115,
-      115,  115, 1045,  188,  495,  115,  115, 1161, 1022,  115,
-     1046,  494,  496,  493,  115, 1161, 1161,  115, 1033,  115,
-
-      115,  115,  115, 1050, 1034, 1161,  115,  115, 1161,  115,
-      115, 1045, 1049,  495,  115,  115,  115,  115, 1046,  494,
-      496,  497,  115, 1041,  948, 1041,  115,  115,  115, 1051,
-      498,  115, 1050,  115,  115, 1161,  115,  500,  115,  115,
-     1049,  499,  115,  852,  115,  852,  115, 1052, 1161,  497,
-     1161,  115,  115,  115,  115, 1161,  115, 1051,  498,  115,
-     1053, 1161,  115,  115,  115, 1061,  500,  115,  115, 1060,
-      499,  115,  501,  115,  115, 1161, 1052,  115,  925,  115,
-      115,  115,  115,  115,  115,  203, 1064,  502,  115, 1053,
-      503,  926, 1065,  115, 1061, 1161,  115, 1060,  504, 1066,
-
-      501,  115,  203,  115,  115,  211,  115,  925,  115,  115,
-      505,  115, 1161, 1161, 1064,  502, 1072, 1056,  503,  926,
-     1065,  115, 1076,  115,  115,  115,  504, 1066, 1161,  115,
-      115, 1161,  507,  115,  115, 1161,  506,  115,  115,  505,
-      508, 1057,  115, 1161,  115, 1072, 1056, 1055,  115, 1075,
-     1076,  115, 1161,  211,  115, 1079,  115,  509,  115,  115,
-      115,  507,  115,  115,  506,  115,  115,  115,  508,  115,
-     1057,  115,  115, 1078,  115, 1055,  115,  512, 1075,  115,
-      510,  115,  511, 1079,  115,  509, 1161, 1161,  115,  115,
-     1161,  115,  115, 1058,  115,  115,  115,  115,  115,  513,
-
-      115, 1161, 1078,  115, 1085,  515,  512,  115,  510,  115,
-      511,  115,  115, 1161,  115,  115,  115,  115,  115,  514,
-      115,  115, 1058,  115,  115,  516,  115, 1086,  513,  115,
-      211,  517, 1085,  515,  115, 1161,  203,  115,  115,  115,
-     1161,  115,  115,  115,  115,  115,  115,  115,  514,  115,
-      115,  211,  115,  521,  516,  521, 1086,  518, 1161,  517,
-      519,  115,  115,  522,  115,  115,  115,  115, 1070,  948,
-     1070, 1081,  115, 1161,  115, 1084, 1089, 1161,  520,  115,
-      115, 1090,  115,  203, 1083,  518,  115,  115,  519,  523,
-      115,  115,  115,  115, 1094,  115, 1161, 1096,  115,  524,
-
-     1081,  115,  115, 1084, 1089,  115,  520,  115,  115, 1097,
-     1090,  115,  115, 1083,  526,  115,  115, 1082,  523,  115,
-      115,  115,  115, 1094,  115, 1096, 1099,  115,  524,  115,
-     1161,  115,  525,  115, 1161, 1161,  115, 1097,  115,  115,
-      115, 1103,  526, 1161,  115,  115, 1082, 1111,  115,  115,
-      115, 1161,  211,  115, 1099, 1104,  527, 1107,  115,  211,
-      525,  947,  948,  947,  528, 1161,  115, 1161,  115,  949,
-     1103,  203,  950,  115,  115,  531, 1111,  539, 1161,  115,
-      947,  948,  947, 1104,  527, 1107,  115, 1023,  949, 1024,
-     1161,  950,  528,  540,  540,  540,  540,  540,  540,  540,
-
-      540,  540,  540,  541,  947,  948,  947, 1101, 1161,  176,
-     1161, 1102,  949, 1161,  188,  950, 1023, 1161, 1024,  540,
-      540,  540,  540,  540,  540,  540,  540,  540,  540,  541,
-     1000, 1001, 1000, 1161, 1161,  176, 1101,  188, 1002, 1102,
-     1161, 1003, 1092,  948, 1092,  540,  540,  540,  540,  540,
-      540,  540,  540,  540,  540,  541, 1109,  948, 1109, 1098,
-     1115,  176,  115,  115, 1161,  550,  548,  115,  115,  110,
-      115,  545,  545,  545,  545,  545,  545,  545,  545,  545,
-      545,  115,  549, 1114,  115,  115,  551, 1098, 1115, 1120,
-      115,  115,  115,  554,  550,  548,  115,  115, 1121,  115,
-
-     1161,  115, 1161, 1161,  115,  552,  115, 1161, 1161,  115,
-      549, 1114,  115, 1127,  115,  551, 1123, 1120,  482,  115,
-      115,  115, 1161,  115,  115,  553,  115, 1121,  115,  115,
-      115,  203,  115, 1161,  552,  115,  947,  948,  947, 1129,
-      115, 1127,  115,  115,  949, 1123,  482,  950,  115, 1161,
-      115,  203,  115,  115,  553,  115,  211,  115,  115, 1161,
-     1161, 1000, 1001, 1000, 1161, 1161, 1116, 1129,  115, 1002,
-      115,  115, 1003,  383,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  211, 1161, 1000, 1001, 1000, 1117, 1118,
-     1117, 1161,  565, 1002, 1132, 1116, 1003, 1131, 1136, 1161,
-
-      566,  566,  566,  566,  566,  566,  566,  566,  566,  566,
-      211, 1161, 1042, 1001, 1042, 1117, 1118, 1117, 1142,  567,
-      949,  565, 1132,  950, 1161, 1131, 1136,  383,  383,  383,
-      383,  383,  383,  383,  383,  383,  383,  405,  405,  405,
-      405,  405,  405,  405,  405,  405,  405, 1142,  567,  405,
-      405,  405,  405,  405,  405,  405,  405,  405,  405,  407,
-      407,  407,  407,  407,  407,  407,  407,  407,  407,  407,
-      407,  407,  407,  407,  407,  407,  407,  407,  407,  409,
-      409,  409,  409,  409,  409,  409,  409,  409,  409,  409,
-      409,  409,  409,  409,  409,  409,  409,  409,  409,  424,
-
-      424,  424,  424,  424,  424,  424,  424,  424,  424,  424,
-      424,  424,  424,  424,  424,  424,  424,  424,  424,  426,
-      426,  426,  426,  426,  426,  426,  426,  426,  426,  426,
-      426,  426,  426,  426,  426,  426,  426,  426,  426,  428,
-      428,  428,  428,  428,  428,  428,  428,  428,  428,  428,
-      428,  428,  428,  428,  428,  428,  428,  428,  428,  588,
-      211,  588, 1161, 1161,  589,  589,  589,  589,  589,  589,
-      589,  589,  589,  589,  430,  430,  430,  430,  430,  430,
-      430,  430,  430,  430, 1161,  115, 1161,  115, 1161,  590,
-      115,  590,  115,  429,  591,  591,  591,  591,  591,  591,
-
-      591,  591,  591,  591,  115,  592,  115,  115,  115,  593,
-      203, 1119,  115,  115,  115, 1161,  115, 1141,  188,  115,
-     1161,  115,  429, 1161,  115, 1161,  115,  115,  594,  115,
-      115, 1161,  115,  592,  115,  115,  115,  115,  593, 1119,
-     1161,  115,  115,  115, 1161, 1141,  115,  203,  595,  115,
-     1149,  115, 1161,  115,  115,  115, 1146,  594,  115,  115,
-     1161, 1161,  596, 1161,  115,  115,  188,  115,  115,  115,
-     1161,  115,  597,  115,  115,  115,  595,  115,  188, 1149,
-      115,  115, 1161,  598, 1146,  115,  203,  115,  115,  115,
-      115,  596, 1144,  115,  115,  188,  115,  115,  115,  203,
-
-      599,  597,  115,  115,  115,  115, 1161,  188,  115,  115,
-      115,  598, 1161,  600,  115,  115,  115, 1130,  115,  115,
-     1144,  115,  115,  115,  115,  601,  115,  115,  599, 1143,
-      115, 1157,  115,  602,  115,  115,  115, 1148, 1161,  115,
-      115,  115,  600,  603, 1145, 1130, 1124,  948, 1124,  115,
-      115,  115,  115, 1161,  601,  115,  115, 1143, 1151,  115,
-     1157,  602,  115, 1161,  115, 1148,  188,  115,  115,  115,
-      115,  603, 1145,  605,  115,  115,  203,  115,  606,  115,
-     1161,  115, 1161, 1161,  203,  608, 1151,  608, 1161,  115,
-     1161,  115,  607,  115, 1161, 1161,  115, 1161, 1161,  115,
-
-     1161,  605, 1147,  115,  115, 1161, 1161,  606,  115,  115,
-      115, 1153, 1154, 1153,  115,  115, 1161,  115,  115,  115,
-      607,  115, 1161,  115, 1161, 1155,  609, 1161,  619,  115,
-      620, 1147, 1161,  115, 1161, 1152, 1161,  115, 1161,  115,
-      610,  115, 1161,  115,  115,  115,  621,  115,  115, 1161,
-      115, 1161,  115, 1155,  203,  609,  619,  115,  620,  622,
-      115,  115,  115, 1152,  115,  115, 1161,  115,  610,  455,
-      115,  455, 1161, 1161,  115,  621, 1153, 1154, 1153,  115,
-     1161,  629, 1161, 1161,  115, 1161, 1161,  622,  115,  115,
-     1156,  115,  115, 1159, 1160, 1159,  115, 1159, 1160, 1159,
-
-      456,  623, 1161,  115, 1161,  611,  115,  612, 1161,  629,
-      613,  115,  203,  115,  614, 1161, 1161,  615,  115, 1156,
-      616,  617, 1161, 1161,  618,  115, 1161, 1161, 1161,  623,
-      626,  115, 1161, 1161,  611,  115,  612, 1161,  115,  613,
-      115, 1161,  614,  115, 1161,  615,  115, 1161,  616,  617,
-      624,  115,  618,  115,  115,  115, 1161,  637,  626,  115,
-      115,  627, 1161, 1158, 1161,  115,  625,  115, 1161, 1161,
-     1161, 1161,  115,  115,  115,  115,  628, 1161, 1161,  624,
-      115, 1161, 1161,  115,  115,  637, 1161, 1161,  115,  115,
-      627, 1158, 1161,  115,  625, 1161, 1161, 1161, 1161, 1161,
-
-     1161,  115,  115, 1161,  628,  630,  630,  630,  630,  630,
-      630,  630,  630,  630,  630,  630, 1161,  630,  630,  630,
-      630,  630,  631,  630,  632,  632,  632,  632,  632,  632,
-      632,  632,  632,  632,  630,  630,  630,  630,  630,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  633,  633,  630,  630,  633,  633,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  630,  115, 1161,  635,  638,  635,  115,
-
-     1161, 1161,  115,  115, 1000, 1001, 1000, 1161,  115, 1161,
-     1161,  634, 1002,  115, 1161, 1003,  115, 1161, 1161, 1161,
-     1161, 1161,  639,  115, 1161, 1161,  638,  636,  115,  115,
-      115,  115,  115, 1161,  115,  115, 1161,  115,  115,  634,
-     1161,  115, 1161,  115,  115, 1161,  641, 1161,  115,  115,
-      639, 1161, 1161, 1161, 1161, 1161, 1161,  115,  115,  115,
-      115, 1161, 1161,  115,  115,  115, 1161,  115,  115, 1161,
-     1161, 1161,  115,  115, 1161,  641,  115,  115, 1161,  115,
-      642, 1161, 1161, 1161, 1161,  115, 1161,  643, 1161,  115,
-      115, 1161, 1161, 1161,  115,  115, 1161,  115,  644,  115,
-
-     1161, 1161,  115, 1161,  115,  645, 1161,  115,  642,  115,
-     1161, 1161,  646, 1161, 1161,  643, 1161, 1161,  115,  115,
-     1161, 1000, 1001, 1000,  115, 1161, 1161,  644,  115, 1002,
-      115,  650, 1003,  115,  645,  115,  115,  115,  647,  115,
-      646,  648,  115, 1161,  115, 1161,  115,  115, 1161,  115,
-      115, 1161, 1161, 1161, 1161, 1161,  649, 1161,  115,  115,
-      650,  115, 1161, 1161,  115,  115, 1161,  647,  115,  115,
-      648,  115, 1161,  115,  115,  652,  115,  115,  115, 1161,
-      115, 1161, 1161,  651,  649, 1161,  115, 1161,  115,  115,
-     1161,  115, 1161, 1161,  115,  115,  115, 1161,  115, 1161,
-
-      115, 1161,  653,  115,  652, 1161,  654,  115, 1161,  115,
-      115,  651,  115, 1161,  115, 1161,  115, 1161,  115, 1161,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1161,  115,
-      653, 1161,  115, 1161,  654,  655,  115,  115,  115,  115,
-     1161,  115,  115,  115,  115, 1161,  115,  115,  115, 1161,
-      115, 1161,  115, 1161,  115,  115,  115, 1161,  115, 1161,
-     1161,  115,  115, 1161,  655,  115,  115, 1161,  115,  659,
-      115,  115,  115,  115,  115,  115, 1161,  115, 1161,  115,
-      656, 1161,  657, 1161,  115,  115,  115,  115, 1161,  115,
-      115,  658,  115,  115, 1161,  115,  661,  659,  115,  115,
-
-      115,  115, 1161, 1161,  115, 1161,  115, 1161,  656, 1161,
-      657, 1161,  660,  115, 1161,  115,  115,  115,  115,  115,
-      658,  115,  115,  115,  115,  661, 1161,  115, 1161,  664,
-      115, 1071,  948, 1071,  115,  662, 1161,  115,  115,  949,
-      660,  115,  950,  115, 1161, 1161,  115,  115,  115,  663,
-      115, 1161,  115,  115, 1161,  115, 1161,  115, 1161, 1161,
-      115, 1161,  115,  662, 1161,  115,  115, 1161, 1161,  115,
-      115, 1161, 1161, 1161,  665,  115,  115, 1161,  663,  115,
-     1161, 1161,  115, 1161,  115, 1161,  115,  115,  115,  115,
-      115,  115, 1161,  666,  115,  115, 1161,  115, 1161, 1161,
-
-     1161,  115,  665,  668,  115, 1161,  667, 1161,  115,  115,
-     1161,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,
-      115,  666,  115,  115,  115,  115, 1161,  115,  115,  115,
-      669,  668, 1161,  115,  667, 1161,  115,  115,  670,  115,
-     1161,  115, 1161, 1161, 1161,  115, 1161,  115, 1161,  115,
-      115,  115, 1161,  115,  115, 1161,  115,  115,  115,  669,
-     1161,  115,  115, 1161,  115,  115,  115,  115, 1161,  115,
-      115, 1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115,
-      115, 1161,  115, 1161,  115, 1161,  115,  115,  115, 1161,
-      115,  115,  115,  115,  115,  115, 1161, 1161, 1161,  115,
-
-      115, 1161,  671, 1161, 1161,  115, 1161,  115,  115,  115,
-     1161, 1161,  115,  672,  115,  115, 1161,  115,  115, 1161,
-      115,  115,  115,  115, 1161, 1161,  115, 1161,  115, 1161,
-      671, 1161, 1161,  115, 1161,  115, 1161,  115,  115, 1161,
-      115,  115,  672,  115,  115,  673,  115,  115,  674,  115,
-      115, 1161,  115, 1161, 1161,  115,  115, 1161, 1161, 1161,
-      115,  698, 1161,  115, 1161,  115,  115, 1161,  115, 1161,
-      115, 1161, 1161,  115,  673,  115, 1161,  674,  115,  677,
-      115,  684, 1161, 1161, 1161, 1093,  948, 1093,  115, 1161,
-      698,  115, 1161,  949, 1161,  115,  950,  685,  685,  685,
-
-      685,  685,  685,  685,  685,  685,  685,  686,  115, 1110,
-      948, 1110, 1161,  176, 1161, 1161, 1161,  949, 1161, 1161,
-      950, 1161, 1161,  685,  685,  685,  685,  685,  685,  685,
-      685,  685,  685,  686,  693, 1161,  693, 1161, 1161,  176,
-     1161, 1161, 1161, 1161,  694, 1161, 1161, 1161, 1161,  685,
-      685,  685,  685,  685,  685,  685,  685,  685,  685,  686,
-      697, 1161,  697, 1161, 1161,  176,  696,  115, 1161, 1161,
-      695,  115,  115,  110,  600,  690,  690,  690,  690,  690,
-      690,  690,  690,  690,  690,  115,  115, 1161, 1161, 1161,
-     1161, 1161, 1161,  115, 1161,  696,  115, 1161,  115,  695,
-
-      115,  115,  115,  600, 1161,  115, 1161,  115,  645,  732,
-      115, 1161,  115,  115,  115,  646, 1161, 1161,  700,  699,
-      700,  115,  115, 1161,  115, 1161, 1161,  115,  701, 1161,
-     1161,  115,  702, 1161,  115, 1161,  115,  645,  732,  115,
-      115,  211, 1161,  646, 1161, 1161, 1161,  699, 1161,  115,
-     1161,  115,  115,  709, 1161,  709,  115, 1161,  710,  710,
-      710,  710,  710,  710,  710,  710,  710,  710, 1161,  211,
-      115, 1126,  948, 1126, 1161, 1161, 1161, 1161, 1161,  949,
-      115, 1161,  950, 1161, 1161,  115,  566,  566,  566,  566,
-      566,  566,  566,  566,  566,  566,  211, 1161,  115, 1161,
-
-     1161,  947,  948,  947, 1161,  565, 1161, 1161,  711,  949,
-      711, 1161,  950,  712,  712,  712,  712,  712,  712,  712,
-      712,  712,  712,  589,  589,  589,  589,  589,  589,  589,
-      589,  589,  589, 1161,  565,  589,  589,  589,  589,  589,
-      589,  589,  589,  589,  589,  591,  591,  591,  591,  591,
-      591,  591,  591,  591,  591,  591,  591,  591,  591,  591,
-      591,  591,  591,  591,  591,  733, 1161, 1161,  115, 1161,
-      115, 1161, 1161,  115,  947,  948,  947, 1161, 1000, 1001,
-     1000, 1161,  949,  737,  115,  950, 1002,  115, 1161, 1003,
-     1161, 1161, 1161, 1161,  733, 1161, 1161,  115, 1161,  115,
-
-     1161, 1161,  115, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161,  737,  115,  718,  718,  115,  718,  718,  718,  718,
-      718,  718,  718,  718,  718,  718,  718,  718,  718,  718,
-      734,  718,  735,  735,  735,  735,  735,  735,  735,  735,
-      735,  735,  718,  718,  718,  718,  718,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-      736,  736,  736,  718,  718,  736,  736,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-
-      736,  718,  115,  115,  738,  115,  115,  115,  115,  115,
-      115,  115, 1161,  740,  115, 1161, 1161, 1161,  739,  741,
-     1161,  115,  115, 1161,  115,  115, 1161, 1161,  115, 1161,
-     1161,  115,  115,  738,  115,  115,  115,  115,  115,  115,
-      115, 1161,  740,  115, 1161, 1161,  739,  741, 1161,  115,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1161,  115,
-      115,  115,  115, 1161, 1161,  745,  115, 1161, 1161,  742,
-     1161, 1161, 1161,  115,  115,  743,  115, 1161, 1161, 1161,
-      115, 1161, 1161,  115,  115, 1161,  115,  115,  115,  115,
-      115,  115,  115, 1161,  745,  115, 1161,  742,  746, 1161,
-
-     1161,  115,  115,  743,  115, 1161,  115, 1161,  115,  115,
-      115, 1161, 1161,  115,  750,  115,  115,  747,  115, 1161,
-      751,  115, 1161, 1161, 1161, 1161,  746, 1161,  115,  115,
-     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
-      115,  115,  115,  750,  115, 1161,  747,  115, 1161,  751,
-     1161, 1161, 1161, 1161,  115,  115,  115,  115,  115, 1161,
-      115, 1161, 1161,  115,  115,  115, 1161, 1161, 1161,  115,
-      115,  761, 1161, 1161,  115,  115, 1161,  115,  762,  115,
-      115, 1161,  115,  115, 1161, 1161, 1161,  115,  763, 1161,
-     1161,  115,  115,  115,  115, 1161,  115, 1161, 1161,  761,
-
-     1161, 1161,  764,  115,  115,  115, 1161,  762,  115,  115,
-      115, 1161,  115,  765,  115, 1161,  763,  115,  768,  115,
-      115,  115,  115,  115, 1161,  115, 1161, 1161, 1161,  766,
-      764,  115, 1161,  115, 1161,  115, 1161,  115,  115,  767,
-      115,  115,  765,  115, 1161, 1161,  115,  768,  115, 1161,
-     1161, 1161,  115,  769,  115,  769, 1161,  766, 1161,  115,
-     1161,  115, 1161,  258,  115,  115, 1161, 1161,  767,  115,
-      257,  257,  257,  257,  257,  257,  257,  257,  257,  257,
-      115, 1161,  115,  115,  770,  115,  115,  115,  115,  115,
-     1161,  115,  115, 1161,  115, 1161, 1161, 1161, 1161,  115,
-
-      771, 1161,  115, 1161, 1161,  115,  115, 1161,  115,  115,
-     1161, 1161,  115, 1161,  115,  115,  115,  115,  115,  115,
-      115,  115, 1161,  115,  115, 1161, 1161,  115,  771, 1161,
-      115, 1161, 1161,  115,  115,  115,  115, 1161,  772,  115,
-      115,  774,  115,  773,  115,  775,  115,  115,  115, 1161,
-     1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115, 1161,
-     1161,  115,  115, 1161,  115,  115,  772,  115,  115,  115,
-      774,  115,  773,  115,  775,  115,  115, 1161, 1161,  776,
-      115,  115,  115,  115, 1161,  115,  115,  777,  115,  115,
-      115,  115,  115,  115,  780, 1161,  115,  115, 1161,  115,
-
-     1161, 1161,  115, 1161,  778,  779, 1161,  776, 1161,  115,
-     1161,  115,  115,  115,  115, 1161,  777,  115, 1161,  115,
-     1161,  115, 1161,  780, 1161, 1161,  115, 1161,  115,  115,
-      115,  781,  778,  779,  115,  115, 1161, 1161, 1161,  115,
-      115,  115, 1161, 1161, 1161, 1161,  782, 1161,  115, 1161,
-     1161, 1161, 1161, 1161,  115, 1161, 1161, 1161,  115, 1161,
-      781,  115, 1161,  115,  115,  115,  115,  783, 1161,  115,
-      115, 1161,  784,  115,  782, 1161,  115,  785,  115, 1161,
-      115, 1161,  115, 1161,  115, 1161, 1161, 1161, 1161, 1161,
-      115, 1161,  115, 1161,  115,  115,  783, 1161,  115,  115,
-
-      784, 1161,  115,  787, 1161,  115,  785,  115,  115,  115,
-      115, 1161,  115,  786,  115, 1161, 1161,  115, 1161, 1161,
-      115, 1161,  788, 1161,  115,  115, 1161,  115,  115,  789,
-      115, 1161,  787, 1161,  115, 1161,  115, 1161,  115,  115,
-     1161,  115,  786,  115,  115,  115, 1161, 1161,  115, 1161,
-      788, 1161,  115,  115,  115,  115,  115,  115,  789,  115,
-     1161,  790,  115, 1161, 1161,  115, 1161,  115,  115,  792,
-      115, 1161,  115,  115,  115, 1161,  115,  115, 1161, 1161,
-     1161, 1161,  115,  115, 1161, 1161,  115,  791,  115, 1161,
-      790,  115, 1161, 1161,  115,  115,  793,  115,  792,  115,
-
-      115,  115,  115,  115,  115,  115,  115, 1161, 1161, 1161,
-     1161, 1161, 1161,  115, 1161,  791,  115, 1161,  795,  115,
-      796, 1161, 1161,  115, 1161,  793,  115, 1161,  115,  115,
-      115,  115, 1161, 1161,  115,  115, 1161,  115, 1161,  797,
-      798,  115,  115, 1161, 1161,  115,  795,  115,  796,  115,
-     1161, 1161, 1161,  115,  115,  115,  115,  115,  115, 1161,
-      115, 1161,  115, 1161, 1161, 1161,  115,  797,  799,  798,
-     1161,  115,  801,  115,  115, 1161,  115,  800,  115,  115,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1161, 1161,
-     1161,  115, 1161,  115, 1161, 1161,  799, 1161, 1161,  115,
-
-      801, 1161, 1161,  115,  115,  800, 1161, 1161,  115,  115,
-     1161, 1161,  176, 1161,  115, 1161, 1161, 1161,  176,  115,
-     1161,  115, 1161,  816,  115, 1161,  110,  115,  111,  111,
-      111,  111,  111,  111,  111,  111,  111,  111,  115,  115,
-      115,  115, 1161, 1161,  115,  115,  819,  817,  115, 1161,
-     1161,  818,  816,  115, 1161, 1161, 1161, 1161,  115,  115,
-      115, 1161, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,
-      115, 1161,  211,  115,  115,  819,  817, 1161, 1161,  818,
-     1161, 1161,  211, 1161, 1161, 1161,  115,  115,  115,  710,
-      710,  710,  710,  710,  710,  710,  710,  710,  710,  710,
-
-      710,  710,  710,  710,  710,  710,  710,  710,  710,  211,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,  211,
-     1161, 1161, 1161, 1161, 1161, 1161,  712,  712,  712,  712,
-      712,  712,  712,  712,  712,  712,  712,  712,  712,  712,
-      712,  712,  712,  712,  712,  712,  823,  823,  211,  823,
-      823,  823,  823,  823,  823,  823,  823,  823,  823,  823,
-      823,  823,  823,  828,  823,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  823,  823,  823,  823,  823,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-
-      830,  830,  830,  830,  830,  830,  823,  823,  830,  830,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-      830,  830,  830,  830,  823,  832,   77,  832, 1161, 1161,
-      833,  833, 1161,  833, 1161, 1161, 1161,  833,  833, 1161,
-     1161,  833, 1161, 1161,  833,  833,  833,  833,  833,  833,
-      833,  833,  833,  831,  831, 1161,  831,  831,  831,  831,
-      831,  831,  831,  831,  831,  831,  831,  831,  831,  831,
-      841,  831,  842,  842,  842,  842,  842,  842,  842,  842,
-      842,  842,  831,  831,  831,  831,  831,  843,  843,  843,
-
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  843,  843,  831,  831,  843,  843,  843,  843,  843,
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  831,  115, 1161, 1161,  258, 1161,  115,  257,  257,
-      257,  257,  257,  257,  257,  257,  257,  257,  115,  845,
-     1161,  844,  115,  115,  115,  115, 1161,  115, 1161, 1161,
-      115,  115, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
-     1161,  115, 1161, 1161,  846,  115, 1161,  115,  845,  844,
-
-      115,  115,  115,  115,  115, 1161,  115,  115, 1161,  115,
-     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
-     1161, 1161,  846,  115,  115, 1161,  115, 1161, 1161,  115,
-      847, 1161, 1161, 1161, 1161, 1161,  115,  115,  848, 1161,
-     1161,  115,  115,  115, 1161,  849, 1161,  115,  115, 1161,
-      115,  115,  115, 1161,  115,  115,  115, 1161,  847,  850,
-     1161,  852,  115,  852, 1161,  115,  848, 1161, 1161,  115,
-      115, 1161,  115,  115,  849, 1161, 1161,  115,  115,  115,
-      115, 1161,  115, 1161,  115,  115,  855,  115,  850, 1161,
-      115, 1161,  115, 1161,  115, 1161,  853,  115,  115,  115,
-
-     1161,  115,  115, 1161, 1161, 1161, 1161,  115, 1161,  854,
-     1161,  115, 1161,  115,  115,  855,  115, 1161,  858,  115,
-      115, 1161, 1161,  115, 1161,  853,  115, 1161,  115,  115,
-     1161,  115, 1161,  115,  115, 1161,  866,  854, 1161,  115,
-     1161,  115, 1161,  115, 1161,  115,  867,  858,  115, 1161,
-     1161,  115, 1161,  115, 1161,  115,  115,  868, 1161, 1161,
-      115,  115, 1161,  115, 1161,  866, 1161, 1161,  115, 1161,
-      115,  115,  115,  115,  867,  869,  115,  115,  115, 1161,
-      115,  115,  871,  115, 1161,  115,  868, 1161, 1161,  870,
-      115,  115, 1161, 1161,  874, 1161, 1161,  115,  115,  115,
-
-      115,  115, 1161,  115,  869,  115,  115,  115,  115, 1161,
-      115,  871,  115,  115,  875,  115,  875,  870,  115,  115,
-      872,  873,  115,  874,  876,  115,  115, 1161,  115,  115,
-     1161,  115,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
-      877,  115, 1161, 1161,  115,  115,  115,  115,  872,  873,
-      115,  115,  115, 1161,  878,  115, 1161,  115,  115, 1161,
-      115, 1161,  879,  115, 1161,  115,  115,  115,  877,  115,
-     1161,  880,  115,  115,  115,  115,  115,  115, 1161, 1161,
-      115,  115, 1161,  878, 1161, 1161,  115,  115,  115, 1161,
-      115,  879,  115,  115,  115,  115,  115, 1161,  115,  115,
-
-      880,  115, 1161,  115,  115,  115, 1161,  881, 1161,  115,
-      115, 1161, 1161, 1161,  115,  115,  115,  882,  115,  115,
-     1161,  883,  115, 1161,  115, 1161, 1161,  115,  115,  115,
-     1161,  115, 1161,  115, 1161,  881,  115,  115, 1161,  115,
-     1161,  115,  115,  115,  115,  882,  115,  115,  115,  883,
-      115,  115, 1161,  884, 1161,  884,  115,  115, 1161, 1161,
-      115,  115,  115,  115, 1161,  115, 1161, 1161,  115,  115,
-     1161,  115,  115, 1161,  115, 1161,  115,  115,  115,  115,
-     1161,  886,  115,  888, 1161, 1161,  115, 1161,  115,  115,
-      115,  115,  115,  115,  115, 1161, 1161,  115,  887,  115,
-
-     1161,  885,  115,  115, 1161,  115, 1161, 1161,  115,  886,
-      115, 1161,  888,  889, 1161,  115, 1161,  115, 1161,  115,
-      115,  115, 1161,  115,  115, 1161,  887,  115,  115,  885,
-      115,  891,  115,  115, 1161, 1161,  890, 1161,  115,  115,
-     1161,  889, 1161, 1161,  115, 1161,  115, 1161,  115, 1161,
-     1161,  892, 1161,  115, 1161, 1161,  115, 1161,  115, 1161,
-      891,  115,  115, 1161,  890, 1161,  115,  115,  115, 1161,
-      115,  115, 1161,  115,  115,  115,  115, 1161,  895,  892,
-     1161,  115,  115, 1161, 1161, 1161,  115,  115, 1161,  115,
-      115,  115, 1161,  115, 1161,  896,  115,  896,  115,  115,
-
-      115,  115, 1161, 1161,  115,  115, 1161,  895, 1161,  115,
-     1161,  115,  115, 1161, 1161, 1161,  115,  115,  115,  115,
-      115, 1161,  115, 1161,  115,  115,  115,  115,  115,  115,
-      897,  906, 1161,  115, 1161, 1161, 1161, 1161,  898,  115,
-      115, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,  115,
-     1161,  115, 1161,  115,  115,  115,  115,  115, 1161,  897,
-      906, 1161,  115, 1161,  907, 1161,  898,  115, 1161,  908,
-      115,  908, 1161,  115,  258,  115,  802,   77,  804,  175,
-      115, 1161, 1161, 1161, 1161,  115, 1161, 1161, 1161, 1161,
-      909,  115,  907, 1161, 1161,  115,  115, 1161,  115, 1161,
-
-     1161, 1161,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
-      115,  177,  178, 1161, 1161,  179, 1161,  180, 1161,  909,
-      115,  115, 1161, 1161,  115,  115, 1161, 1161,  341,  182,
-     1161,  115, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
-      177,  178, 1161, 1161,  179, 1161,  180, 1161, 1161,  115,
-     1161, 1161, 1161, 1161, 1161, 1161,  341,  182,  912,  912,
-      211,  912,  912,  912,  912,  912,  912,  912,  912,  912,
-      912,  912,  912,  912,  912,  914,  912,  915,  915,  915,
-      915,  915,  915,  915,  915,  915,  915,  912,  912,  912,
-      912,  912,  916,  916,  916,  916,  916,  916,  916,  916,
-
-      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
-      916,  916,  916,  916,  916,  916,  916,  916,  912,  912,
-      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
-      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
-      916,  916,  916,  916,  916,  916,  912,  211,  257,  257,
-      257,  257,  257,  257,  257,  257,  257,  257, 1161, 1161,
-     1161, 1161, 1161, 1161,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  383,  374,  374,  211,  374,  374,  374,
-      374,  374,  374,  374,  374,  374,  374,  374,  374,  374,
-      374,  384,  374,  385,  385,  385,  385,  385,  385,  385,
-
-      385,  385,  385,  374,  374,  374,  374,  374,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  374,  374,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  374,  115, 1161,  917, 1161,  115,  115,  918,
-      115,  115,  115,  919,  115, 1161,  115, 1161,  920,  115,
-     1161, 1161,  115, 1161,  115, 1161,  115, 1161, 1161, 1161,
-      115, 1161,  115,  115,  917, 1161,  115,  115,  918,  115,
-
-      115,  115,  919,  115,  922,  115, 1161,  920,  115,  115,
-      115,  115,  115, 1161,  115,  921,  115, 1161,  115, 1161,
-      115,  115, 1161,  115, 1161,  115, 1161,  115, 1161, 1161,
-      115,  115,  115,  922,  923, 1161,  115, 1161,  115,  115,
-      115,  927, 1161, 1161,  921,  115,  115, 1161,  928,  115,
-      115,  115,  115, 1161,  115, 1161,  115,  115,  115, 1161,
-      115,  115,  923,  115, 1161,  115, 1161,  115,  115,  927,
-     1161,  115,  115, 1161,  115, 1161,  928,  115,  115, 1161,
-      930,  115,  115,  115, 1161, 1161,  115, 1161,  115, 1161,
-     1161,  938,  115, 1161,  939, 1161, 1161,  115, 1161,  115,
-
-     1161,  115,  115, 1161,  115, 1161,  115, 1161,  930,  115,
-      115, 1161,  115,  115, 1161,  941, 1161,  115,  115,  938,
-     1161,  940,  939,  115, 1161, 1161, 1161, 1161, 1161,  115,
-      115, 1161,  115,  115,  115,  115, 1161, 1161,  115, 1161,
-      115, 1161,  115,  942,  941, 1161, 1161,  115,  115,  940,
-     1161,  115, 1161, 1161,  115, 1161, 1161, 1161,  115, 1161,
-      115,  115, 1161,  115,  115,  943,  115, 1161,  115,  115,
-      115,  942,  944,  115, 1161,  115,  115, 1161, 1161, 1161,
-      115,  945,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
-      115,  115, 1161,  115,  943,  115,  115,  115,  115,  115,
-
-     1161,  944,  115, 1161,  115, 1161,  951, 1161,  115,  945,
-      952, 1161,  115,  115,  115,  115,  115,  115,  115,  115,
-      115,  115,  115, 1161, 1161,  115, 1161,  115, 1161, 1161,
-     1161, 1161,  115,  115,  951,  115,  115, 1161,  952, 1161,
-      115,  115,  115,  115,  953,  115, 1161,  115,  115, 1161,
-      115, 1161,  115,  115, 1161,  115, 1161,  115,  115,  115,
-      115,  115, 1161,  115,  115,  115, 1161, 1161, 1161, 1161,
-      115,  115,  956,  953, 1161, 1161,  955, 1161,  115,  115,
-     1161,  115,  115,  115,  115, 1161,  115,  115,  115, 1161,
-      115,  115, 1161,  115, 1161,  115,  115, 1161,  115,  115,
-
-      956,  957,  115, 1161,  955, 1161,  115,  115,  115,  115,
-      115,  115, 1161,  115, 1161,  958,  115, 1161, 1161,  115,
-      115,  115,  115,  962,  115,  115,  115,  115,  115,  957,
-      115,  115, 1161, 1161,  115, 1161,  115,  115,  115,  115,
-      115,  115,  115,  969,  958,  115, 1161, 1161,  115,  115,
-     1161,  115,  962,  115, 1161,  960,  115,  115,  115,  115,
-     1161, 1161,  115,  115,  115, 1161,  115,  963,  115,  115,
-      115,  115,  969, 1161, 1161, 1161, 1161,  115,  115, 1161,
-     1161,  115, 1161,  960,  970,  115, 1161, 1161,  115,  115,
-      115,  971, 1161,  115,  115,  115,  963, 1161, 1161, 1161,
-
-      115, 1161, 1161, 1161, 1161, 1161,  115,  211,  115, 1161,
-     1161, 1161,  970,  115, 1161, 1161,  115,  975,  115, 1161,
-      971,  115, 1161,  115,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  383, 1161,  115,  115,  115, 1161,  115,
-     1161, 1161,  115,  976,  115,  115,  975, 1161,  115, 1161,
-      115, 1161, 1161,  115, 1161, 1161,  115, 1161,  115, 1161,
-     1161, 1161, 1161,  115, 1161,  977,  115,  115,  115,  115,
-      115,  115,  976,  115,  115,  115, 1161,  115,  115, 1161,
-     1161, 1161,  115,  115,  115, 1161,  115, 1161,  115,  978,
-     1161,  979, 1161,  977, 1161,  115, 1161,  115,  115,  115,
-
-     1161,  115, 1161,  115,  115,  115,  115,  115, 1161,  983,
-      115, 1161,  115,  982, 1161, 1161,  115,  978, 1161,  979,
-      115,  115, 1161, 1161,  115,  115,  115,  115,  994,  992,
-      115,  985,  115,  115,  115,  115, 1161, 1161,  983,  115,
-      115,  982, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
-      115, 1161,  115, 1161, 1161,  115,  115,  994,  992,  115,
-      985,  115,  115,  993,  115,  115,  115, 1161,  115, 1161,
-      115,  115, 1161, 1161,  115,  115, 1161, 1161,  115, 1161,
-     1161, 1161,  115, 1161,  995,  115,  996,  115,  115, 1161,
-     1161,  115,  993,  115,  115,  115,  115, 1161, 1161,  115,
-
-      115,  115,  115, 1161,  997, 1161,  115,  115, 1161, 1161,
-      115,  115,  995,  115,  996, 1161,  115, 1161,  115, 1161,
-      115,  115,  115,  115, 1161,  115, 1161,  115, 1161,  115,
-     1161,  115,  997, 1161, 1161, 1161,  115,  115,  115,  115,
-     1161,  115, 1161,  115,  115, 1004, 1161,  115,  115,  115,
-     1161,  115,  115, 1006, 1161, 1161,  115, 1161,  115,  115,
-     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
-      115,  115,  115,  115, 1004,  115, 1161,  115,  115, 1161,
-     1161, 1006, 1161, 1161, 1161,  115,  115, 1007,  115,  115,
-      115, 1161,  115,  115, 1161,  115, 1009,  115, 1161,  115,
-
-      115, 1161, 1161,  115,  115, 1161,  115, 1161,  115,  115,
-     1161,  115, 1161,  115,  115, 1007, 1012,  115, 1161, 1161,
-     1161,  115,  115, 1161, 1161, 1009,  115, 1011,  115,  115,
-     1161, 1161,  115, 1161,  115,  115, 1161,  115,  115,  115,
-      115,  115, 1161,  115, 1012, 1020,  115, 1161,  115, 1019,
-      115, 1161,  115, 1161,  115, 1011,  115,  115,  115, 1161,
-      115,  115, 1161,  115,  115, 1161,  115, 1161,  115,  115,
-      115,  115, 1025,  115, 1020,  115,  115, 1019, 1161, 1161,
-      115,  115,  115, 1161,  115, 1161,  115,  115,  115,  115,
-      115, 1161, 1161,  115, 1161,  115, 1161,  115,  115,  115,
-
-     1025,  115,  115,  115,  115, 1026,  115, 1161,  115,  115,
-     1161, 1161,  115,  115, 1161,  115, 1161, 1161,  115, 1029,
-      115, 1161,  115,  115,  115, 1161, 1030,  115, 1161,  115,
-      115,  115, 1161,  115, 1026,  115, 1161, 1161,  115, 1161,
-      115,  115, 1161,  115,  115,  115,  115, 1029,  115,  115,
-      115,  115, 1161,  115, 1161, 1030, 1038, 1161,  115, 1037,
-      115,  115, 1161,  115,  115, 1161,  115,  115, 1161, 1161,
-      115,  115,  115,  115,  115,  115, 1161, 1161,  115,  115,
-      115, 1161, 1161, 1161, 1038, 1161, 1039, 1037,  115, 1161,
-      115,  115,  115,  115, 1161,  115,  115,  115,  115, 1040,
-
-      115,  115,  115, 1161,  115,  115, 1044, 1161,  115,  115,
-     1161, 1161,  115, 1161, 1039, 1161,  115, 1161, 1161,  115,
-      115, 1161,  115,  115, 1161,  115,  115,  115, 1040,  115,
-     1161,  115, 1161,  115,  115, 1044, 1161,  115,  115,  115,
-      115, 1047,  115, 1161,  115, 1161, 1161,  115, 1161,  115,
-     1161,  115, 1161,  115,  115, 1161,  115, 1048,  115, 1161,
-      115, 1161, 1161, 1161,  115,  115,  115,  115, 1161,  115,
-     1047,  115,  115, 1161, 1161, 1054,  115, 1161, 1161,  115,
-     1059,  115,  115,  115,  115,  115, 1048,  115, 1161,  115,
-      115, 1161, 1161,  115,  115,  115, 1161,  115,  115, 1161,
-
-      115, 1161,  115, 1054,  115,  115, 1161,  115, 1062, 1059,
-      115,  115, 1161, 1161,  115, 1161,  115, 1161, 1161,  115,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1063,  115,
-     1161,  115,  115, 1161, 1161, 1067, 1062, 1161, 1161,  115,
-     1161,  115, 1161,  115,  115, 1161, 1161,  115, 1161,  115,
-     1161,  115,  115,  115,  115, 1068,  115, 1063,  115,  115,
-     1161, 1161, 1161, 1067,  115, 1161,  115,  115,  115,  115,
-      115,  115, 1069,  115, 1073,  115,  115, 1161,  115, 1161,
-     1161,  115, 1161, 1161, 1068, 1161, 1161,  115,  115,  115,
-      115,  115, 1161,  115,  115,  115,  115,  115, 1161,  115,
-
-     1161, 1069,  115, 1073,  115, 1161,  115,  115, 1161,  115,
-     1080, 1161,  115, 1161, 1161,  115,  115,  115, 1161,  115,
-      115,  115, 1161,  115,  115,  115,  115, 1087,  115, 1161,
-     1161, 1161, 1161, 1161, 1088,  115,  115,  115, 1080,  115,
-     1161,  115,  115, 1161,  115,  115,  115, 1161,  115, 1161,
-      115,  115,  115,  115,  115, 1161, 1087,  115,  115, 1091,
-     1161, 1161, 1088,  115, 1161,  115, 1161,  115,  115,  115,
-      115,  115, 1095,  115,  115,  115,  115,  115, 1161, 1161,
-      115, 1161,  115, 1161, 1161, 1161,  115, 1091,  115, 1161,
-      115,  115, 1161,  115,  115,  115,  115, 1161,  115,  115,
-
-      115, 1095, 1106,  115, 1161,  115, 1161, 1161, 1161, 1161,
-      115, 1161, 1161,  115, 1105, 1161,  115,  115,  115, 1161,
-      115, 1108,  115,  115,  115,  115, 1161, 1161,  115,  115,
-     1161, 1106, 1161, 1161, 1161, 1161,  115, 1161,  115, 1161,
-      115,  115, 1105,  115, 1112,  115,  115,  115, 1161,  115,
-     1108,  115,  115,  115,  115, 1161, 1161, 1161,  115,  115,
-     1161, 1122, 1161, 1161,  115, 1161,  115, 1161,  115,  115,
-     1161,  115, 1112, 1161,  115, 1161,  115, 1161,  115, 1161,
-     1161,  115, 1161,  115, 1161, 1161, 1161,  115, 1161, 1122,
-     1161, 1161, 1161, 1161,  115, 1161,  115, 1124,  948, 1124,
-
-     1161, 1161, 1125, 1125, 1161, 1125, 1161, 1161, 1161, 1125,
-     1125, 1161, 1161, 1125, 1161, 1161, 1125, 1125, 1125, 1125,
-     1125, 1125, 1125, 1125, 1125,  115,  115, 1161, 1161, 1161,
-      115,  115, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1133,
-     1161, 1161, 1128, 1161,  115,  115, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161,  115,  115, 1161, 1161, 1161,  115,
-      115, 1161, 1161, 1161, 1161, 1161, 1161, 1133, 1161, 1161,
-     1128, 1161,  115,  115,  947,  948,  947, 1161, 1161, 1134,
-     1134, 1161, 1135, 1161,  115,  950, 1134, 1134, 1137,  115,
-     1134, 1161, 1161, 1134, 1134, 1134, 1134, 1134, 1134, 1134,
-
-     1134, 1134, 1161,  115,  115,  115, 1161, 1161, 1161,  115,
-      115, 1161, 1161,  115, 1161, 1161, 1161, 1137,  115, 1161,
-     1161, 1161, 1161,  115,  115, 1161, 1161, 1161, 1161, 1161,
-     1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115,  115,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161,  115,  115,   64,   64,   64,   64,   64,   64,   64,
-       64,   64,   64,   64,   64,   65,   65,   65,   65,   65,
-       65,   65,   65,   65,   65,   65,   65,   81,   81, 1161,
-       81,   81,   81,   81,   81,   81,   81,   81,   81,   84,
-       84, 1161,   84,   84,   84,   84,   84,   84,   84,   84,
-
-       84,   88,   88,   88,   88,   88,   88,   88,   88,   88,
-       88,   88,   88,   92,   92,   92,   92,   92,   92,   92,
-       92,   92,   92,   92,   92,  111,  111,  115,  115,  115,
-      115,  115,  115,  115,  115,  187,  187,  187,  187,  187,
-      187,  187,  187,  187,  187,  187,  187,  202,  202,  202,
-      202,  202,  202,  202,  202,  202,  202,  202,  202,  209,
-      209,  209,  209,  209,  209, 1161,  209,  209,  209, 1161,
-      209,  232,  232,  232,  232,  232,  232,  232,  232,  232,
-      232,  232,  232,  101, 1161, 1161,  101,  252,  252,  252,
-     1161, 1161,  252, 1161,  252,  252, 1161,  252,  252,  343,
-
-      343,  343,  343,  343,  343,  343,  343,  343,  343,  343,
-      343,  358,  358, 1161,  358,  358,  358,  358,  358,  358,
-      358,  358,  358,  371,  371,  371,  371,  371,  371, 1161,
-      371,  371,  371, 1161,  371,  374,  374,  374,  374,  374,
-      374,  374,  374,  374,  374,  374,  374,  379,  379,  379,
-      379,  379,  379,  379,  379,  379,  379,  379,  379,  422,
-     1161, 1161,  422,  276, 1161, 1161, 1161,  276, 1161, 1161,
-     1161, 1161, 1161,  276,  558,  558,  558,  558,  558,  558,
-      558,  558,  558,  558,  558,  558,  718,  718, 1161,  718,
-      718,  718,  718,  718,  718,  718,  718,  718,  721,  721,
-
-     1161,  721,  721,  721,  721,  721,  721,  721,  721,  721,
-      723,  723, 1161,  723,  723,  723,  723,  723,  723,  723,
-      723,  723,   88,   88,   88,   88,   88,   88,   88,   88,
-       88,   88,   88,   88,  726,  726,  726,  726,  726,  726,
-      726,  726,  726,  726,  726,  726,   92,   92,   92,   92,
-       92,   92,   92,   92,   92,   92,   92,   92,  728,  728,
-      728,  728,  728,  728,  728,  728,  728,  728,  728,  728,
-      812,  812,  812,  812,  812,  812,  812,  812,  812,  812,
-      812,  812,  814,  814, 1161,  814,  814,  814,  814,  814,
-      814,  814,  814,  814,  823,  823,  823,  823,  823,  823,
-
-      823,  823,  823,  823,  823,  823,  825,  825,  825,  825,
-      825,  825,  825,  825,  825,  825,  825,  825,  831,  831,
-     1161,  831,  831,  831,  831,  831,  831,  831,  831,  831,
-      834,  834, 1161,  834,  834,  834,  834,  834,  834,  834,
-      834,  834,   81,   81, 1161,   81,   81,   81,   81,   81,
-       81,   81,   81,   81,  835,  835, 1161,  835,  835,  835,
-      835,  835,  835,  835,  835,  835,   84,   84, 1161,   84,
-       84,   84,   84,   84,   84,   84,   84,   84,  837,  837,
-      837,  837,  837,  837,  837,  837,  837,  837,  837,  837,
-       88,   88,   88,   88,   88,   88,   88,   88,   88,   88,
-
-       88,   88,  838,  838,  838,  838,  838,  838,  838,  838,
-      838,  838,  838,  838,   92,   92,   92,   92,   92,   92,
-       92,   92,   92,   92,   92,   92,  187,  187,  187,  187,
-      187,  187,  187,  187,  187,  187,  187,  187,  904,  904,
-      904,  904,  904,  904,  904,  904,  904,  904,  904,  904,
-      358,  358, 1161,  358,  358,  358,  358,  358,  358,  358,
-      358,  358,  814,  814, 1161,  814,  814,  814,  814,  814,
-      814,  814,  814,  814,  202,  202,  202,  202,  202,  202,
-      202,  202,  202,  202,  202,  202,  912,  912,  912,  912,
-      912,  912,  912,  912,  912,  912,  912,  912,  374,  374,
-
-      374,  374,  374,  374,  374,  374,  374,  374,  374,  374,
-      379,  379,  379,  379,  379,  379,  379,  379,  379,  379,
-      379,  379,  825,  825,  825,  825,  825,  825,  825,  825,
-      825,  825,  825,  825,  946,  946,  946,  946,  946,  946,
-      946,  946,  946,  946,  946,  946,  999,  999,  999,  999,
-      999,  999,  999,  999,  999,  999,  999,  999,   13, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161
+       50,   51,   52,   42,   53,   42,   42,   54,   14,   55,
+       56,   57,   58,  222,   69,   68,   69,   70,   72,   76,
+
+       77,   76, 1094,   74,   78,   77,   78,   59,   59,   59,
+       59,   59,   59,   59,   59,   59,   59,   75,  205,   80,
+     1092,   73,  222,  208,   60,   61,  205,  223,   62,   70,
+       63,   71,   74,   81,   83,   74,   87,   74,   74,   91,
+       82,   64,   65,  691, 1070,   75,   92,   93,   80,   75,
+       73,   75,   75,   60,   61,  223,  225,   62,   70,   63,
+       71,   81,   83,   96,   74,  111,   74,   74,   84,   64,
+       65,  209,   74,   88,   74,   74,   94,   75,  226,   75,
+       75,   97,   85,  255,   74,  225,   75,   89,   75,   75,
+       95,  227,  107,   83,  239,   74, 1070,   84,   75,  209,
+
+      624,   74,   88,   74,   74,   94,  226,   74,  625,   75,
+       85,   74,  255,   74,   75,   89,   75,   75,   95,   74,
+      227,   75,  239, 1065,   74,   75,   75,   78,   77,   78,
+       76,   77,   76,   75,  240,  247,   74,   75,  248,  228,
+       74,  179,  206,  205,  206,  112, 1030,  179,   74,   75,
+       98,   74,   98,   75,   78,   77,   78,  224,   77,  224,
+     1027,   75,  240,  247,  963,   75,  248,  228,   99,   99,
+       99,   99,   99,   99,   99,   99,   99,   99,   74,  207,
+       74,  114,  115,  100,  261,  116,  116,  101,   74,  102,
+      212,  117,   75,   75,  103,  142,  104,  105,  118,  119,
+
+      121,  922,   75,  263,   87,  190,  106,   74,  207,   87,
+      114,  115,  100,  261,  116,  116,  101,   74,  102,  117,
+       75,  253,  103,  142,  104,  105,  118,  119,  121,   87,
+       75,  120,  263,  116,  106,  108,  116,  109,  109,  109,
+      109,  109,  109,  109,  109,  109,  109,  121,   83,  253,
+      121,   91,  511,  230,  512,  110,  110,   74,   92,   93,
+      120,  229,  116,  254,  256,  116,  245,  212,  110,  260,
+      262,   75,  268,  116, 1131,  121,  246,  175,  121,  127,
+      116,  230,  146,  128,  110,  110,   74,  121, 1131,  129,
+      229,  254,  256,  130,  121,  245,  110,  260,  262,   75,
+
+      122,  268,  116, 1131,  246,  116,  116,  123,  127,  116,
+      146,  124,  128,  212,  125,  121, 1131,  129,   91,  121,
+      121,  130,  121,  190,  126,   92,   93,  179,  190,  122,
+       78,   77,   78,  179,  116,  116,  123,  143,   87,  124,
+      275,  147,  125,   87,  144,  145,  116,  121,  121,  148,
+       83,  121,  126,  116,  753,  149,  211,  212,  211,  131,
+      121,  132,  133,  754,  134,  135,  143,  121,  213,  275,
+      147,  136,  144,  145,  264,  116,  241,   82,  148,  121,
+      795,  212,  116,  149,  366,  367,  366,  131,  121,  132,
+      133,  242,  134,  135,  214,  121,  259,  162,  116,  136,
+
+      116,  190,  264,  137,  762,  241,  138,  139,  215,  140,
+      150,  753,  121,  260,  121,  141,  271,  255,  151,  242,
+      754,  113,  152,  214,  153,  259,  162,  116,  257,  116,
+      154,  698,  137,  243,  138,  139,  215,  140,  258,  150,
+      121,  260,  121,  141,  271,  116,  255,  151,  244,  113,
+      152,  158,  153,  155,  272,  156,  116,  257,  154,  121,
+      157,  116,  243,  273,  274,  159,  258,  276,  160,  172,
+      121,  161,  179,   87,  116,  121,  244,  534,  179,  277,
+      158,  155,  272,  156,  534,  116,  278,  121,  157,  282,
+      116,  273,  274,  159,   91,  276,  160,  172,  121,  161,
+
+      163,   92,   93,  121,  164,  116,  169,  277,  165,  643,
+      116,  116,  173,  170,  278,  635,  166,  282,  285,  167,
+      168,  286,  174,  171,  121,  121,  378,   77,  378,  163,
+      560,  559,  295,  164,  116,  169,  287,  165,  290,  116,
+      116,  173,  170,  237,  166,  196,  285,  167,  168,  286,
+      174,  171,  121,  121,  176,   77,  177,  178,  186,  187,
+      190,  295,  179,  557,  287,  191,  290,  511,  283,  512,
+      296,  237,  197,  556,  284,  188,  188,  188,  188,  188,
+      188,  188,  188,  188,  188,  297,  198,  298,  310,  180,
+      181,  116,   74,  182,  116,  183,  283,  192,  296,  172,
+
+      200,  197,  284,  142,  203,  121,  184,  185,  121,  212,
+      299,  193,  534,  297,  198,  190,  298,  310,  180,  181,
+      116,   74,  182,  116,  183,  300,  192,  172,  200,  510,
+      400,  142,  203,  121,  184,  185,  121,  143,  299,  193,
+      194,  232,  233,  232,  144,  201,  179,  396,  395,  234,
+      235,  121,  394,  300,  108,  393,  195,  195,  195,  195,
+      195,  195,  195,  195,  195,  195,  143,  238,  238,  288,
+       91,  288,  144,  201,  110,  110,   74,   92,   93,  121,
+      238,  301,  265,  266,  302,  303,  304,  110,  267,  307,
+       75,  313,  212,  651,  319,  652,  238,  238,  320,  212,
+
+      323,  269,  236,  110,  110,   74,  270,  330,  238,  301,
+      265,  266,  302,  303,  304,  110,  267,  307,   75,  199,
+      313,  289,  319,  127,  116,  205,  320,  128,  323,  190,
+      269,  236,  190,  129,  344,  270,  330,  130,  121,  308,
+      169,  190,  309,  279,  321,  116,  291,  170,  199,  289,
+      280,  322,  127,  116,  281,  331,  128,  171,  292,  121,
+      293,  129,  344,  294,  202,  130,  121,  308,   87,  169,
+      309,   87,  279,  321,  116,  291,  170,   83,  280,  322,
+      205,  651,  281,  652,  331,  171,  292,  121,  293,  921,
+     1131,  294,  202,  210,  211,  212,  211,  210,  210,  210,
+
+      216,  210,  210,  210,  210,  210,  210,  210,  210,  210,
+      210,  210,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  210,  210,  210,  210,  210,  197,  217,  217,
+      217,  217,  218,  217,  123,  217,  217,  217,  219,  217,
+      217,  198,  217,  217,  217,  217,  220,  217,  217,  217,
+      217,  221,  217,  210,  210,  217,  197,  217,  217,  217,
+      217,  218,  217,  123,  217,  217,  219,  217,  217,  198,
+      217,  217,  217,  217,  220,  217,  217,  217,  217,  221,
+      217,  210,   98,  251,   98,  251,   68,  305,  252,  252,
+      252,  252,  252,  252,  252,  252,  252,  252,  311,  366,
+
+      367,  366,  306,  345,  312,  332,  667,  326,  667,  328,
+      333,  335, 1131,  329,  334,  100,  305,  347,  327,  101,
+      343,  102,  205,  669,  355,  669,  103,  311,  104,  105,
+      306,  345,  312,  314,  332,  315,  326,  328,  106,  333,
+      335,  329, 1131,  334,  100,  347,  327, 1131,  101,  343,
+      102,  316,  317,  355,  103,  318,  104,  105,  337,  358,
+      338, 1131,  314,  190,  315, 1131,  106,  250,  250,  250,
+      250,  250,  250,  250,  250,  250,  250,  324,  341,  316,
+      317,  223,  925,  318,  362,  110,  110,  358,  346,  190,
+      359,  325,  342,  190,  260,  351, 1131,  233,  110,  361,
+
+     1131,  205,  212, 1131,  385,  235,  324,  341, 1131,  223,
+      339,  186,  348,  362,  110,  110,  346,  205,  359,  325,
+      342,  352,  260, 1131,  351, 1131,  110,  361,  349,  349,
+      349,  349,  349,  349,  349,  349,  349,  349,  339,  350,
+      262,  770,  353,  771,  390,  179,  209,  356,  376,  363,
+      352,  369,  377, 1131, 1131,  349,  349,  349,  349,  349,
+      349,  349,  349,  349,  349,  350,  265,  357,  262,  212,
+      353,  179,  267,  390,  209,  356,  376, 1131,  363,  369,
+      377,  349,  349,  349,  349,  349,  349,  349,  349,  349,
+      349,  350,  205,  379,  265,  357,  212,  179, 1131,  391,
+
+      267,  368,  206,  205,  206,  108,  291,  354,  354,  354,
+      354,  354,  354,  354,  354,  354,  354,  380,  292,  399,
+      293,  379,   83,  360,   87,  110,  110,  364,  370,  371,
+      368,  375, 1131, 1131,  408,  291,  233,  392,  110,  207,
+       87, 1131,   83,  385,  235,  380,  292,  399,  293, 1131,
+      770,  360,  771, 1131,  110,  110,  364,  370,  371, 1131,
+      375,  397,  381,  408, 1131,  392,  110,  383,  207,  365,
+      365,  212,  365,  365,  365,  365,  365,  365,  365,  365,
+      365,  365,  365,  365,  365,  365,  365,  365,  371,  371,
+      381,  382,  384,  401,  398,  383,  404,  405,  365,  365,
+
+      365,  365,  365,  373,   91,  374,  232,  233,  232,  406,
+      407,   92,   93,  409,  234,  235, 1131,  371,  371,  382,
+      384,  401,  398, 1131,  404,  405,  232,  233,  232,  365,
+      365,  373, 1131,  374,  234,  235,   91,  406,  407, 1131,
+      388,  409,  388,   92,   93,  389,  389,  389,  389,  389,
+      389,  389,  389,  389,  389,  410,  387,  365,  365,  365,
+      212,  365,  365,  365,  365,  365,  365,  365,  365,  365,
+      365,  365,  365,  365,  365,  365,  365,  411,  412,  386,
+      547,   77,  547,  410,  387, 1131, 1131,  365,  365,  365,
+      365,  365,  372,  252,  252,  252,  252,  252,  252,  252,
+
+      252,  252,  252,  413,  414,  411,  412,  386,  252,  252,
+      252,  252,  252,  252,  252,  252,  252,  252,  365,  365,
+      402,  372,  402,  686,   77,  686, 1131, 1131,  417,  419,
+      403,  413,  414,  415,  420,  421,  416, 1131,  422,  423,
+      424,  425,  426, 1131, 1131,  418,  365,  250,  250,  250,
+      250,  250,  250,  250,  250,  250,  250,  417,  419,  439,
+      444,  415,  420,  421,  416,  238,  238,  422,  423,  424,
+      425,  426,  437,  418,  437,  445,  446,  440,  238,  440,
+     1131, 1131,  442,  443,  447,  448,  450,  448,  439,  444,
+      451, 1131,  453,  454,  238,  238,  455,  456,  288,  457,
+
+      288,  460, 1131,  438,  445,  446,  238,  427,  441,  427,
+      442,  443,  447,  458,  450,  470,  449, 1131,  469,  451,
+      453,  454, 1131,  471,  455,  456,  459,  457,  474, 1131,
+      460,  461,  472,  461,  472, 1131,  475,  465,  428,  465,
+      476,  462,  458,  429,  470,  430,  469,  466,  431, 1131,
+      452,  471,  432,  478,  459,  433,  477,  474,  434,  435,
+      479, 1131,  436,  473,  475,  480,  481,  484,  476,  485,
+      488,  482,  429,  489,  430,  463,  490,  431,  452,  483,
+      432,  467,  478,  433,  477,  464,  434,  435,  491,  479,
+      436,  468,  486,  480,  481,  492,  484,  485,  488,  482,
+
+      487,  489,  493,  463,  490,  494,  495,  483,  496,  467,
+      497,  498,  499,  464,  502,  503,  500,  491,  500,  468,
+      504,  486,  505,  506,  492,  507,  501,  508,  487,  509,
+      346,  493,  513,  494,  514,  495,  496,  515,  497,  498,
+      499,  516,  517,  502,  503,  518,  519,  190,  504, 1131,
+      505,  506, 1131,  507,  190,  508,  205,  509,  346,  511,
+      513,  520,  514,  190, 1131,  515,  527,  528,  530,  516,
+      517,  417,  531,  518,  545,  519,  212,  521,  521,  521,
+      521,  521,  521,  521,  521,  521,  521,  522,  529,  212,
+      524,  533,  523,  179,  535,  527,  528,  530,  371, 1131,
+
+      417,  531,  545,  521,  521,  521,  521,  521,  521,  521,
+      521,  521,  521,  522,  212,  525,  529,  212,  524,  179,
+      533,  523,  546,  535,  548,   87, 1131,  371,  539,  521,
+      521,  521,  521,  521,  521,  521,  521,  521,  521,  190,
+     1131,  532,  371,  525,  522,  536,  205,  536,   83,  927,
+      179,  546,  548,  541,  459,  540,  539,  538,  108,  371,
+      526,  526,  526,  526,  526,  526,  526,  526,  526,  526,
+      532,  371,  371,  549,   87,  552,   83,  542,  110,  110,
+     1131,  541,  459,  371,  540,  538,  537,  562,  371,  233,
+      558,  110,  543,  561,  544,  550,  385,  235,  667, 1029,
+
+      667,  371,  549,  552, 1131,  542,   91,  110,  110,  551,
+      553, 1131,  371,   92,   93,  537,  562,   91,  558,  110,
+      543,  561,  544,  550,   92,   93,  389,  389,  389,  389,
+      389,  389,  389,  389,  389,  389,  563,  564,  551,  553,
+      389,  389,  389,  389,  389,  389,  389,  389,  389,  389,
+      402,  565,  402,  555,  566, 1131,  554,  567, 1131,  568,
+      403,  569,  570,  571,  572,  563,  564,  573,  574,  575,
+      576,  577,  578,  589,  578,  590,  591, 1131,  592,  565,
+      593,  596,  555,  566,  554,  597,  567,  568,  594,  569,
+      570,  598,  571,  572,  599,  573,  574,  575,  576,  577,
+
+      437,  589,  437,  590,  595,  591,  592,  602,  593,  596,
+      440,  605,  440,  579,  597,  606,  603,  594,  603,  598,
+      607,  448,  599,  448,  212,  608,  609,  580,  610, 1131,
+      613,  438,  595,  611,  612,  602,  614,  616,  617,  605,
+      619,  441,  579,  615,  606,  618,  621,  604,  620,  607,
+     1131,  622,  449,  608,  609,  580,  427,  610,  427,  613,
+      623,  611,  612, 1131,  629,  614,  616,  617,  461,  619,
+      461,  615,  465,  618,  465,  621,  620,  627,  462,  622,
+      632,  472,  466,  472, 1033,  628,  630,  428,  623,  631,
+      633,  624,  581,  629,  582,  634,  640,  583,  645,  625,
+
+      636,  584, 1131,  637,  585,  627,  638,  586,  587,  632,
+      639,  588,  473,  628,  630, 1131, 1131,  631,  633, 1131,
+      646,  581,  646,  582,  634,  640,  583,  645,  636,  584,
+      626,  637,  585,  644,  638,  586,  587, 1131,  639,  588,
+      600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
+      600,  647,  600,  600,  600,  600,  600,  600,  600,  626,
+      648,  644,  649,  650,  641,  500,  641,  500,  653,  600,
+      600,  600,  600,  600,  642,  501,  654,  655,  656,  657,
+      658,  190,  190,  669,  205,  669,  190, 1131,  667,  648,
+      667,  649,  650,  651,  668,  659,  666,  653,  701,  205,
+
+      600,  600,  571,  212,  654,  670,  655,  656,  657,  658,
+      205,  660,  660,  660,  660,  660,  660,  660,  660,  660,
+      660,  661,  664,  668,  666,  684,  701,  179,  600,  703,
+      662,  571,  663,  675,  670, 1131, 1131,  660,  660,  660,
+      660,  660,  660,  660,  660,  660,  660,  661, 1131,  212,
+      212,  664,  679,  179,  684,  676,  705,  703,  662, 1050,
+      663,  675, 1131,  660,  660,  660,  660,  660,  660,  660,
+      660,  660,  660,  661,  614,  536,  205,  536, 1131,  179,
+      679,  615,  687,  676,  705,  671,  678,  108,  371,  665,
+      665,  665,  665,  665,  665,  665,  665,  665,  665,  677,
+
+      672, 1131,  672,  614,   87,   83,  680,  110,  110,  615,
+      673,  687,  699,  671,  674,  678,  537,  371,  371, 1131,
+      110,  371,  681,   91,  371,  682,  700,  677,  683,  704,
+       92,   93,  706,  712,  680,   91,  110,  110,  689,  713,
+      692,  699,  696,  697,  707,  537,  708,  371,  110,  709,
+      371,  681,  710,  371,  682,  700,  711,  683,  704,  694,
+     1131,  706,  712,  718,  770,  186,  775,  689,  713,  692,
+     1131,  578,  707,  578,  708, 1131,  641,  709,  641,  716,
+      710,  717, 1131,  719,  711,  720,  642,  721,  694,  685,
+      685,  718,  685,  685,  685,  685,  685,  685,  685,  685,
+
+      685,  685,  685,  685,  685,  685,  685,  685,  716,  722,
+      717,  719,  714,  723,  720,  721,  725,  726,  685,  685,
+      685,  685,  685,  727,  728, 1131,  715,  729,  730,  724,
+      731, 1131,  732,  733,  734,  739,  735,  722,  735, 1131,
+      737,  714,  723,  603,  725,  603,  726,  738,  742,  685,
+      685,  727,  740,  728,  715,  729,  730,  724,  741,  731,
+      732,  743,  733,  734,  739,  744,  745,  736,  737,  746,
+      747, 1131,  748,  749,  604,  738,  742,  685,  750,  751,
+      752,  740,  755, 1131,  756,  757,  758,  741,  759,  760,
+      743,  761,  766,  744,  745,  763,  764,  765,  746,  747,
+
+      748,  767,  749,  768,  769,  646,  750,  646,  751,  752,
+      772,  755,  756,  773,  757,  758,  759,  774,  760,  190,
+      761,  766,  190,  763,  764,  765,  779,  780,  669,  767,
+      669,  768,  769,  672,  781,  672,  647,  782,  672,  772,
+      672,  205,  773,  673,  371,  774,  205,  674,  673,  674,
+      371,  674,  674,  212,  212,  779,  780,  801,  777,  776,
+       91, 1131,  781,  674,   91,  371,  782,  798,  799,  788,
+       91,   92,   93,  371,  802,  803, 1131,   92,   93,  371,
+      770,  833,  771,  833,  190,  801,  783,  777,  776,  179,
+      785,  834,  784,  787,  371,  179, 1131,  804,  788,  805,
+
+      806,  807,  802,  108,  803,  109,  109,  109,  109,  109,
+      109,  109,  109,  109,  109,  783,  808, 1131,  809,  785,
+      784,  810,  787,  110,  110,  804,  814,  805,  806,  807,
+      815,  816, 1131,  817,  818, 1131,  110,  851, 1131,  851,
+      770,  864,  770,  864, 1093,  808,  809,  852, 1131,  864,
+      810,  864,  110,  110,  811,  814,  811,  819,  820,  815,
+      816,  817,  821,  818,  110,  786,  786,  212,  786,  786,
+      786,  786,  786,  786,  786,  786,  786,  786,  786,  786,
+      786,  786,  786,  786,  822,  819,  820,  823,  824,  812,
+      826,  821,  825,  827,  786,  786,  786,  786,  786,  828,
+
+      829, 1131,  813,  830,  831,  735,  832,  735,  205,  835,
+      836,  837,  822,  838, 1131,  839,  823,  824,  812,  826,
+      825,  840,  827,  841,  844,  786,  786,  828,  846,  829,
+      813,  830,  831, 1131, 1131,  832,  736,  835, 1131,  836,
+      837,  845,  838,  839,  847,  770,  186,  775,  833,  840,
+      833,  841,  844,  786,  791,   77,  791,  846,  834,  792,
+      792,  842,  792,  842, 1131, 1131,  792,  792, 1095,  845,
+      792, 1131,  847,  792,  792,  792,  792,  792,  792,  792,
+      792,  792,  790,  790,  190,  790,  790,  790,  790,  790,
+      790,  790,  790,  790,  790,  790,  790,  790,  790,  790,
+
+      790,  848,  849,  205,  850,  853, 1131,  856,  858,  843,
+      857,  790,  790,  790,  790,  790,  854,  859,  854,  862,
+      865,  860,  205,  212,  863,  371,  791,   77,  791,  848,
+      873,  849,  850,  879,  853,  856,  858,  843,  874,  857,
+      866, 1131,  790,  790,  875,  876,  859,  877,  862,  865,
+      860,  855,  863,  878,  371,   91,  882,   91,  867,  873,
+      869,  879,   92,   93,   92,   93,  864,  874,  864,  866,
+      790, 1131, 1131,  875,  876, 1131,  877,  811, 1131,  811,
+      855,  871,  878,  883,  882,  872,  884,  867,  885,  869,
+      868,  868,  212,  868,  868,  868,  868,  868,  868,  868,
+
+      868,  868,  868,  868,  868,  868,  868,  868,  868,  886,
+      871,  883,  880,  888,  872,  884,  885,  887,  889,  868,
+      868,  868,  868,  868,  890,  881,  891, 1131,  892,  893,
+      894,  895,  896, 1131,  897,  898,  899,  908,  886,  900,
+      212,  880,  888,  906,  907,  887,  842,  889,  842,  910,
+      868,  868,  890,  881,  911,  891,  892,  893,  894,  895,
+      912,  896,  897,  913,  898,  899,  908,  900,  902,  903,
+      902,  906,  907,  851,  914,  851,  904,  910,  868,  905,
+      915,  917,  911,  852,  854,  918,  854,  919,  912,  920,
+      205,  924,  913,  923,  909,  371,  928, 1131,  929,  930,
+
+     1096,  931,  932,  914,  933,  934,  935,  936,  915,  937,
+      917,  938, 1131,  939,  918,  919,  940,  944,  920,  916,
+      924,  923,  909,  941,  371,  928,  929,  942,  930,  931,
+      932,  943,  933,  934,  935,  936,  945,  937,  950,  926,
+      938,  939,  946,  947,  948,  940,  944,  949,  916,  951,
+      952,  941,  902,  903,  902,  942,  953,  903,  953,  943,
+      904,  960, 1131,  905,  945,  961,  950,  926, 1131,  959,
+      964,  946,  947,  948,  962,  965,  949,  951,  952,  902,
+      903,  902,  966,  955,  956,  955,  967,  904,  968,  960,
+      905,  957,  969,  961,  958,  902,  903,  902,  959,  964,
+
+      190,  971,  962,  904,  965,  972,  905,  205,  205,  212,
+      966,  976,  977,  978,  967, 1131,  968,  979, 1131,  980,
+      981,  969,  982,  983,  984,  987,  985,  988,  985,  989,
+      971,  990,  991,  992,  972,  970,  986,  993,  994,  976,
+      977,  978,  995,  973,  975,  974,  979,  980, 1131,  981,
+      982, 1131,  983,  984,  987,  999,  988,  998,  989,  990,
+      991,  992, 1131, 1131,  970,  993,  994,  996,  903,  996,
+     1001,  995,  973,  975,  974,  955,  956,  955,  190,  955,
+      956,  955, 1000,  957,  999,  998,  958,  957, 1002,  205,
+      958,  997,  956,  997, 1003,  955,  956,  955, 1001,  904,
+
+     1004,  212,  905,  957, 1006,  205,  958,  955,  956,  955,
+     1010, 1000, 1011, 1013, 1011,  957, 1014, 1002,  958, 1131,
+     1015, 1016, 1012, 1003, 1005,  985,  985,  985,  985, 1004,
+     1017, 1018, 1006, 1019, 1007,  986,  986, 1008, 1021, 1010,
+     1020, 1013, 1022,  205,  205, 1014, 1131, 1009, 1015, 1025,
+     1016, 1131, 1005, 1023,  903, 1023, 1026, 1028, 1017, 1018,
+     1036, 1019, 1007, 1039, 1037, 1038, 1008, 1021, 1020, 1040,
+     1041, 1022, 1024,  903, 1024, 1009, 1042, 1032, 1025, 1031,
+      904,  205, 1011,  905, 1011, 1026, 1028, 1034, 1036, 1034,
+     1045, 1039, 1012, 1037, 1038, 1046,  190, 1040, 1047, 1041,
+
+     1035, 1049, 1035,  212, 1042, 1056, 1032, 1055, 1031, 1043,
+      903, 1043, 1044,  903, 1044, 1131, 1057, 1051, 1035, 1045,
+      904, 1058, 1060,  905, 1046, 1034, 1047, 1034, 1063, 1049,
+     1059,  190, 1053, 1056, 1053,  212, 1055, 1064, 1035,  205,
+     1035, 1048, 1073, 1054, 1057, 1035, 1051, 1035, 1052, 1075,
+     1058, 1060, 1061,  903, 1061, 1067, 1035, 1063, 1059, 1062,
+      903, 1062, 1053, 1035, 1053, 1064, 1072,  904, 1074, 1048,
+      905, 1073, 1079, 1054, 1068,  205, 1052, 1066, 1075, 1080,
+     1081, 1071, 1131, 1067, 1078,  903, 1078,  190,  212, 1083,
+     1131, 1086,  904, 1131, 1072,  905, 1074, 1087, 1131, 1090,
+
+     1079,  190,  205, 1068,  190, 1066, 1131, 1080, 1081, 1071,
+     1076,  903, 1076,  205, 1131, 1077, 1077, 1083, 1077, 1086,
+     1097, 1084, 1077, 1077, 1091, 1087, 1077, 1090, 1098, 1077,
+     1077, 1077, 1077, 1077, 1077, 1077, 1077, 1077, 1082, 1085,
+     1076,  903, 1076,  902,  903,  902, 1131, 1100, 1097, 1084,
+     1103,  904,  212, 1091,  905, 1099, 1108, 1098, 1101,  205,
+      212,  205, 1113, 1131,  190, 1131, 1082, 1085,  902,  903,
+      902, 1104,  205, 1088, 1088, 1100, 1089,  190, 1103,  905,
+     1088, 1088,  212, 1099, 1088, 1108, 1101, 1088, 1088, 1088,
+     1088, 1088, 1088, 1088, 1088, 1088,  902,  903,  902, 1104,
+
+      955,  956,  955, 1102,  904, 1105,  190,  905,  957, 1106,
+     1112,  958, 1109, 1107,  212, 1115, 1116,  212, 1110, 1119,
+     1120, 1119,  205, 1117, 1121, 1122, 1121, 1124, 1125, 1124,
+      205, 1102,  205, 1105, 1119, 1120, 1119, 1106, 1111, 1112,
+     1109,  205, 1107, 1115, 1116, 1131, 1114, 1110, 1121, 1122,
+     1121, 1117, 1124, 1125, 1124, 1129, 1130, 1129, 1129, 1130,
+     1129, 1131, 1131, 1131, 1127, 1131, 1126, 1111, 1118, 1131,
+     1131, 1123, 1131, 1131, 1131, 1114, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1128, 1127, 1131, 1126, 1118, 1131, 1131, 1123,
+
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1128,   66,   66,   66,   66,   66,   66,   66,   66,   66,
+       66,   66,   66,   66,   67,   67,   67,   67,   67,   67,
+       67,   67,   67,   67,   67,   67,   67,   79, 1131,   79,
+       79,   79,   79,   79,   79,   79,   79,   79,   79,   79,
+       82,   82,   82,   82,   82,   82,   82,   82,   82,   82,
+       82,   82,   82,   86,   86,   86,   86,   86,   86,   86,
+       86,   86,   86,   86,   86,   86,   90,   90,   90,   90,
+       90,   90,   90,   90,   90,   90,   90,   90,   90,  113,
+
+      113,  113,  113,  113,  113,  113,  113,  113,  189,  189,
+      189,  189,  189,  189,  189,  189,  189,  189,  189,  189,
+      189,  204,  204,  204,  204,  204,  204,  204,  204,  204,
+      204,  204,  204,  204,  210,  210,  210,  210,  210, 1131,
+      210,  210,  210, 1131,  210, 1131,  210,  231,  231,  231,
+      231,  231,  231,  231,  231,  231,  231,  231,  231,  231,
+       99, 1131, 1131, 1131, 1131, 1131, 1131, 1131,   99,  249,
+      249, 1131,  249,  249, 1131,  249, 1131, 1131,  249,  249,
+     1131,  249,  336,  336,  336,  336,  340,  340,  340,  340,
+      340,  340,  340,  340,  340,  340,  340,  340,  340,  365,
+
+      365,  365,  365,  365,  365,  365,  365,  365,  365,  365,
+      365,  365,  371,  371,  371,  371,  371,  371,  371,  371,
+      371,  371,  371,  371,  371,  601,  601,  601, 1131,  601,
+      601,  601,  601,  601,  601,  601,  601,  601,  685, 1131,
+      685,  685,  685,  685,  685,  685,  685,  685,  685,  685,
+      685,  688, 1131,  688,  688,  688,  688,  688,  688,  688,
+      688,  688,  688,  688,  690,  690,  690,  690,  690,  690,
+      690,  690,  690,  690,  690,  690,  690,  693,  693,  693,
+      693,  693,  693,  693,  693,  693,  693,  693,  693,  693,
+      695,  695,  695,  695,  695,  695,  695,  695,  695,  695,
+
+      695,  695,  695,  702, 1131,  702,  702,  702,  702,  702,
+      702,  702,  702,  702,  702,  702,  778,  778,  778,  778,
+      778,  778,  778,  778,  778,  778,  778,  778,  778,  786,
+      786,  786,  786,  786,  786,  786,  786,  786,  786,  786,
+      786,  786,  789,  789,  789,  789,  789,  789,  789,  789,
+      789,  789,  789,  789,  789,  790, 1131,  790,  790,  790,
+      790,  790,  790,  790,  790,  790,  790,  790,  793, 1131,
+      793,  793,  793,  793,  793,  793,  793,  793,  793,  793,
+      793,  794,  794,  794,  794,  794,  794,  794,  794,  794,
+      794,  794,  794,  794,  796,  796,  796,  796,  796,  796,
+
+      796,  796,  796,  796,  796,  796,  796,  797,  797,  797,
+      797,  797,  797,  797,  797,  797,  797,  797,  797,  797,
+      800, 1131,  800,  800,  800,  800,  800,  800,  800,  800,
+      800,  800,  800,  861,  861,  861,  861,  861,  861,  861,
+      861,  861,  861,  861,  861,  861,  868,  868,  868,  868,
+      868,  868,  868,  868,  868,  868,  868,  868,  868,  870,
+      870,  870,  870,  870,  870,  870,  870,  870,  870,  870,
+      870,  870,  901,  901,  901,  901,  901,  901,  901,  901,
+      901,  901,  901,  901,  901,  954,  954,  954,  954,  954,
+      954,  954,  954,  954,  954,  954,  954,  954, 1069, 1069,
+
+     1069, 1069, 1069, 1069, 1069, 1069, 1069, 1069, 1069, 1069,
+     1069,   13, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+
+     1131
     } ;
 
-static yyconst flex_int16_t yy_chk[9249] =
+static yyconst flex_int16_t yy_chk[4102] =
     {   0,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
@@ -8737,77 +7708,94 @@
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    2,
-        2,    2,    2,   10,    8,    8,    8,    8,   15,   15,
-
-       15,   68, 1129,   14,   10, 1119,   68,    2,    2,    2,
-        2,    2,    2,    2,    2,    2,    2,   14,   16,   16,
-       16,   54,   54,   54,    2,    2,   18,   10,    2,   19,
-        2,    8,   14,   17,   17,   17,   15,   20,   21, 1096,
-       18,    2,    2,  176,   22,   14, 1084,   25,   26,  176,
-       15,   20,   21,    2,    2,   18,   10,    2,   75,    2,
-        8,   25,   42,   19,   69,   15,   20,   21,   18,    2,
-        2,   17,   24,   27,   26,   23,   25,   19,   15,   20,
-       21,   22,   23,   23,   29,   17,   75,   27,   26,   25,
-     1045,   42,   19,   24,  959,   22,   30,  339,   74,  339,
-
-       17,   82,   27,   26,  340,   19,  340,   24,   83,   69,
-       22,   29,   23,   17,   31,   27,   26,   32,   30,   34,
-       41,  178,   24,   22,  916,   29,   23,   74,   31,  912,
-       82,   32,   30,   34,   41,   24,   83,   69,   49,  685,
-       29,   23,   49,   31,  905,  685,   32,   30,   34,   41,
-      178,  207,   33,   29,   23,   28,   31,   28,   33,   32,
-       30,   34,   41,   76,   76,   76,  242,   49,   67,   67,
-       67,   49,   33,   28,   28,   28,   28,   28,   28,   28,
-       28,   28,   28,   86,   43,   63,  207,   33,   28,   43,
-       44,  350,   28,   28,   28,  242,   43,   43,  904,   28,
-
-       33,   28,   28,   63,   44,   67,   91,   28,   77,   77,
-       77,   28,   86,   43,   63,  207,  837,   28,   43,   44,
-      350,   28,   28,   28,   43,   43,   87,   28,  360,   28,
-       28,   63,   44,  835,   67,   28,   78,   78,   78,   28,
-       35,   86,   35,   35,   35,   35,   35,   35,   35,   35,
-       35,   35,   38,   40,  830,   91,   38,  360,   35,   35,
-       38,   40,   35,  903,   40,  102,   38,   40,   35,  103,
-       38,  107,   87,   40,   90,   35,   35,   79,   79,   79,
-      825,   38,   40,   91,  342,   38,  342,   35,   35,   38,
-       40,   35,   40,  102,   38,   40,   35,  103,   38,  107,
-
-       87,   40,  108,   35,   35,   36,   90,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,  179,   37,  359,
-       39,  359,   36,  903,  823,   37,   45,   36,  822,   37,
-      108,   39,   37,   39,   45,   90,   39,   39,   46,  205,
-       45,   36,   37,   39,  812,  179,   46,   37,  393,   39,
-      180,   36,   46,  182,   37,   45,   36,   37,   46,   39,
-       37,   39,   48,   45,   39,   39,   51,   46,   45,   36,
-       37,   39,   47,   51,  811,   46,   48,  393,  180,   48,
-       46,  182,   48,   51,  205,   47,   46,   47,  104,   50,
-      220,   48,   47,   50,  529,   51,  529,   50,  396,   52,
-
-      450,   47,   51,  104,   48,   50,   52,   48,   50,   50,
-       48,   51,  205,   47,  532,   47,   52,  104,   50,  804,
-       47,  220,   50,   80,   80,   80,   50,  396,   52,  450,
-      530,  104,  530,   50,   92,   52,   50,   50,   55,   55,
-       55,   92,   92,  532,   52,   53,   53,   53,   53,  220,
-       56,  223,  531,   53,  531,   56,   55,   55,   55,   55,
-       55,   55,   55,   55,   55,   55,  184,  184,  184,   94,
-       70,   70,   70,   71,   71,   71,   94,   94,   60,  223,
-       53,   53,   70,   53,   53,   71,   53,   56,  726,   60,
-      106,  191,   60,  686,   93,   93,   93,   53,   53,  686,
-
-      106,   56,   93,   93,  181,   70,  725,   60,   71,   53,
-       53,  181,   53,   53,  723,   53,   56,   60,  722,  106,
-       60,   72,   72,   72,  910,   53,   53,  214,  106,   56,
-       57,   58,  181,   72,   70,   96,   57,   71,  222,  181,
-      191,  716,   96,   96,   57,  189,   57,   57,   57,   57,
-       57,   57,   57,   57,   57,   57,   59,  222,   58,   72,
-       59,  208,  208,  208,   59,   58,   57,   96,  191,   58,
-       59,  190,   58,   72,   59,  714,  214,  189,   61,  206,
-       57,  706,   58,   61,  910,   59,  222,   58,   72,   59,
-       61,   61,   62,   59,   58,   57,   96,   58,   59,   62,
-
-       58,   72,   59,  190,  214,  224,  189,   61,   57,   62,
-       58,  206,   61,  210,  210,  210,   62,  689,   61,   61,
-      664,   62,  225,  225,  225,  585,  580,  232,   62,  578,
-      558,  235,  190,  224,  232,  232,  554,   62,  235,  235,
-      206,  372,  372,  372,   62,   73,   73,   73,   73,   73,
+        2,    2,    2,   74,    8,    8,    8,    8,   10,   15,
+
+       15,   15, 1083,   14,   16,   16,   16,    2,    2,    2,
+        2,    2,    2,    2,    2,    2,    2,   14,   70,   17,
+     1081,   10,   74,   70,    2,    2,   71,   75,    2,    8,
+        2,    8,   14,   17,   18,   19,   21,   15,   20,   22,
+      551,    2,    2,  551, 1069,   14,   22,   22,   17,   19,
+       10,   15,   20,    2,    2,   75,   80,    2,    8,    2,
+        8,   17,   84,   23,   19,   30,   15,   20,   18,    2,
+        2,   71,   24,   21,   26,   30,   22,   19,   81,   15,
+       20,   25,   18,  116,   23,   80,   24,   21,   26,   30,
+       22,   84,   28,   85,  100,   31, 1051,   18,   23,   71,
+
+      624,   24,   21,   26,   30,   22,   81,   25,  624,   31,
+       18,   32,  116,   23,   24,   21,   26,   30,   22,   28,
+       84,   25,  100, 1047,   31,   32,   23,   56,   56,   56,
+       76,   76,   76,   28,  101,  105,   25,   31,  106,   85,
+       32,  179,   69,   69,   69,   33, 1006,  179,   28,   25,
+       27,   33,   27,   32,   77,   77,   77,   78,   78,   78,
+     1000,   28,  101,  105,  914,   33,  106,   85,   27,   27,
+       27,   27,   27,   27,   27,   27,   27,   27,   34,   69,
+       33,   35,   35,   27,  120,   35,   41,   27,   27,   27,
+      868,   35,   34,   33,   27,   41,   27,   27,   35,   35,
+
+       41,  862,   27,  123,   89,  861,   27,   34,   69,  796,
+       35,   35,   27,  120,   35,   41,   27,   27,   27,   35,
+       34,  114,   27,   41,   27,   27,   35,   35,   41,   88,
+       27,   36,  123,   42,   27,   29,   36,   29,   29,   29,
+       29,   29,   29,   29,   29,   29,   29,   42,  794,  114,
+       36,   90,  337,   89,  337,   29,   29,   29,   90,   90,
+       36,   88,   42,  115,  117,   36,  104,  786,   29,  121,
+      122,   29,  126,   44,  109,   42,  104,   54,   36,   38,
+       38,   89,   44,   38,   29,   29,   29,   44,  109,   38,
+       88,  115,  117,   38,   38,  104,   29,  121,  122,   29,
+
+       37,  126,   44,  109,  104,   37,   54,   37,   38,   38,
+       44,   37,   38,  785,   37,   44,  109,   38,   92,   37,
+       54,   38,   38,  778,   37,   92,   92,  660,  777,   37,
+      186,  186,  186,  660,   37,   54,   37,   43,  693,   37,
+      132,   45,   37,  692,   43,   43,   45,   37,   54,   45,
+      690,   43,   37,   39,  625,   45,   72,   72,   72,   39,
+       45,   39,   39,  625,   39,   39,   43,   39,   72,  132,
+       45,   39,   43,   43,  124,   45,  102,  689,   45,   43,
+      689,  678,   39,   45,  211,  211,  211,   39,   45,   39,
+       39,  102,   39,   39,   72,   39,  119,   49,   49,   39,
+
+       40,  664,  124,   40,  635,  102,   40,   40,   72,   40,
+       46,  753,   49,  119,   40,   40,  128,  143,   46,  102,
+      753,   46,   46,   72,   46,  119,   49,   49,  118,   40,
+       46,  558,   40,  103,   40,   40,   72,   40,  118,   46,
+       49,  119,   40,   40,  128,   47,  143,   46,  103,   46,
+       46,   48,   46,   47,  129,   47,   48,  118,   46,   47,
+       47,   52,  103,  130,  131,   48,  118,  133,   48,   52,
+       48,   48,  661,  553,   47,   52,  103,  534,  661,  134,
+       48,   47,  129,   47,  519,   48,  135,   47,   47,  137,
+       52,  130,  131,   48,   95,  133,   48,   52,   48,   48,
+
+       50,   95,   95,   52,   50,   50,   51,  134,   50,  496,
+       53,   51,   53,   51,  135,  487,   50,  137,  139,   50,
+       50,  140,   53,   51,   53,   51,  224,  224,  224,   50,
+      401,  399,  146,   50,   50,   51,  141,   50,  144,   53,
+       51,   53,   51,   95,   50,   60,  139,   50,   50,  140,
+       53,   51,   53,   51,   55,   55,   55,   55,   57,   57,
+       58,  146,   55,  392,  141,   58,  144,  338,  138,  338,
+      147,   95,   60,  390,  138,   57,   57,   57,   57,   57,
+       57,   57,   57,   57,   57,  148,   60,  149,  159,   55,
+       55,   65,   55,   55,   62,   55,  138,   58,  147,   65,
+
+       62,   60,  138,   62,   65,   65,   55,   55,   62,  365,
+      150,   58,  362,  148,   60,  340,  149,  159,   55,   55,
+       65,   55,   55,   62,   55,  151,   58,   65,   62,  336,
+      247,   62,   65,   65,   55,   55,   62,   63,  150,   58,
+       59,   91,   91,   91,   63,   63,   59,  244,  243,   91,
+       91,   63,  242,  151,   59,  241,   59,   59,   59,   59,
+       59,   59,   59,   59,   59,   59,   63,   99,   99,  142,
+       94,  142,   63,   63,   59,   59,   59,   94,   94,   63,
+       99,  152,  125,  125,  153,  154,  155,   59,  125,  157,
+       59,  161,  213,  511,  163,  511,   99,   99,  164,  210,
+
+      166,  127,   94,   59,   59,   59,  127,  170,   99,  152,
+      125,  125,  153,  154,  155,   59,  125,  157,   59,   61,
+      161,  142,  163,   61,   61,  204,  164,   61,  166,  860,
+      127,   94,  189,   61,  182,  127,  170,   61,   61,  158,
+       64,  178,  158,  136,  165,   64,  145,   64,   61,  142,
+      136,  165,   61,   61,  136,  171,   61,   64,  145,   64,
+      145,   61,  182,  145,   64,   61,   61,  158,   87,   64,
+      158,   86,  136,  165,   64,  145,   64,   82,  136,  165,
+       67,  512,  136,  512,  171,   64,  145,   64,  145,  860,
+       13,  145,   64,   73,   73,   73,   73,   73,   73,   73,
+
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
@@ -8815,934 +7803,352 @@
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   97,  101,  101,  105,  204,  204,
-      204,   97,   97,  226,  538,  227,  213,  675,  101,  675,
-      534,  111,  105,  111,  111,  111,  111,  111,  111,  111,
-      111,  111,  111,  421,  101,  101,  105,  375,  375,  375,
-      419,  226,  173,  227,  173,  204,  101,  114,  213,  534,
-      105,  219,  412,   97,  113,  113,  113,  113,  113,  113,
-      113,  113,  113,  113,  114,  228,  115,  118,  219,  114,
-
-      116,  115,  118,  125,  204,  116,  410,  213,  125,  231,
-      173,   97,  100,  114,  100,  115,  118,  229,  116,  116,
-      386,  221,  125,  114,  173,  115,  118,  219,  114,  116,
-      115,  118,  125,  379,  116,  228,  249,  125,  230,  173,
-      374,  114,  251,  115,  118,  100,  116,  116,  117,  100,
-      125,  100,  173,  117,  243,  221,  100,  276,  100,  100,
-      248,  231,  117,  228,  249,  401,  229,  117,  100,  294,
-      251,  294,  401,  401,  100,  371,  343,  117,  100,  294,
-      100,  230,  117,  221,  100,  276,  100,  100,  535,  231,
-      117,  250,  243,  248,  229,  117,  100,  110,  110,  110,
-
-      110,  110,  110,  110,  110,  110,  110,  119,  121,  230,
-      913,  247,  119,  121,  120,  110,  110,  535,  119,  120,
-      243,  248,  120,  246,  400,  121,  119,  121,  110,  245,
-      233,  233,  233,  120,  341,  277,  119,  121,  233,  233,
-      344,  119,  121,  120,  110,  110,  119,  122,  120,  122,
-      244,  120,  122,  121,  119,  121,  110,  177,  123,  218,
-      400,  120,  341,  123,  212,  345,  122,  346,  344,  354,
-      913,  177,  277,  347,  209,  123,  122,  123,  122,  124,
-      202,  122,  348,  126,  124,  187,  177,  123,  126,  400,
-      124,  349,  123,  345,  122,  346,  183,  126,  124,  177,
-
-      277,  347,  126,  123,  676,  123,  676,  354,  124,  127,
-      348,  175,  126,  124,  127,  174,  237,  126,  124,  349,
-       89,  127,  127,  237,  237,  126,  124,  127,  127,  128,
-      126,  128,  129,  389,  128,  130,  354,  129,  127,  292,
-      130,  292,  361,  127,  234,  234,  234,  130,  128,  127,
-      127,  129,  234,  234,  130,  127,  127,  536,  128,  237,
-      128,  129,   88,  128,  130,  388,  129,   84,  389,  130,
-      361,  380,  380,  380,  356,  130,  128,   65,   13,  129,
-      378,  238,  130,  131,  355,  131,  536,  237,  238,  238,
-      369,  292, 1051,  388,  390,  133,  389,  392,    9,  131,
-
-      133,  131,  131,  131,  131,  131,  131,  131,  131,  131,
-      131,  132, 1081,  133,  133,  134,  132,    7,  134,  292,
-      134,  388,  132,  398,  133,  392,  356,  355,  369,  133,
-      132,  390,  378,  238,  134,  677,  131,  677,  131, 1130,
-      132,  133,  133,  381,  134,  132,  136,  134,  135,  134,
-      132,  136, 1051,  135,  356,  355,  398,  369,  132,  390,
-      378,  238,  134,  136,  131,  136,  131,  135,  135,  139,
-      377,  137, 1081,  138,  139,  136,  137,  135,  138,  137,
-      136,  381,  135,  139,  138,  398,  137,  395,  139,    0,
-      137,  136,  138,  136,  418,  135,  135,  397,  139, 1130,
-
-      137,  382,  138,  139,  140,  137,  475,  138,  137,  140,
-      381,  139,  138,  377,  137,  395,  139,  142,  137,  142,
-      138,  140,  418,  140,  141,  399,  143,  144,  143,  141,
-     1131,  537,  144,  140,  475,    0,  143,  141,  140,  391,
-      533,  377,  144,  141,  397,  382,  144,    0,  543,  140,
-      142,  140,  466,  141,  466,  142,  144,  146,  141,  143,
-      537,  144,  146,  146,  143,  141,    0,  391,  533,  142,
-      144,  141,  397,  382,  144,  399,  146,    0,  143,  142,
-      145,    0,  145,  466,  142,  145,  146,  680,  143,  680,
-     1131,  146,  146,  143,  145,  391,  145,  142,  543,  145,
-
-      147,    0,  148,  399,  146,  147,  143,  148,  557,  145,
-      484,  145,  484,  546,  145,  148,  394,  394,  394,  147,
-      484,  148,  145,  147,  145,  149,  543,  145,  149,  147,
-      149,  148,  572,  150,  147, 1148,  148,  151,  150,    0,
-        0,  546,  151,  148,  149,  150,  547,  147,    0,  148,
-      151,  147,  150,  557,  149,    0,  151,  149,    0,  149,
-      544,  572,  150,  152,  153,    0,  151,  150,  152,  153,
-        0,  151,  149,  150,  547,  153,  152,  488,  151,  488,
-      150,  557,  152,  153,  151,    0,  155,  488,    0,  154,
-      155,  155,  152,  153,  154, 1148,  544,  152,  153,  521,
-
-      154,  521,    0,  153,  152,  155,  611,    0,  154,  521,
-      152,  153,  156,  253,  253,  155,  158,  156,  154,  155,
-      155,  158,  402,  154,  158,  544,  253,    0,  154,  402,
-      402,  156,  157,  155,  611,  158,  154,  157,  559,  559,
-      559,  156,  253,  253,    0,  158,  156,  612,    0,  157,
-      158,  157,  157,  158,  253,  160,  160,  159,    0,  156,
-      160,  157,  159,  158,  614,  159,  157,  370,  370,  370,
-      615,  159,  402,  561,  160,  612,  159,  157,    0,  157,
-      157,  194,  162,  194,  160,  160,  159,  162,  161,  160,
-      161,  159,  614,  161,  159,  556,  556,  556,  615,  159,
-
-      402,  162,  160,  162,  159,    0,  161,  161,  370,  542,
-      161,  162,  575,  163,  194,  564,  162,  161,  163,  161,
-      164,  555,  161,  561,  163,  164,  164,  563,  194,  162,
-        0,  162,  163,  164,  161,  161,  556,  370,  161,  164,
-      165,  575,  163,  194,  568,  165,  692,  163,  692,  164,
-      617,  561,  163,  562,  164,  164,  194,  165,  542,  165,
-      163,  164,  564,  166,  403,  556,  682,  164,  166,  165,
-      555,  403,  403,  577,  165,  569,  563,  166,  617,  568,
-      166,    0,  166,  167,  167,  165,  542,  165,  167,  562,
-      564,  697,  166,  697,  682,  167,  569,  166,  555,  744,
-
-      403,    0,  167,  570,  563,  166,  577,  568,  166,  168,
-      166,  579,  167,  167,  168,  169,    0,  167,  562,  169,
-      169,    0,  168,  167,  570,  569,  168,  744,  168,  403,
-      167,  571,  170,    0,  169,  577,  753,  170,  168,    0,
-      170,  171,    0,  168,  169,  171,  171,  579,  169,  169,
-      168,  170,  571,  570,  168,    0,  168,  574,  574,  574,
-      171,  170,  169,  172,  753,  581,  170,  604,  172,  170,
-      171,  172,  581,  581,  171,  171,  579,  582,  613,  170,
-      618,  571,  172,  687,  582,  582,    0,    0,  171,  678,
-        0,  678,  172,  185,  185,  185,  604,  172,  756,  678,
-
-      172,  581,  679,  635,  815,  635,  815,  613,  757,  618,
-      172,  185,  185,  185,  185,  185,  185,  185,  185,  185,
-      185,  186,  681,  687,    0,  678,  756,  186,  713,    0,
-      581,  679,  691,  608,  635,  608,  757,  186,  186,  186,
-      186,  186,  186,  186,  186,  186,  186,  192,  683,  713,
-      683,  681,  687,  192,  678,  684,  684,  684,  683,    0,
-      703,  691,  683,  192,  192,  192,  192,  192,  192,  192,
-      192,  192,  192,  193,  608,  215,  215,  215,  713,  193,
-      708,  708,  708,  748,  826,  826,  826,  193,  608,  193,
-      193,  193,  193,  193,  193,  193,  193,  193,  193,  195,
-
-      703,  196,  197,  608,  195,  749,  196,  197,  215,    0,
-      195,  616,  748,  196,  196,  688,  608,  195,  195,  196,
-      196,  197,  215,  832,  832,  832,  704,  616,  195,  703,
-      196,  197,  707,  195,  749,  196,  197,  215,  195,  198,
-      616,  196,  196,    0,  198,  195,  195,  196,  196,  197,
-      215,  688,  702,  198,  702,  616,  200,    0,  198,  201,
-      199,  200,  199,  201,  201,  199,  702,  755,  198,  758,
-        0,  200,  707,  198,  199,  200,  199,  704,  201,  199,
-      688,  198,  759,  807,    0,  200,  198,    0,  201,  199,
-      200,  199,  201,  201,  199,  216,  755,    0,  758,  200,
-
-        0,  707,  199,  200,  199,  704,  201,  199,    0,    0,
-      759,  807,  216,  216,  216,  216,  216,  216,  216,  216,
-      216,  216,  217,  217,  217,  217,  217,  217,  217,  217,
+       73,   73,   98,  110,   98,  110,    7,  156,  110,  110,
+      110,  110,  110,  110,  110,  110,  110,  110,  160,  366,
+
+      366,  366,  156,  183,  160,  172,  528,  168,  528,  169,
+      173,  174,    0,  169,  173,   98,  156,  185,  168,   98,
+      181,   98,  866,  530,  196,  530,   98,  160,   98,   98,
+      156,  183,  160,  162,  172,  162,  168,  169,   98,  173,
+      174,  169,    0,  173,   98,  185,  168,    0,   98,  181,
+       98,  162,  162,  196,   98,  162,   98,   98,  176,  199,
+      176,    0,  162,  191,  162,    0,   98,  108,  108,  108,
+      108,  108,  108,  108,  108,  108,  108,  167,  180,  162,
+      162,  184,  866,  162,  203,  108,  108,  199,  184,  192,
+      200,  167,  180,  193,  167,  191,  176,  231,  108,  202,
+
+        0,  207,  215,    0,  231,  231,  167,  180,    0,  184,
+      176,  187,  187,  203,  108,  108,  184,  208,  200,  167,
+      180,  192,  167,    0,  191,  176,  108,  202,  187,  187,
+      187,  187,  187,  187,  187,  187,  187,  187,  176,  188,
+      197,  651,  193,  651,  239,  188,  207,  197,  222,  208,
+      192,  215,  223,    0,    0,  188,  188,  188,  188,  188,
+      188,  188,  188,  188,  188,  194,  198,  198,  197,  214,
+      193,  194,  198,  239,  207,  197,  222,    0,  208,  215,
+      223,  194,  194,  194,  194,  194,  194,  194,  194,  194,
+      194,  195,  209,  225,  198,  198,  216,  195,    0,  240,
+
+      198,  214,  206,  206,  206,  195,  201,  195,  195,  195,
+      195,  195,  195,  195,  195,  195,  195,  226,  201,  246,
+      201,  225,  227,  201,  229,  195,  195,  209,  216,  221,
+      214,  221,    0,    0,  258,  201,  234,  240,  195,  206,
+      230,    0,  228,  234,  234,  226,  201,  246,  201,    0,
+      652,  201,  652,    0,  195,  195,  209,  216,  221,    0,
+      221,  245,  227,  258,    0,  240,  195,  229,  206,  217,
       217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  239,    0,  239,  860,  760,  239,  239,  239,  239,
-      239,  239,  239,  239,  239,  239,  240,    0,  240,  863,
-      805,  240,  240,  240,  240,  240,  240,  240,  240,  240,
-      240,  241,  860,  241,  760,  806,  241,  241,  241,  241,
-      241,  241,  241,  241,  241,  241,  254,  863,  254,  805,
-        0,  254,  254,  254,  254,  254,  254,  254,  254,  254,
-      254,  255,    0,  255,  806,    0,  255,  255,  255,  255,
-      255,  255,  255,  255,  255,  255,  256,  808,  256,  259,
-      865,  256,  256,  256,  256,  256,  256,  256,  256,  256,
-
-      256,  257,  257,  257,  257,  257,  257,  257,  257,  257,
-      257,    0,  259,  769,  260,  769,  808,  259,  865,  260,
-      257,  258,  258,  258,  258,  258,  258,  258,  258,  258,
-      258,  259,  260,  260,  261,  813,  901,  262,  901,  261,
-      258,  259,  262,  260,  769,  261,  259,  727,  260,  257,
-      908,  262,  908,  261,  727,  727,  262,  263,  705,  259,
-      260,  260,  263,  261,  813,  693,  262,  693,  261,  258,
-      263,  262,    0,  261,    0,  693,  263,  264,  266,  262,
-      265,  261,  264,  266,  262,  265,  263,  803,  266,  803,
-      264,  263,    0,    0,  705,  803,  264,  266,  263,  265,
-
-      265,  693,  851,  268,  263,  810,  264,  266,  268,  265,
-      267,  264,  266,    0,  265,  267,  266,    0,  264,    0,
-      268,  267,  268,  705,  264,  266,    0,  265,  265,  267,
-      693,  851,  268,  269,    0,  271,  821,  268,  269,  267,
-      271,  270,  810,    0,  267,  700,  270,  700,  268,  267,
-      268,  269,  269,  270,  271,  700,  270,  267,  272,  700,
-      270,    0,  269,  272,  271,  272,  728,  269,    0,  271,
-      270,  810,  821,  728,  728,  270,    0,  272,  273,  269,
-      269,  270,  271,  273,  270,  274,    0,  272,  270,  273,
-      274,  729,  272,  794,  272,  794,  274,  273,  729,  729,
-
-        0,  821,    0,  794,  274,  272,    0,  273,  278,  278,
-      857,  275,  273,  278,  274,  275,  275,  273,  900,  274,
-      859,  809,  809,  809,  274,  273,  820,  278,  279,  809,
-      275,  280,  274,  279,  824,  279,  280,  278,  278,  857,
-      275,  284,  278,  284,  275,  275,  900,  279,  281,  859,
-      280,  861,  281,  281,    0,  278,  862,  279,  275,  864,
-      280,  925,  279,  820,  279,  280,    0,  281,  283,    0,
-        0,  824,  284,  283,  284,  279,  283,  281,  280,  284,
-      861,  281,  281,  838,  875,  862,  875,  283,  864,  925,
-      838,  838,  820,  284,  875,  281,  282,  283,  282,  285,
-
-      824,  894,  283,  284,  285,  283,  286,  899,  284,  422,
-      422,  286,  839,  902,  893,  283,  893,  285,  285,  839,
-      839,  284,  422,    0,  893,  286,    0,  282,  285,  282,
-      894,  911,  282,  285,  282,  286,  899,  282,  422,  422,
-      286,  282,  902,    0,  282,  285,  285,  282,  282,  289,
-      422,  282,  287,  286,  289,  288,  287,  287,  282,  288,
-      288,  282,  934,  282,  937,  884,  282,  884,  289,  282,
-        0,  287,  282,    0,  288,  282,  282,  926,  289,  282,
-      911,  287,  290,  289,  288,  287,  287,  290,  288,  288,
-      291,  934,  291,  937,  290,  291,  289,  929,  293,  287,
-
-      931,  290,  288,  293,  896,  926,  896,  932,  911,  291,
-        0,  290,  293,  884,    0,  296,  290,  293,  933,  291,
-      296,  291,  290,  935,  291,  929,  296,  293,  931,  290,
-      961,  297,  293,    0,  296,  932,  297,  291,  298,  896,
-      293,  884,  297,  298,  296,  293,  933,    0,  954,  296,
-      297,  935,    0,  964,  296,    0,    0,  298,  298,  961,
-      297,  299,  296,    0,    0,  297,  299,  298,  896,  965,
-      297,  980,  298,  948,  948,  948,  954,  966,  297,  972,
-      299,  299,  964,  300,  301,  298,  298,  300,  300,  301,
-      299,  302,  301,  302,  303,  299,  303,  965,  967,  980,
-
-      300,  302,  300,  301,  303,  968,  966,  968,  299,  299,
-        0,    0,  300,  301,  989,  972,  300,  300,  301,  990,
-      304,  301,  973,  981,  302,  304,  984,  303,  300,  302,
-      300,  301,  303,  967,  968,  302,  968,    0,  303,  304,
-      304,  986,  989,  302,  972,  302,  303,  990,  303,  304,
-     1005,    0,  981,  302,  304,  984,  303,    0,  302,  973,
-      305,  303,  967,  302,  305,  305,  303,  304,  304,  987,
-      986,  302,  306,  302,  303,  988,  303,  306, 1005,  305,
-      307,  308, 1008, 1016,  307,  307,  308,    0,  973,  305,
-     1010,  306,  308,  305,  305,    0,    0,  309,  987,  307,
-
-      308,  306,  309, 1015,  988,    0,  306,  305,    0,  307,
-      308, 1008, 1013,  307,  307,  308,  309,  310, 1010,  306,
-      308,  309,  310,  998,  998,  998,  309,  307,  308, 1016,
-      310,  309, 1015,  311,  312,    0,  310,  313,  311,  312,
-     1013,  311,  313,  852,  309,  852,  310, 1017,    0,  309,
-        0,  310,  311,  312,  314,    0,  313, 1016,  310,  314,
-     1018,    0,  311,  312,  310, 1028,  313,  311,  312, 1027,
-      311,  313,  314,  314,  315,    0, 1017,  316,  852,  315,
-      311,  312,  316,  314,  313, 1022, 1032,  315,  314, 1018,
-      316,  852, 1034,  315, 1028,    0,  316, 1027,  316, 1036,
-
-      314,  314, 1021,  315,  317, 1023,  316,  852,  315,  317,
-      317,  316,    0,    0, 1032,  315, 1043, 1022,  316,  852,
-     1034,  315, 1049,  317,  316,  318,  316, 1036,    0,  319,
-      318,    0,  319,  317,  319,    0,  318,  320,  317,  317,
-      319, 1023,  320,    0,  318, 1043, 1022, 1021,  319, 1046,
-     1049,  317,    0, 1024,  318, 1053,  320,  320,  319,  318,
-      321,  319,  322,  319,  318,  321,  320,  322,  319,  323,
-     1023,  320,  318, 1052,  323, 1021,  319,  323, 1046,  321,
-      321,  322,  322, 1053,  320,  320,    0,    0,  323,  321,
-        0,  322,  326, 1024,  321,  324,  322,  326,  323,  324,
-
-      324,    0, 1052,  323, 1060,  326,  323,  321,  321,  322,
-      322,  326,  328,    0,  324,  325,  323,  328,  327,  325,
-      325,  326, 1024,  327,  324,  327,  326, 1061,  324,  324,
-     1058,  328, 1060,  326,  325,    0, 1055,  327,  329,  326,
-        0,  328,  324,  329,  325,  330,  328,  327,  325,  325,
-      330, 1057,  327,  332,  327,  332, 1061,  329,    0,  328,
-      330,  331,  325,  332,  330,  327,  331,  329, 1041, 1041,
-     1041, 1055,  329,    0,  330, 1058, 1064,    0,  331,  330,
-      331, 1066,  333, 1056, 1057,  329,  332,  333,  330,  333,
-      331,  332,  330,  334, 1072,  331,    0, 1074,  334,  334,
-
-     1055,  333,  336, 1058, 1064,  332,  331,  336,  331, 1076,
-     1066,  333,  334, 1057,  336,  332,  333, 1056,  333,  335,
-      332,  336,  334, 1072,  335, 1074, 1078,  334,  334,  333,
-        0,  336,  335,  332,    0,    0,  336, 1076,  335,  337,
-      334, 1085,  336,    0,  337,  338, 1056, 1094,  335,  336,
-      338,    0,  974,  335, 1078, 1086,  337, 1090,  337, 1083,
-      335,  876,  876,  876,  338,    0,  335,    0,  337,  876,
-     1085, 1082,  876,  337,  338,  351, 1094,  351,    0,  338,
-      946,  946,  946, 1086,  337, 1090,  337,  974,  946,  974,
-        0,  946,  338,  351,  351,  351,  351,  351,  351,  351,
-
-      351,  351,  351,  352,  947,  947,  947, 1082,    0,  352,
-        0, 1083,  947,    0, 1077,  947,  974,    0,  974,  352,
-      352,  352,  352,  352,  352,  352,  352,  352,  352,  353,
-      949,  949,  949,    0,    0,  353, 1082, 1098,  949, 1083,
-        0,  949, 1070, 1070, 1070,  353,  353,  353,  353,  353,
-      353,  353,  353,  353,  353,  357, 1092, 1092, 1092, 1077,
-     1099,  357,  362,  363,    0,  364,  362,  362,  363,  357,
-      364,  357,  357,  357,  357,  357,  357,  357,  357,  357,
-      357,  362,  363, 1098,  364,  365,  365, 1077, 1099, 1103,
-      365,  362,  363,  368,  364,  362,  362,  363, 1104,  364,
-
-        0,  366,    0,    0,  365,  366,  366,    0,    0,  362,
-      363, 1098,  364, 1111,  365,  365, 1107, 1103,  366,  365,
-      366,  367,    0,  433,  368,  367,  367, 1104,  433,  368,
-      366, 1100,  365,    0,  366,  366,  950,  950,  950, 1113,
-      367, 1111,  433,  368,  950, 1107,  366,  950,  366,    0,
-      367, 1116,  433,  368,  367,  367,  383,  433,  368,    0,
-        0,  999,  999,  999,    0,    0, 1100, 1113,  367,  999,
-      433,  368,  999,  383,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  384,    0, 1000, 1000, 1000, 1101, 1101,
-     1101,    0,  383, 1000, 1121, 1100, 1000, 1116, 1127,    0,
-
-      384,  384,  384,  384,  384,  384,  384,  384,  384,  384,
-      387,    0, 1001, 1001, 1001, 1117, 1117, 1117, 1136,  384,
-     1001,  383, 1121, 1001,    0, 1116, 1127,  387,  387,  387,
-      387,  387,  387,  387,  387,  387,  387,  404,  404,  404,
-      404,  404,  404,  404,  404,  404,  404, 1136,  384,  405,
-      405,  405,  405,  405,  405,  405,  405,  405,  405,  406,
-      406,  406,  406,  406,  406,  406,  406,  406,  406,  407,
-      407,  407,  407,  407,  407,  407,  407,  407,  407,  408,
-      408,  408,  408,  408,  408,  408,  408,  408,  408,  409,
-      409,  409,  409,  409,  409,  409,  409,  409,  409,  423,
-
-      423,  423,  423,  423,  423,  423,  423,  423,  423,  424,
-      424,  424,  424,  424,  424,  424,  424,  424,  424,  425,
-      425,  425,  425,  425,  425,  425,  425,  425,  425,  426,
-      426,  426,  426,  426,  426,  426,  426,  426,  426,  427,
-      427,  427,  427,  427,  427,  427,  427,  427,  427,  428,
-      428,  428,  428,  428,  428,  428,  428,  428,  428,  429,
-     1102,  429,    0,    0,  429,  429,  429,  429,  429,  429,
-      429,  429,  429,  429,  430,  430,  430,  430,  430,  430,
-      430,  430,  430,  430,    0,  436,    0,  434,    0,  431,
-      436,  431,  434,  430,  431,  431,  431,  431,  431,  431,
-
-      431,  431,  431,  431,  436,  434,  434,  435,  437,  435,
-     1144, 1102,  435,  437,  436,    0,  434, 1132, 1147,  436,
-        0,  434,  430,    0,  438,    0,  435,  437,  438,  438,
-      439,    0,  436,  434,  434,  439,  435,  437,  435, 1102,
-        0,  435,  437,  438,    0, 1132,  440, 1140,  439,  439,
-     1147,  440,    0,  438,  435,  437, 1144,  438,  438,  439,
-        0,    0,  441,    0,  439,  440, 1114,  441,  442,  443,
-        0,  438,  442,  442,  443,  440,  439,  439, 1139, 1147,
-      440,  441,    0,  443, 1144,  446, 1146,  442,  443,  444,
-      446,  441, 1140,  440,  444, 1143,  441,  442,  443, 1156,
-
-      444,  442,  442,  443,  446,  445,    0, 1149,  444,  441,
-      445,  443,    0,  445,  446,  442,  443, 1114,  444,  446,
-     1140,  447,  448,  444,  445,  447,  447,  448,  444, 1139,
-      449, 1156,  446,  448,  445,  449,  444, 1146,    0,  445,
-      447,  448,  445,  449, 1143, 1114, 1124, 1124, 1124,  449,
-      447,  448,  445,    0,  447,  447,  448, 1139, 1149,  449,
-     1156,  448,  451,    0,  449, 1146, 1145,  451,  447,  448,
-      452,  449, 1143,  451,  453,  452, 1152,  449,  452,  453,
-        0,  451,    0,    0, 1150,  454, 1149,  454,    0,  452,
-        0,  451,  453,  453,    0,    0,  451,    0,    0,  452,
-
-        0,  451, 1145,  453,  452,    0,    0,  452,  453,  451,
-      458, 1151, 1151, 1151,  457,  458,    0,  452,  454,  457,
-      453,  453,    0,  454,    0, 1152,  454,    0,  457,  458,
-      458, 1145,    0,  457,    0, 1150,    0,  454,    0,  458,
-      454,  459,    0,  457,  458,  460,  459,  454,  457,    0,
-      460,    0,  454, 1152, 1155,  454,  457,  458,  458,  460,
-      459,  457,  468, 1150,  460,  454,    0,  468,  454,  455,
-      459,  455,    0,    0,  460,  459, 1153, 1153, 1153,  460,
-        0,  468,    0,    0,  461,    0,    0,  460,  459,  461,
-     1155,  468,  460, 1158, 1158, 1158,  468, 1159, 1159, 1159,
-
-      455,  461,    0,  461,    0,  455,  463,  455,    0,  468,
-      455,  463, 1157,  461,  455,    0,    0,  455,  461, 1155,
-      455,  455,    0,    0,  455,  463,    0,    0,    0,  461,
-      463,  461,    0,    0,  455,  463,  455,    0,  472,  455,
-      463,    0,  455,  472,    0,  455,  462,    0,  455,  455,
-      462,  462,  455,  463,  464,  465,    0,  472,  463,  464,
-      465,  464,    0, 1157,    0,  462,  462,  472,    0,    0,
-        0,    0,  472,  464,  465,  462,  465,    0,    0,  462,
-      462,    0,    0,  464,  465,  472,    0,    0,  464,  465,
-      464, 1157,    0,  462,  462,    0,    0,    0,    0,    0,
-
-        0,  464,  465,    0,  465,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,    0,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  470,    0,  471,  473,  471,  470,
-
-        0,    0,  473,  474, 1002, 1002, 1002,    0,  474,    0,
-        0,  470, 1002,  470,    0, 1002,  473,    0,    0,    0,
-        0,    0,  474,  470,    0,    0,  473,  471,  470,  471,
-      476,  473,  474,    0,  471,  476,    0,  474,  477,  470,
-        0,  470,    0,  477,  473,    0,  477,    0,  471,  476,
-      474,    0,    0,    0,    0,    0,    0,  477,  471,  476,
-      478,    0,    0,  471,  476,  478,    0,  477,  479,    0,
-        0,    0,  477,  479,    0,  477,  471,  476,    0,  478,
-      478,    0,    0,    0,    0,  477,    0,  479,    0,  478,
-      480,    0,    0,    0,  478,  480,    0,  479,  480,  481,
-
-        0,    0,  479,    0,  481,  481,    0,  478,  478,  480,
-        0,    0,  481,    0,    0,  479,    0,    0,  481,  480,
-        0, 1003, 1003, 1003,  480,    0,    0,  480,  481, 1003,
-      482,  487, 1003,  481,  481,  482,  487,  480,  482,  483,
-      481,  483,  486,    0,  483,    0,  481,  486,    0,  482,
-      487,    0,    0,    0,    0,    0,  486,    0,  483,  482,
-      487,  486,    0,    0,  482,  487,    0,  482,  483,  490,
-      483,  486,    0,  483,  490,  491,  486,  482,  487,    0,
-      491,    0,    0,  490,  486,    0,  483,    0,  490,  486,
-        0,  492,    0,    0,  491,  493,  492,    0,  490,    0,
-
-      493,    0,  492,  490,  491,    0,  493,  494,    0,  491,
-      492,  490,  494,    0,  493,    0,  490,    0,  495,    0,
-      492,    0,  491,  495,  493,  492,  494,  496,    0,  493,
-      492,    0,  496,    0,  493,  496,  494,  495,  492,  497,
-        0,  494,  493,  498,  497,    0,  496,  495,  498,    0,
-      502,    0,  495,    0,  494,  502,  496,    0,  497,    0,
-        0,  496,  498,    0,  496,  495,  499,    0,  497,  502,
-      500,  499,  498,  497,  496,  500,    0,  498,    0,  502,
-      499,    0,  500,    0,  502,  499,  497,  501,    0,  500,
-      498,  501,  501,  503,    0,  499,  504,  502,  503,  500,
-
-      499,  504,    0,    0,  500,    0,  501,    0,  499,    0,
-      500,    0,  503,  499,    0,  504,  501,  500,  505,  507,
-      501,  501,  503,  505,  507,  504,    0,  503,    0,  508,
-      504, 1042, 1042, 1042,  501,  505,    0,  505,  507, 1042,
-      503,  506, 1042,  504,    0,    0,  506,  505,  507,  506,
-      508,    0,  505,  507,    0,  508,    0,  509,    0,    0,
-      506,    0,  509,  505,    0,  505,  507,    0,    0,  508,
-      506,    0,    0,    0,  509,  506,  509,    0,  506,  508,
-        0,    0,  510,    0,  508,    0,  509,  510,  506,  511,
-      512,  509,    0,  510,  511,  512,    0,  508,    0,    0,
-
-        0,  510,  509,  512,  509,    0,  511,    0,  511,  512,
-        0,  510,    0,    0,    0,    0,  510,    0,  511,  512,
-      513,  510,  515,  511,  512,  513,    0,  515,  514,  510,
-      514,  512,    0,  514,  511,    0,  511,  512,  517,  513,
-        0,  515,    0,    0,    0,  516,    0,  514,    0,  513,
-      516,  515,    0,  518,  513,    0,  515,  514,  518,  514,
-        0,  517,  514,    0,  516,  519,  517,  513,    0,  515,
-      519,    0,  518,    0,  516,  514,    0,    0,    0,  516,
-      517,    0,  518,    0,  519,    0,  523,  518,  520,    0,
-      517,  523,  516,  520,  519,  517,    0,    0,    0,  519,
-
-      518,    0,  520,    0,    0,  523,    0,  520,  517,  524,
-        0,    0,  519,  524,  524,  523,    0,  520,  525,    0,
-      523,  526,  520,  525,    0,    0,  526,    0,  524,    0,
-      520,    0,    0,  523,    0,  520,    0,  525,  524,    0,
-      526,  527,  524,  524,  528,  527,  527,  525,  528,  528,
-      526,    0,  525,    0,    0,  526,  524,    0,    0,    0,
-      527,  551,    0,  528,    0,  525,  551,    0,  526,    0,
-      527,    0,    0,  528,  527,  527,    0,  528,  528,  539,
-      551,  539,    0,    0,    0, 1071, 1071, 1071,  527,    0,
-      551,  528,    0, 1071,    0,  551, 1071,  539,  539,  539,
-
-      539,  539,  539,  539,  539,  539,  539,  540,  551, 1093,
-     1093, 1093,    0,  540,    0,    0,    0, 1093,    0,    0,
-     1093,    0,    0,  540,  540,  540,  540,  540,  540,  540,
-      540,  540,  540,  541,  548,    0,  548,    0,    0,  541,
-        0,    0,    0,    0,  548,    0,    0,    0,    0,  541,
-      541,  541,  541,  541,  541,  541,  541,  541,  541,  545,
-      550,    0,  550,    0,    0,  545,  549,  548,    0,    0,
-      548,  549,  548,  545,  549,  545,  545,  545,  545,  545,
-      545,  545,  545,  545,  545,  549,  548,    0,    0,    0,
-        0,    0,    0,  550,    0,  549,  548,    0,  550,  548,
-
-      549,  548,  552,  549,    0,  592,    0,  552,  552,  592,
-      592,    0,  550,  549,  548,  552,    0,    0,  553,  552,
-      553,  552,  550,    0,  592,    0,    0,  550,  553,    0,
-        0,  552,  553,    0,  592,    0,  552,  552,  592,  592,
-      550,  565,    0,  552,    0,    0,    0,  552,    0,  552,
-        0,  553,  592,  565,    0,  565,  553,    0,  565,  565,
-      565,  565,  565,  565,  565,  565,  565,  565,    0,  566,
-      553, 1110, 1110, 1110,    0,    0,    0,    0,    0, 1110,
-      553,    0, 1110,    0,    0,  553,  566,  566,  566,  566,
-      566,  566,  566,  566,  566,  566,  567,    0,  553,    0,
-
-        0, 1125, 1125, 1125,    0,  566,    0,    0,  567, 1125,
-      567,    0, 1125,  567,  567,  567,  567,  567,  567,  567,
-      567,  567,  567,  588,  588,  588,  588,  588,  588,  588,
-      588,  588,  588,    0,  566,  589,  589,  589,  589,  589,
-      589,  589,  589,  589,  589,  590,  590,  590,  590,  590,
-      590,  590,  590,  590,  590,  591,  591,  591,  591,  591,
-      591,  591,  591,  591,  591,  593,    0,    0,  595,    0,
-      593,    0,    0,  595, 1134, 1134, 1134,    0, 1135, 1135,
-     1135,    0, 1134,  595,  593, 1134, 1135,  595,    0, 1135,
-        0,    0,    0,    0,  593,    0,    0,  595,    0,  593,
-
-        0,    0,  595,    0,    0,    0,    0,    0,    0,    0,
-        0,  595,  593,  594,  594,  595,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-
-      594,  594,  596,  597,  596,  598,  600,  596,  597,  599,
-      598,  600,    0,  599,  599,    0,    0,    0,  598,  600,
-        0,  596,  597,    0,  598,  600,    0,    0,  599,    0,
-        0,  596,  597,  596,  598,  600,  596,  597,  599,  598,
-      600,    0,  599,  599,    0,    0,  598,  600,    0,  596,
-      597,    0,  598,  600,  601,  602,  599,  603,    0,  601,
-      602,  605,  603,    0,    0,  605,  605,    0,    0,  602,
-        0,    0,    0,  601,  602,  603,  603,    0,    0,    0,
-      605,    0,    0,  601,  602,    0,  603,  606,  601,  602,
-      605,  603,  606,    0,  605,  605,    0,  602,  606,    0,
-
-        0,  601,  602,  603,  603,    0,  606,    0,  605,  609,
-      607,    0,    0,  610,  609,  607,  606,  607,  610,    0,
-      610,  606,    0,    0,    0,    0,  606,    0,  609,  607,
-        0,    0,  610,    0,  606,  619,  621,    0,  609,  607,
-      619,  621,  610,  609,  607,    0,  607,  610,    0,  610,
-        0,    0,    0,    0,  619,  621,  609,  607,  620,    0,
-      610,    0,    0,  620,  619,  621,    0,    0,    0,  619,
-      621,  620,    0,    0,  623,  622,    0,  620,  622,  623,
-      622,    0,  619,  621,    0,    0,    0,  620,  623,    0,
-        0,  624,  620,  623,  622,    0,  624,    0,    0,  620,
-
-        0,    0,  624,  623,  622,  620,    0,  622,  623,  622,
-      624,    0,  625,  625,  626,    0,  623,  625,  628,  626,
-      624,  623,  622,  628,    0,  624,    0,    0,    0,  626,
-      624,  625,    0,  626,    0,  627,    0,  628,  624,  627,
-      627,  625,  625,  626,    0,    0,  625,  628,  626,    0,
-        0,    0,  628,  629,  627,  629,    0,  626,    0,  625,
-        0,  626,    0,  632,  627,  628,    0,    0,  627,  627,
-      631,  631,  631,  631,  631,  631,  631,  631,  631,  631,
-      632,    0,  627,  633,  629,  632,  629,  634,  633,  637,
-        0,  629,  634,    0,  637,    0,    0,    0,    0,  632,
-
-      634,    0,  633,    0,    0,  629,  634,    0,  637,  632,
-        0,    0,  633,    0,  632,  629,  634,  633,  637,  638,
-      629,  634,    0,  637,  638,    0,    0,  632,  634,    0,
-      633,    0,    0,  629,  634,  639,  637,    0,  638,  641,
-      639,  641,  642,  639,  641,  642,  643,  642,  638,    0,
-        0,  643,    0,  638,  639,    0,    0,    0,  641,    0,
-        0,  642,  644,    0,  639,  643,  638,  644,  641,  639,
-      641,  642,  639,  641,  642,  643,  642,    0,    0,  644,
-      643,  644,  639,  645,    0,  646,  641,  645,  645,  642,
-      646,  644,  647,  643,  648,    0,  644,  647,    0,  648,
-
-        0,    0,  645,    0,  646,  647,    0,  644,    0,  644,
-        0,  647,  645,  648,  646,    0,  645,  645,    0,  646,
-        0,  647,    0,  648,    0,    0,  647,    0,  648,  649,
-      645,  649,  646,  647,  649,  650,    0,    0,    0,  647,
-      650,  648,    0,    0,    0,    0,  650,    0,  649,    0,
-        0,    0,    0,    0,  650,    0,    0,    0,  649,    0,
-      649,  652,    0,  649,  650,  651,  652,  651,    0,  650,
-      651,    0,  652,  653,  650,    0,  649,  653,  653,    0,
-      652,    0,  650,    0,  651,    0,    0,    0,    0,    0,
-      652,    0,  653,    0,  651,  652,  651,    0,  655,  651,
-
-      652,    0,  653,  655,    0,  654,  653,  653,  652,  656,
-      654,    0,  651,  654,  656,    0,    0,  655,    0,    0,
-      653,    0,  656,    0,  654,  657,    0,  655,  656,  657,
-      657,    0,  655,    0,  654,    0,  658,    0,  656,  654,
-        0,  658,  654,  656,  657,  655,    0,    0,  660,    0,
-      656,    0,  654,  660,  657,  658,  656,  659,  657,  657,
-        0,  659,  659,    0,    0,  658,    0,  660,  661,  662,
-      658,    0,  657,  661,  662,    0,  659,  660,    0,    0,
-        0,    0,  660,  658,    0,    0,  659,  661,  662,    0,
-      659,  659,    0,    0,  663,  660,  663,  661,  662,  663,
-
-      665,  666,  661,  662,  659,  665,  666,    0,    0,    0,
-        0,    0,    0,  663,    0,  661,  662,    0,  665,  665,
-      666,    0,    0,  663,    0,  663,  667,    0,  663,  665,
-      666,  667,    0,    0,  665,  666,    0,  668,    0,  667,
-      668,  663,  668,    0,    0,  667,  665,  665,  666,  669,
-        0,    0,    0,  672,  669,  667,  668,  671,  672,    0,
-      667,    0,  671,    0,    0,    0,  668,  667,  669,  668,
-        0,  668,  672,  667,  673,    0,  671,  671,  669,  673,
-      674,    0,  672,  669,  668,  674,  671,  672,    0,    0,
-        0,  671,    0,  673,    0,    0,  669,    0,    0,  674,
-
-      672,    0,    0,  673,  671,  671,    0,    0,  673,  674,
-        0,    0,  690,    0,  674,    0,    0,    0,  690,  695,
-        0,  673,    0,  695,  695,    0,  690,  674,  690,  690,
-      690,  690,  690,  690,  690,  690,  690,  690,  695,  696,
-      698,  699,    0,    0,  696,  698,  699,  696,  695,    0,
-        0,  698,  695,  695,    0,    0,    0,    0,  696,  698,
-      699,    0,    0,    0,    0,    0,  695,    0,  696,  698,
-      699,    0,  709,  696,  698,  699,  696,    0,    0,  698,
-        0,    0,  710,    0,    0,    0,  696,  698,  699,  709,
-      709,  709,  709,  709,  709,  709,  709,  709,  709,  710,
-
-      710,  710,  710,  710,  710,  710,  710,  710,  710,  711,
-        0,    0,    0,    0,    0,    0,    0,    0,    0,  712,
-        0,    0,    0,    0,    0,    0,  711,  711,  711,  711,
-      711,  711,  711,  711,  711,  711,  712,  712,  712,  712,
-      712,  712,  712,  712,  712,  712,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  719,  719,  719,    0,    0,
-      719,  719,    0,  719,    0,    0,    0,  719,  719,    0,
-        0,  719,    0,    0,  719,  719,  719,  719,  719,  719,
-      719,  719,  719,  732,  732,    0,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  733,    0,    0,  735,    0,  733,  734,  734,
-      734,  734,  734,  734,  734,  734,  734,  734,  736,  737,
-        0,  733,  735,  736,  737,  738,    0,  735,    0,    0,
-      738,  733,    0,    0,    0,    0,  733,  736,  737,    0,
-        0,  735,    0,    0,  738,  739,    0,  736,  737,  733,
-
-      739,  735,  736,  737,  738,    0,  735,  740,    0,  738,
-        0,    0,  740,    0,  739,  736,  737,    0,  741,  735,
-        0,    0,  738,  741,  739,    0,  740,    0,    0,  739,
-      740,    0,    0,    0,    0,    0,  740,  741,  741,    0,
-        0,  740,  739,  742,    0,  742,    0,  741,  742,    0,
-      747,  743,  741,    0,  740,  747,  743,    0,  740,  743,
-        0,  745,  742,  745,    0,  741,  741,    0,    0,  747,
-      743,    0,  742,  750,  742,    0,    0,  742,  750,  747,
-      743,    0,  746,    0,  747,  743,  746,  746,  743,    0,
-      742,    0,  750,    0,  745,    0,  745,  747,  743,  745,
-
-        0,  746,  750,    0,    0,    0,    0,  750,    0,  745,
-        0,  746,    0,  745,  751,  746,  746,    0,  751,  751,
-      750,    0,    0,  745,    0,  745,  762,    0,  745,  746,
-        0,  762,    0,  751,  761,    0,  761,  745,    0,  761,
-        0,  745,    0,  751,    0,  762,  762,  751,  751,    0,
-        0,  763,    0,  761,    0,  762,  763,  763,    0,    0,
-      762,  751,    0,  761,    0,  761,    0,    0,  761,    0,
-      763,  764,  765,  762,  762,  764,  764,  765,  766,    0,
-      763,  761,  766,  766,    0,  763,  763,    0,    0,  765,
-      764,  765,    0,    0,  771,    0,    0,  766,  763,  771,
-
-      764,  765,    0,  767,  764,  764,  765,  766,  767,    0,
-      768,  766,  766,  771,  772,  768,  772,  765,  764,  765,
-      767,  768,  767,  771,  772,  766,  773,    0,  771,  768,
-        0,  773,  767,    0,    0,    0,    0,  767,    0,  768,
-      773,  771,    0,    0,  768,  773,  774,  772,  767,  768,
-      767,  774,  772,    0,  774,  773,    0,  768,  775,    0,
-      773,    0,  775,  775,    0,  774,  772,  776,  773,  778,
-        0,  776,  776,  773,  778,  774,  772,  775,    0,    0,
-      774,  772,    0,  774,    0,    0,  776,  775,  778,    0,
-      777,  775,  775,  774,  772,  777,  776,    0,  778,  779,
-
-      776,  776,    0,  778,  779,  775,    0,  777,    0,  777,
-      780,    0,    0,    0,  776,  780,  778,  779,  779,  777,
-        0,  780,  781,    0,  777,    0,    0,  781,  779,  780,
-        0,  782,    0,  779,    0,  777,  782,  777,    0,  780,
-        0,  781,  783,  784,  780,  779,  779,  783,  784,  780,
-      782,  781,    0,  785,    0,  785,  781,  780,    0,    0,
-      782,  783,  784,  786,    0,  782,    0,    0,  786,  781,
-        0,  783,  784,    0,  787,    0,  783,  784,  782,  787,
-        0,  786,  786,  788,    0,    0,  785,    0,  788,  783,
-      784,  785,  786,  787,  789,    0,    0,  786,  787,  789,
-
-        0,  785,  788,  787,    0,  785,    0,    0,  787,  786,
-      786,    0,  788,  789,    0,  785,    0,  788,    0,  790,
-      785,  787,    0,  789,  790,    0,  787,  791,  789,  785,
-      788,  791,  791,  785,    0,    0,  790,    0,  790,  792,
-        0,  789,    0,    0,  792,    0,  791,    0,  790,    0,
-        0,  792,    0,  790,    0,    0,  791,    0,  792,    0,
-      791,  791,  793,    0,  790,    0,  790,  793,  792,    0,
-      795,  796,    0,  792,  791,  795,  796,    0,  795,  792,
-        0,  793,  797,    0,    0,    0,  792,  797,    0,  795,
-      796,  793,    0,  798,    0,  799,  793,  799,  798,  795,
-
-      796,  797,    0,    0,  795,  796,    0,  795,    0,  793,
-        0,  797,  798,    0,    0,    0,  797,  795,  796,  800,
-      801,    0,  798,    0,  800,  801,  816,  798,  799,  797,
-      799,  816,    0,  799,    0,    0,    0,    0,  800,  801,
-      798,    0,    0,    0,    0,  816,    0,  799,  800,  801,
-        0,  817,    0,  800,  801,  816,  817,  799,    0,  799,
-      816,    0,  799,    0,  817,    0,  800,  801,    0,  818,
-      817,  818,    0,  816,  842,  799,  802,  802,  802,  802,
-      817,    0,    0,    0,    0,  817,    0,    0,    0,    0,
-      819,  842,  817,    0,    0,  819,  842,    0,  817,    0,
-
-        0,    0,  818,    0,    0,    0,    0,  818,    0,  819,
-      842,  802,  802,    0,    0,  802,    0,  802,    0,  819,
-      842,  818,    0,    0,  819,  842,    0,    0,  802,  802,
-        0,  818,    0,    0,    0,    0,  818,  819,  842,    0,
-      802,  802,    0,    0,  802,    0,  802,    0,    0,  818,
-        0,    0,    0,    0,    0,    0,  802,  802,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  828,  841,  841,
-      841,  841,  841,  841,  841,  841,  841,  841,    0,    0,
-        0,    0,    0,    0,  828,  828,  828,  828,  828,  828,
-      828,  828,  828,  828,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  843,    0,  844,    0,  847,  843,  844,
-      844,  845,  847,  845,  846,    0,  845,    0,  846,  846,
-        0,    0,  843,    0,  844,    0,  847,    0,    0,    0,
-      845,    0,  843,  846,  844,    0,  847,  843,  844,  844,
-
-      845,  847,  845,  846,  849,  845,    0,  846,  846,  849,
-      843,  848,  844,    0,  847,  848,  848,    0,  845,    0,
-      850,  846,    0,  849,    0,  850,    0,  853,    0,    0,
-      848,  854,  853,  849,  850,    0,  854,    0,  849,  850,
-      848,  853,    0,    0,  848,  848,  853,    0,  854,  850,
-      854,  849,  855,    0,  850,    0,  853,  855,  848,    0,
-      854,  853,  850,  858,    0,  854,    0,  850,  858,  853,
-        0,  855,  866,    0,  853,    0,  854,  866,  854,    0,
-      858,  855,  858,  867,    0,    0,  855,    0,  867,    0,
-        0,  866,  858,    0,  867,    0,    0,  858,    0,  855,
-
-        0,  866,  867,    0,  868,    0,  866,    0,  858,  868,
-      858,    0,  867,  869,    0,  869,    0,  867,  869,  866,
-        0,  868,  867,  868,    0,    0,    0,    0,    0,  870,
-      867,    0,  869,  868,  870,  871,    0,    0,  868,    0,
-      871,    0,  869,  870,  869,    0,    0,  869,  870,  868,
-        0,  868,    0,    0,  871,    0,    0,    0,  870,    0,
-      869,  872,    0,  870,  871,  872,  872,    0,  873,  871,
-      874,  870,  873,  873,    0,  874,  870,    0,    0,    0,
-      872,  874,  871,    0,    0,    0,    0,  873,    0,  874,
-      872,  878,    0,  877,  872,  872,  878,  873,  877,  874,
-
-        0,  873,  873,    0,  874,    0,  877,    0,  872,  874,
-      878,    0,  877,  879,  880,  873,  881,  874,  879,  880,
-      878,  881,  877,    0,    0,  878,    0,  877,    0,    0,
-        0,    0,  879,  880,  877,  881,  882,    0,  878,    0,
-      877,  882,  879,  880,  882,  881,    0,  879,  880,    0,
-      881,    0,  883,  886,    0,  882,    0,  883,  886,  885,
-      879,  880,    0,  881,  885,  882,    0,    0,    0,    0,
-      882,  883,  886,  882,    0,    0,  885,    0,  885,  887,
-        0,  883,  886,  882,  887,    0,  883,  886,  885,    0,
-      888,  890,    0,  885,    0,  888,  890,    0,  887,  883,
-
-      886,  888,  891,    0,  885,    0,  885,  891,  887,  888,
-      890,  889,    0,  887,    0,  889,  889,    0,    0,  888,
-      890,  891,  892,  897,  888,  890,  887,  892,  897,  888,
-      889,  891,    0,    0,  895,    0,  891,  888,  890,  895,
-      889,  892,  897,  906,  889,  889,    0,    0,  906,  891,
-        0,  892,  897,  895,    0,  895,  892,  897,  889,  898,
-        0,    0,  906,  895,  898,    0,  907,  898,  895,  892,
-      897,  907,  906,    0,    0,    0,    0,  906,  898,    0,
-        0,  895,    0,  895,  907,  907,    0,    0,  898,  909,
-      906,  909,    0,  898,  909,  907,  898,    0,    0,    0,
-
-      907,    0,    0,    0,    0,    0,  898,  914,  909,    0,
-        0,    0,  907,  907,    0,    0,  917,  917,  909,    0,
-      909,  917,    0,  909,  914,  914,  914,  914,  914,  914,
-      914,  914,  914,  914,    0,  917,  909,  918,    0,  919,
-        0,    0,  918,  919,  919,  917,  917,    0,  920,    0,
-      917,    0,    0,  920,    0,    0,  918,    0,  919,    0,
-        0,    0,    0,  917,    0,  920,  918,  920,  919,  921,
-      922,  918,  919,  919,  921,  922,    0,  920,  923,    0,
-        0,    0,  920,  923,  918,    0,  919,    0,  921,  922,
-        0,  923,    0,  920,    0,  920,    0,  923,  921,  922,
-
-        0,  927,    0,  921,  922,  928,  927,  923,    0,  928,
-      928,    0,  923,  927,    0,    0,  921,  922,    0,  923,
-      927,  938,    0,    0,  928,  923,  938,  930,  940,  938,
-      927,  930,  930,  940,  928,  927,    0,    0,  928,  928,
-      938,  927,    0,    0,    0,    0,  930,  940,  927,    0,
-      938,    0,  928,    0,    0,  938,  930,  940,  938,  939,
-      930,  930,  940,  939,  939,  941,  942,    0,  938,    0,
-      941,  942,    0,    0,  930,  940,    0,    0,  939,    0,
-        0,    0,  943,    0,  941,  942,  942,  943,  939,    0,
-        0,  944,  939,  939,  941,  942,  944,    0,    0,  941,
-
-      942,  943,  945,    0,  944,    0,  939,  945,    0,    0,
-      944,  943,  941,  942,  942,    0,  943,    0,  951,    0,
-      944,  945,  952,  951,    0,  944,    0,  952,    0,  943,
-        0,  945,  944,    0,    0,    0,  945,  951,  944,  955,
-        0,  952,    0,  953,  955,  953,    0,  951,  953,  945,
-        0,  952,  951,  955,    0,    0,  952,    0,  955,  956,
-        0,    0,  953,    0,  956,  951,  957,    0,  955,  952,
-      958,  957,  953,  955,  953,  958,    0,  953,  956,    0,
-        0,  955,    0,    0,    0,  957,  955,  958,  956,  958,
-      953,    0,  960,  956,    0,  957,  960,  960,    0,  958,
-
-      957,    0,    0,  963,  958,    0,  956,    0,  963,  962,
-        0,  960,    0,  957,  962,  958,  963,  958,    0,    0,
-        0,  960,  963,    0,    0,  960,  960,  962,  962,  969,
-        0,    0,  963,    0,  969,  970,    0,  963,  962,  960,
-      970,  971,    0,  962,  963,  971,  971,    0,  969,  969,
-      963,    0,  976,    0,  970,  962,  962,  976,  969,    0,
-      971,  975,    0,  969,  970,    0,  975,    0,  977,  970,
-      971,  976,  975,  977,  971,  971,  969,  969,    0,    0,
-      975,  976,  970,    0,  979,    0,  976,  977,  971,  979,
-      975,    0,    0,  985,    0,  975,    0,  977,  985,  976,
-
-      975,  978,  977,  979,  982,  978,  978,    0,  975,  982,
-        0,    0,  985,  979,    0,  977,    0,    0,  979,  982,
-      978,    0,  985,  982,  983,    0,  983,  985,    0,  983,
-      978,  979,    0,  982,  978,  978,    0,    0,  982,    0,
-      985,  993,    0,  983,  994,  992,  993,  982,  978,  994,
-      992,  982,    0,  983,    0,  983,  994,    0,  983,  992,
-      993,  995,    0,  994,  992,    0,  995,  996,    0,    0,
-      993,  983,  996,  994,  992,  993,    0,    0,  994,  992,
-      995,    0,    0,    0,  994,    0,  996,  992,  993,    0,
-      995,  994,  992, 1004,    0,  995,  996,  997, 1004,  997,
-
-     1007,  996,  997,    0, 1006, 1007, 1006,    0,  995, 1006,
-        0,    0, 1004,    0,  996,    0,  997,    0,    0, 1007,
-     1009,    0, 1004, 1006,    0, 1009,  997, 1004,  997, 1007,
-        0,  997,    0, 1006, 1007, 1006,    0, 1011, 1006, 1009,
-     1004, 1011, 1011,    0,  997,    0,    0, 1007,    0, 1009,
-        0, 1006,    0, 1012, 1009,    0, 1011, 1012, 1012,    0,
-     1020,    0,    0,    0, 1019, 1020, 1011, 1009,    0, 1019,
-     1011, 1011, 1012,    0,    0, 1019, 1025,    0,    0, 1020,
-     1025, 1025, 1012, 1019, 1011, 1026, 1012, 1012,    0, 1020,
-     1026,    0,    0, 1019, 1020, 1025,    0, 1029, 1019,    0,
-
-     1012,    0, 1029, 1019, 1026, 1025,    0, 1020, 1029, 1025,
-     1025, 1019,    0,    0, 1026,    0, 1029,    0,    0, 1026,
-     1030,    0, 1037, 1025, 1038, 1030, 1029, 1037, 1030, 1038,
-        0, 1029, 1026,    0,    0, 1037, 1029,    0,    0, 1030,
-        0, 1037,    0, 1038, 1029,    0,    0, 1039,    0, 1030,
-        0, 1037, 1039, 1038, 1030, 1039, 1037, 1030, 1038, 1047,
-        0,    0,    0, 1037, 1047,    0, 1039, 1030, 1040, 1037,
-     1044, 1038, 1040, 1040, 1044, 1044, 1039,    0, 1047,    0,
-        0, 1039,    0,    0, 1039,    0,    0, 1040, 1047, 1044,
-     1048, 1054,    0, 1047, 1039, 1048, 1054, 1040,    0, 1044,
-
-        0, 1040, 1040, 1044, 1044,    0, 1047, 1059,    0, 1048,
-     1054,    0, 1059,    0,    0, 1040, 1063, 1044,    0, 1048,
-     1054, 1063,    0, 1062, 1048, 1054, 1059, 1062, 1062,    0,
-        0,    0,    0,    0, 1063, 1063, 1059, 1048, 1054, 1067,
-        0, 1059, 1062,    0, 1067, 1063, 1068,    0, 1069,    0,
-     1063, 1068, 1062, 1069, 1059,    0, 1062, 1062, 1067, 1068,
-        0,    0, 1063, 1063,    0, 1068,    0, 1069, 1067, 1073,
-     1062, 1080, 1073, 1067, 1073, 1068, 1080, 1069,    0,    0,
-     1068,    0, 1069,    0,    0,    0, 1067, 1068, 1073,    0,
-     1080, 1087,    0, 1068, 1088, 1069, 1087,    0, 1073, 1088,
-
-     1080, 1073, 1088, 1073,    0, 1080,    0,    0,    0,    0,
-     1087,    0,    0, 1088, 1087,    0, 1073, 1091, 1080,    0,
-     1087, 1091, 1091, 1088, 1095, 1087,    0,    0, 1088, 1095,
-        0, 1088,    0,    0,    0,    0, 1091,    0, 1087,    0,
-     1105, 1088, 1087, 1095, 1095, 1105, 1091, 1106,    0, 1108,
-     1091, 1091, 1106, 1095, 1108,    0,    0,    0, 1095, 1105,
-        0, 1106,    0,    0, 1091,    0, 1106,    0, 1108, 1105,
-        0, 1095, 1095,    0, 1105,    0, 1106,    0, 1108,    0,
-        0, 1106,    0, 1108,    0,    0,    0, 1105,    0, 1106,
-        0,    0,    0,    0, 1106,    0, 1108, 1109, 1109, 1109,
-
-        0,    0, 1109, 1109,    0, 1109,    0,    0,    0, 1109,
-     1109,    0,    0, 1109,    0,    0, 1109, 1109, 1109, 1109,
-     1109, 1109, 1109, 1109, 1109, 1112, 1122,    0,    0,    0,
-     1112, 1122,    0,    0,    0,    0,    0,    0,    0, 1122,
-        0,    0, 1112,    0, 1112, 1122,    0,    0,    0,    0,
-        0,    0,    0,    0, 1112, 1122,    0,    0,    0, 1112,
-     1122,    0,    0,    0,    0,    0,    0, 1122,    0,    0,
-     1112,    0, 1112, 1122, 1126, 1126, 1126,    0,    0, 1126,
-     1126,    0, 1126,    0, 1128, 1126, 1126, 1126, 1128, 1128,
-     1126,    0,    0, 1126, 1126, 1126, 1126, 1126, 1126, 1126,
-
-     1126, 1126,    0, 1128, 1133, 1137,    0,    0,    0, 1133,
-     1137,    0,    0, 1128,    0,    0,    0, 1128, 1128,    0,
-        0,    0,    0, 1133, 1137,    0,    0,    0,    0,    0,
-        0, 1128,    0, 1133, 1137,    0,    0,    0, 1133, 1137,
+      217,  217,  217,  217,  217,  217,  217,  217,  220,  219,
+      227,  228,  230,  248,  245,  229,  254,  255,  217,  217,
+
+      217,  217,  217,  219,  237,  220,  232,  232,  232,  256,
+      257,  237,  237,  259,  232,  232,    0,  220,  219,  228,
+      230,  248,  245,    0,  254,  255,  233,  233,  233,  217,
+      217,  219,    0,  220,  233,  233,  236,  256,  257,    0,
+      238,  259,  238,  236,  236,  238,  238,  238,  238,  238,
+      238,  238,  238,  238,  238,  260,  237,  217,  218,  218,
+      218,  218,  218,  218,  218,  218,  218,  218,  218,  218,
+      218,  218,  218,  218,  218,  218,  218,  261,  262,  236,
+      378,  378,  378,  260,  237,    0,    0,  218,  218,  218,
+      218,  218,  218,  251,  251,  251,  251,  251,  251,  251,
+
+      251,  251,  251,  263,  264,  261,  262,  236,  252,  252,
+      252,  252,  252,  252,  252,  252,  252,  252,  218,  218,
+      253,  218,  253,  547,  547,  547,    0,    0,  266,  267,
+      253,  263,  264,  265,  268,  269,  265,    0,  270,  271,
+      272,  273,  274,    0,    0,  266,  218,  250,  250,  250,
+      250,  250,  250,  250,  250,  250,  250,  266,  267,  277,
+      281,  265,  268,  269,  265,  250,  250,  270,  271,  272,
+      273,  274,  276,  266,  276,  282,  283,  278,  250,  278,
+        0,    0,  279,  279,  284,  285,  286,  285,  277,  281,
+      287,    0,  289,  290,  250,  250,  291,  292,  288,  293,
+
+      288,  295,    0,  276,  282,  283,  250,  275,  278,  275,
+      279,  279,  284,  294,  286,  299,  285,    0,  298,  287,
+      289,  290,    0,  300,  291,  292,  294,  293,  302,    0,
+      295,  296,  301,  296,  301,    0,  303,  297,  275,  297,
+      304,  296,  294,  275,  299,  275,  298,  297,  275,    0,
+      288,  300,  275,  306,  294,  275,  305,  302,  275,  275,
+      308,    0,  275,  301,  303,  309,  310,  312,  304,  313,
+      315,  311,  275,  316,  275,  296,  317,  275,  288,  311,
+      275,  297,  306,  275,  305,  296,  275,  275,  318,  308,
+      275,  297,  314,  309,  310,  319,  312,  313,  315,  311,
+
+      314,  316,  320,  296,  317,  321,  322,  311,  323,  297,
+      324,  325,  326,  296,  328,  329,  327,  318,  327,  297,
+      330,  314,  331,  332,  319,  333,  327,  334,  314,  335,
+      339,  320,  341,  321,  342,  322,  323,  343,  324,  325,
+      326,  344,  345,  328,  329,  346,  347,  352,  330,    0,
+      331,  332,    0,  333,  351,  334,  363,  335,  339,  348,
+      341,  348,  342,  353,    0,  343,  355,  356,  358,  344,
+      345,  357,  359,  346,  376,  347,  369,  348,  348,  348,
+      348,  348,  348,  348,  348,  348,  348,  349,  357,  869,
+      352,  361,  351,  349,  363,  355,  356,  358,  371,    0,
+
+      357,  359,  376,  349,  349,  349,  349,  349,  349,  349,
+      349,  349,  349,  350,  368,  353,  357,  370,  352,  350,
+      361,  351,  377,  363,  379,  383,    0,  371,  369,  350,
+      350,  350,  350,  350,  350,  350,  350,  350,  350, 1005,
+        0,  360,  372,  353,  354,  364,  364,  364,  381,  869,
+      354,  377,  379,  372,  360,  370,  369,  368,  354,  373,
+      354,  354,  354,  354,  354,  354,  354,  354,  354,  354,
+      360,  372,  374,  380,  384,  383,  382,  373,  354,  354,
+        0,  372,  360,  375,  370,  368,  364,  406,  373,  385,
+      398,  354,  374,  405,  375,  381,  385,  385,  653, 1005,
+
+      653,  374,  380,  383,    0,  373,  386,  354,  354,  382,
+      384,    0,  375,  386,  386,  364,  406,  387,  398,  354,
+      374,  405,  375,  381,  387,  387,  388,  388,  388,  388,
+      388,  388,  388,  388,  388,  388,  408,  410,  382,  384,
+      389,  389,  389,  389,  389,  389,  389,  389,  389,  389,
+      402,  411,  402,  387,  413,    0,  386,  414,    0,  415,
+      402,  416,  417,  418,  420,  408,  410,  421,  422,  423,
+      424,  425,  426,  429,  426,  430,  431,    0,  432,  411,
+      433,  435,  387,  413,  386,  436,  414,  415,  434,  416,
+      417,  439,  418,  420,  442,  421,  422,  423,  424,  425,
+
+      437,  429,  437,  430,  434,  431,  432,  444,  433,  435,
+      440,  446,  440,  426,  436,  447,  445,  434,  445,  439,
+      450,  448,  442,  448, 1009,  451,  452,  426,  454,    0,
+      457,  437,  434,  455,  456,  444,  458,  459,  460,  446,
+      464,  440,  426,  458,  447,  463,  468,  445,  467,  450,
+        0,  469,  448,  451,  452,  426,  427,  454,  427,  457,
+      470,  455,  456,    0,  480,  458,  459,  460,  461,  464,
+      461,  458,  465,  463,  465,  468,  467,  478,  461,  469,
+      483,  472,  465,  472, 1009,  479,  481,  427,  470,  482,
+      484,  475,  427,  480,  427,  485,  493,  427,  503,  475,
+
+      488,  427,    0,  489,  427,  478,  490,  427,  427,  483,
+      491,  427,  472,  479,  481,    0,    0,  482,  484,    0,
+      506,  427,  506,  427,  485,  493,  427,  503,  488,  427,
+      475,  489,  427,  499,  490,  427,  427,    0,  491,  427,
+      443,  443,  443,  443,  443,  443,  443,  443,  443,  443,
+      443,  506,  443,  443,  443,  443,  443,  443,  443,  475,
+      507,  499,  508,  509,  494,  500,  494,  500,  513,  443,
+      443,  443,  443,  443,  494,  500,  514,  515,  516,  517,
+      518,  523,  524,  655,  535,  655,  525,    0,  667,  507,
+      667,  508,  509,  520,  529,  520,  527,  513,  563, 1031,
+
+      443,  443,  529,  540,  514,  531,  515,  516,  517,  518,
+      537,  520,  520,  520,  520,  520,  520,  520,  520,  520,
+      520,  521,  525,  529,  527,  545,  563,  521,  443,  565,
+      523,  529,  524,  535,  531,    0,    0,  521,  521,  521,
+      521,  521,  521,  521,  521,  521,  521,  522,    0,  538,
+      539,  525,  540,  522,  545,  537,  568,  565,  523, 1031,
+      524,  535,    0,  522,  522,  522,  522,  522,  522,  522,
+      522,  522,  522,  526,  532,  536,  536,  536,    0,  526,
+      540,  532,  548,  537,  568,  532,  539,  526,  541,  526,
+      526,  526,  526,  526,  526,  526,  526,  526,  526,  538,
+
+      533,    0,  533,  532,  552,  550,  541,  526,  526,  532,
+      533,  548,  561,  532,  533,  539,  536,  541,  542,    0,
+      526,  543,  542,  554,  544,  543,  562,  538,  544,  566,
+      554,  554,  569,  576,  541,  555,  526,  526,  550,  577,
+      552,  561,  555,  555,  570,  536,  571,  542,  526,  573,
+      543,  542,  574,  544,  543,  562,  575,  544,  566,  554,
+        0,  569,  576,  581,  659,  659,  659,  550,  577,  552,
+        0,  578,  570,  578,  571,    0,  641,  573,  641,  579,
+      574,  580,    0,  582,  575,  583,  641,  584,  554,  564,
+      564,  581,  564,  564,  564,  564,  564,  564,  564,  564,
+
+      564,  564,  564,  564,  564,  564,  564,  564,  579,  585,
+      580,  582,  578,  586,  583,  584,  587,  588,  564,  564,
+      564,  564,  564,  590,  592,    0,  578,  593,  594,  586,
+      595,    0,  596,  597,  598,  608,  599,  585,  599,    0,
+      602,  578,  586,  603,  587,  603,  588,  607,  613,  564,
+      564,  590,  610,  592,  578,  593,  594,  586,  611,  595,
+      596,  614,  597,  598,  608,  615,  616,  599,  602,  617,
+      618,    0,  619,  620,  603,  607,  613,  564,  621,  622,
+      623,  610,  626,    0,  627,  628,  630,  611,  632,  633,
+      614,  634,  639,  615,  616,  636,  637,  638,  617,  618,
+
+      619,  640,  620,  644,  645,  646,  621,  646,  622,  623,
+      654,  626,  627,  656,  628,  630,  632,  657,  633,  662,
+      634,  639,  663,  636,  637,  638,  666,  668,  669,  640,
+      669,  644,  645,  658,  670,  658,  646,  671,  672,  654,
+      672,  676,  656,  658,  681,  657,  675,  658,  672,  674,
+      683,  674,  672,  679,  677,  666,  668,  700,  663,  662,
+      694,    0,  670,  674,  695,  680,  671,  694,  694,  680,
+      696,  695,  695,  681,  701,  703,    0,  696,  696,  683,
+      771,  738,  771,  738, 1082,  700,  675,  663,  662,  665,
+      677,  738,  676,  679,  680,  665,    0,  704,  680,  706,
+
+      707,  708,  701,  665,  703,  665,  665,  665,  665,  665,
+      665,  665,  665,  665,  665,  675,  709,    0,  710,  677,
+      676,  711,  679,  665,  665,  704,  714,  706,  707,  708,
+      715,  717,    0,  719,  721,    0,  665,  762,    0,  762,
+      770,  781,  770,  781, 1082,  709,  710,  762,  770,  858,
+      711,  858,  665,  665,  712,  714,  712,  722,  723,  715,
+      717,  719,  724,  721,  665,  682,  682,  682,  682,  682,
+      682,  682,  682,  682,  682,  682,  682,  682,  682,  682,
+      682,  682,  682,  682,  725,  722,  723,  726,  727,  712,
+      729,  724,  728,  730,  682,  682,  682,  682,  682,  731,
+
+      732,    0,  712,  733,  734,  735,  737,  735, 1084,  739,
+      740,  741,  725,  742,    0,  743,  726,  727,  712,  729,
+      728,  745,  730,  746,  752,  682,  682,  731,  756,  732,
+      712,  733,  734,    0,    0,  737,  735,  739,    0,  740,
+      741,  755,  742,  743,  757,  775,  775,  775,  833,  745,
+      833,  746,  752,  682,  686,  686,  686,  756,  833,  686,
+      686,  751,  686,  751,    0,    0,  686,  686, 1084,  755,
+      686,    0,  757,  686,  686,  686,  686,  686,  686,  686,
+      686,  686,  699,  699,  776,  699,  699,  699,  699,  699,
+      699,  699,  699,  699,  699,  699,  699,  699,  699,  699,
+
+      699,  758,  759,  783,  760,  763,    0,  768,  773,  751,
+      772,  699,  699,  699,  699,  699,  767,  774,  767,  779,
+      782,  776,  784,  787,  780,  789,  791,  791,  791,  758,
+      802,  759,  760,  810,  763,  768,  773,  751,  803,  772,
+      783,    0,  699,  699,  804,  806,  774,  807,  779,  782,
+      776,  767,  780,  808,  789,  797,  812,  798,  784,  802,
+      787,  810,  797,  797,  798,  798,  864,  803,  864,  783,
+      699,    0,    0,  804,  806,    0,  807,  811,    0,  811,
+      767,  801,  808,  813,  812,  801,  815,  784,  816,  787,
+      788,  788,  788,  788,  788,  788,  788,  788,  788,  788,
+
+      788,  788,  788,  788,  788,  788,  788,  788,  788,  817,
+      801,  813,  811,  819,  801,  815,  816,  818,  820,  788,
+      788,  788,  788,  788,  821,  811,  822,    0,  823,  824,
+      825,  826,  827,    0,  828,  830,  831,  840,  817,  832,
+     1085,  811,  819,  835,  836,  818,  842,  820,  842,  843,
+      788,  788,  821,  811,  844,  822,  823,  824,  825,  826,
+      846,  827,  828,  847,  830,  831,  840,  832,  834,  834,
+      834,  835,  836,  851,  852,  851,  834,  843,  788,  834,
+      853,  855,  844,  851,  854,  856,  854,  857,  846,  859,
+      867,  865,  847,  863,  842,  870,  871,    0,  873,  874,
+
+     1085,  875,  876,  852,  878,  879,  880,  881,  853,  882,
+      855,  883,    0,  884,  856,  857,  885,  889,  859,  854,
+      865,  863,  842,  886,  870,  871,  873,  887,  874,  875,
+      876,  888,  878,  879,  880,  881,  890,  882,  896,  867,
+      883,  884,  892,  893,  894,  885,  889,  895,  854,  897,
+      899,  886,  901,  901,  901,  887,  903,  903,  903,  888,
+      901,  909,    0,  901,  890,  910,  896,  867,    0,  908,
+      915,  892,  893,  894,  913,  916,  895,  897,  899,  902,
+      902,  902,  917,  904,  904,  904,  918,  902,  919,  909,
+      902,  904,  920,  910,  904,  905,  905,  905,  908,  915,
+
+      921,  922,  913,  905,  916,  924,  905,  925,  926,  927,
+      917,  928,  929,  932,  918,    0,  919,  933,    0,  935,
+      936,  920,  937,  938,  939,  941,  940,  942,  940,  943,
+      922,  944,  945,  947,  924,  921,  940,  949,  951,  928,
+      929,  932,  952,  925,  927,  926,  933,  935,    0,  936,
+      937,    0,  938,  939,  941,  961,  942,  960,  943,  944,
+      945,  947,    0,    0,  921,  949,  951,  953,  953,  953,
+      965,  952,  925,  927,  926,  954,  954,  954,  970,  955,
+      955,  955,  963,  954,  961,  960,  954,  955,  966,  973,
+      955,  956,  956,  956,  967,  957,  957,  957,  965,  956,
+
+      969,  975,  956,  957,  971,  974,  957,  958,  958,  958,
+      976,  963,  977,  980,  977,  958,  981,  966,  958,    0,
+      982,  983,  977,  967,  970,  984,  985,  984,  985,  969,
+      987,  989,  971,  991,  973,  984,  985,  974,  994,  976,
+      992,  980,  995, 1008, 1007,  981,    0,  975,  982,  998,
+      983,    0,  970,  996,  996,  996,  999, 1001,  987,  989,
+     1013,  991,  973, 1016, 1014, 1015,  974,  994,  992, 1017,
+     1019,  995,  997,  997,  997,  975, 1021, 1008,  998, 1007,
+      997, 1032, 1011,  997, 1011,  999, 1001, 1012, 1013, 1012,
+     1025, 1016, 1011, 1014, 1015, 1026, 1029, 1017, 1027, 1019,
+
+     1012, 1030, 1012, 1033, 1021, 1037, 1008, 1036, 1007, 1023,
+     1023, 1023, 1024, 1024, 1024,    0, 1038, 1032, 1012, 1025,
+     1024, 1039, 1042, 1024, 1026, 1034, 1027, 1034, 1045, 1030,
+     1041, 1048, 1035, 1037, 1035, 1052, 1036, 1046, 1034, 1050,
+     1034, 1029, 1056, 1035, 1038, 1035, 1032, 1035, 1033, 1059,
+     1039, 1042, 1043, 1043, 1043, 1049, 1034, 1045, 1041, 1044,
+     1044, 1044, 1053, 1035, 1053, 1046, 1055, 1044, 1058, 1029,
+     1044, 1056, 1063, 1053, 1050, 1068, 1033, 1048, 1059, 1064,
+     1065, 1052,    0, 1049, 1062, 1062, 1062, 1066, 1071, 1067,
+        0, 1073, 1062,    0, 1055, 1062, 1058, 1074,    0, 1079,
+
+     1063, 1099, 1109, 1050, 1093, 1048,    0, 1064, 1065, 1052,
+     1061, 1061, 1061, 1095,    0, 1061, 1061, 1067, 1061, 1073,
+     1086, 1068, 1061, 1061, 1080, 1074, 1061, 1079, 1090, 1061,
+     1061, 1061, 1061, 1061, 1061, 1061, 1061, 1061, 1066, 1071,
+     1076, 1076, 1076, 1077, 1077, 1077,    0, 1094, 1086, 1068,
+     1099, 1077, 1096, 1080, 1077, 1093, 1104, 1090, 1095, 1101,
+     1102, 1105, 1109,    0, 1111,    0, 1066, 1071, 1078, 1078,
+     1078, 1100, 1113, 1078, 1078, 1094, 1078, 1103, 1099, 1078,
+     1078, 1078, 1106, 1093, 1078, 1104, 1095, 1078, 1078, 1078,
+     1078, 1078, 1078, 1078, 1078, 1078, 1088, 1088, 1088, 1100,
+
+     1089, 1089, 1089, 1096, 1088, 1101, 1107, 1088, 1089, 1102,
+     1108, 1089, 1105, 1103, 1110, 1111, 1112, 1114, 1106, 1115,
+     1115, 1115, 1117, 1113, 1116, 1116, 1116, 1118, 1118, 1118,
+     1123, 1096, 1126, 1101, 1119, 1119, 1119, 1102, 1107, 1108,
+     1105, 1127, 1103, 1111, 1112,    0, 1110, 1106, 1121, 1121,
+     1121, 1113, 1124, 1124, 1124, 1128, 1128, 1128, 1129, 1129,
+     1129,    0,    0,    0, 1126,    0, 1123, 1107, 1114,    0,
+        0, 1117,    0,    0,    0, 1110,    0,    0,    0,    0,
         0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-        0, 1133, 1137, 1162, 1162, 1162, 1162, 1162, 1162, 1162,
-     1162, 1162, 1162, 1162, 1162, 1163, 1163, 1163, 1163, 1163,
-     1163, 1163, 1163, 1163, 1163, 1163, 1163, 1164, 1164,    0,
-     1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1165,
-     1165,    0, 1165, 1165, 1165, 1165, 1165, 1165, 1165, 1165,
-
-     1165, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166,
-     1166, 1166, 1166, 1167, 1167, 1167, 1167, 1167, 1167, 1167,
-     1167, 1167, 1167, 1167, 1167, 1168, 1168, 1169, 1169, 1169,
-     1169, 1169, 1169, 1169, 1169, 1170, 1170, 1170, 1170, 1170,
-     1170, 1170, 1170, 1170, 1170, 1170, 1170, 1171, 1171, 1171,
-     1171, 1171, 1171, 1171, 1171, 1171, 1171, 1171, 1171, 1172,
-     1172, 1172, 1172, 1172, 1172,    0, 1172, 1172, 1172,    0,
-     1172, 1173, 1173, 1173, 1173, 1173, 1173, 1173, 1173, 1173,
-     1173, 1173, 1173, 1174,    0,    0, 1174, 1175, 1175, 1175,
-        0,    0, 1175,    0, 1175, 1175,    0, 1175, 1175, 1176,
-
-     1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176,
-     1176, 1177, 1177,    0, 1177, 1177, 1177, 1177, 1177, 1177,
-     1177, 1177, 1177, 1178, 1178, 1178, 1178, 1178, 1178,    0,
-     1178, 1178, 1178,    0, 1178, 1179, 1179, 1179, 1179, 1179,
-     1179, 1179, 1179, 1179, 1179, 1179, 1179, 1180, 1180, 1180,
-     1180, 1180, 1180, 1180, 1180, 1180, 1180, 1180, 1180, 1181,
-        0,    0, 1181, 1182,    0,    0,    0, 1182,    0,    0,
-        0,    0,    0, 1182, 1183, 1183, 1183, 1183, 1183, 1183,
-     1183, 1183, 1183, 1183, 1183, 1183, 1184, 1184,    0, 1184,
-     1184, 1184, 1184, 1184, 1184, 1184, 1184, 1184, 1185, 1185,
-
-        0, 1185, 1185, 1185, 1185, 1185, 1185, 1185, 1185, 1185,
-     1186, 1186,    0, 1186, 1186, 1186, 1186, 1186, 1186, 1186,
-     1186, 1186, 1187, 1187, 1187, 1187, 1187, 1187, 1187, 1187,
-     1187, 1187, 1187, 1187, 1188, 1188, 1188, 1188, 1188, 1188,
-     1188, 1188, 1188, 1188, 1188, 1188, 1189, 1189, 1189, 1189,
-     1189, 1189, 1189, 1189, 1189, 1189, 1189, 1189, 1190, 1190,
-     1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190,
-     1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191,
-     1191, 1191, 1192, 1192,    0, 1192, 1192, 1192, 1192, 1192,
-     1192, 1192, 1192, 1192, 1193, 1193, 1193, 1193, 1193, 1193,
-
-     1193, 1193, 1193, 1193, 1193, 1193, 1194, 1194, 1194, 1194,
-     1194, 1194, 1194, 1194, 1194, 1194, 1194, 1194, 1195, 1195,
-        0, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195,
-     1196, 1196,    0, 1196, 1196, 1196, 1196, 1196, 1196, 1196,
-     1196, 1196, 1197, 1197,    0, 1197, 1197, 1197, 1197, 1197,
-     1197, 1197, 1197, 1197, 1198, 1198,    0, 1198, 1198, 1198,
-     1198, 1198, 1198, 1198, 1198, 1198, 1199, 1199,    0, 1199,
-     1199, 1199, 1199, 1199, 1199, 1199, 1199, 1199, 1200, 1200,
-     1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200,
-     1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201,
-
-     1201, 1201, 1202, 1202, 1202, 1202, 1202, 1202, 1202, 1202,
-     1202, 1202, 1202, 1202, 1203, 1203, 1203, 1203, 1203, 1203,
-     1203, 1203, 1203, 1203, 1203, 1203, 1204, 1204, 1204, 1204,
-     1204, 1204, 1204, 1204, 1204, 1204, 1204, 1204, 1205, 1205,
-     1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205,
-     1206, 1206,    0, 1206, 1206, 1206, 1206, 1206, 1206, 1206,
-     1206, 1206, 1207, 1207,    0, 1207, 1207, 1207, 1207, 1207,
-     1207, 1207, 1207, 1207, 1208, 1208, 1208, 1208, 1208, 1208,
-     1208, 1208, 1208, 1208, 1208, 1208, 1209, 1209, 1209, 1209,
-     1209, 1209, 1209, 1209, 1209, 1209, 1209, 1209, 1210, 1210,
-
-     1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210,
-     1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211,
-     1211, 1211, 1212, 1212, 1212, 1212, 1212, 1212, 1212, 1212,
-     1212, 1212, 1212, 1212, 1213, 1213, 1213, 1213, 1213, 1213,
-     1213, 1213, 1213, 1213, 1213, 1213, 1214, 1214, 1214, 1214,
-     1214, 1214, 1214, 1214, 1214, 1214, 1214, 1214, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161
+        0,    0, 1127, 1126,    0, 1123, 1114,    0,    0, 1117,
+
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+     1127, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132,
+     1132, 1132, 1132, 1132, 1133, 1133, 1133, 1133, 1133, 1133,
+     1133, 1133, 1133, 1133, 1133, 1133, 1133, 1134,    0, 1134,
+     1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134,
+     1135, 1135, 1135, 1135, 1135, 1135, 1135, 1135, 1135, 1135,
+     1135, 1135, 1135, 1136, 1136, 1136, 1136, 1136, 1136, 1136,
+     1136, 1136, 1136, 1136, 1136, 1136, 1137, 1137, 1137, 1137,
+     1137, 1137, 1137, 1137, 1137, 1137, 1137, 1137, 1137, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1139, 1139,
+     1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139,
+     1139, 1140, 1140, 1140, 1140, 1140, 1140, 1140, 1140, 1140,
+     1140, 1140, 1140, 1140, 1141, 1141, 1141, 1141, 1141,    0,
+     1141, 1141, 1141,    0, 1141,    0, 1141, 1142, 1142, 1142,
+     1142, 1142, 1142, 1142, 1142, 1142, 1142, 1142, 1142, 1142,
+     1143,    0,    0,    0,    0,    0,    0,    0, 1143, 1144,
+     1144,    0, 1144, 1144,    0, 1144,    0,    0, 1144, 1144,
+        0, 1144, 1145, 1145, 1145, 1145, 1146, 1146, 1146, 1146,
+     1146, 1146, 1146, 1146, 1146, 1146, 1146, 1146, 1146, 1147,
+
+     1147, 1147, 1147, 1147, 1147, 1147, 1147, 1147, 1147, 1147,
+     1147, 1147, 1148, 1148, 1148, 1148, 1148, 1148, 1148, 1148,
+     1148, 1148, 1148, 1148, 1148, 1149, 1149, 1149,    0, 1149,
+     1149, 1149, 1149, 1149, 1149, 1149, 1149, 1149, 1150,    0,
+     1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150,
+     1150, 1151,    0, 1151, 1151, 1151, 1151, 1151, 1151, 1151,
+     1151, 1151, 1151, 1151, 1152, 1152, 1152, 1152, 1152, 1152,
+     1152, 1152, 1152, 1152, 1152, 1152, 1152, 1153, 1153, 1153,
+     1153, 1153, 1153, 1153, 1153, 1153, 1153, 1153, 1153, 1153,
+     1154, 1154, 1154, 1154, 1154, 1154, 1154, 1154, 1154, 1154,
+
+     1154, 1154, 1154, 1155,    0, 1155, 1155, 1155, 1155, 1155,
+     1155, 1155, 1155, 1155, 1155, 1155, 1156, 1156, 1156, 1156,
+     1156, 1156, 1156, 1156, 1156, 1156, 1156, 1156, 1156, 1157,
+     1157, 1157, 1157, 1157, 1157, 1157, 1157, 1157, 1157, 1157,
+     1157, 1157, 1158, 1158, 1158, 1158, 1158, 1158, 1158, 1158,
+     1158, 1158, 1158, 1158, 1158, 1159,    0, 1159, 1159, 1159,
+     1159, 1159, 1159, 1159, 1159, 1159, 1159, 1159, 1160,    0,
+     1160, 1160, 1160, 1160, 1160, 1160, 1160, 1160, 1160, 1160,
+     1160, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1162, 1162, 1162, 1162, 1162, 1162,
+
+     1162, 1162, 1162, 1162, 1162, 1162, 1162, 1163, 1163, 1163,
+     1163, 1163, 1163, 1163, 1163, 1163, 1163, 1163, 1163, 1163,
+     1164,    0, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164,
+     1164, 1164, 1164, 1165, 1165, 1165, 1165, 1165, 1165, 1165,
+     1165, 1165, 1165, 1165, 1165, 1165, 1166, 1166, 1166, 1166,
+     1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1167,
+     1167, 1167, 1167, 1167, 1167, 1167, 1167, 1167, 1167, 1167,
+     1167, 1167, 1168, 1168, 1168, 1168, 1168, 1168, 1168, 1168,
+     1168, 1168, 1168, 1168, 1168, 1169, 1169, 1169, 1169, 1169,
+     1169, 1169, 1169, 1169, 1169, 1169, 1169, 1169, 1170, 1170,
+
+     1170, 1170, 1170, 1170, 1170, 1170, 1170, 1170, 1170, 1170,
+     1170, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+
+     1131
     } ;
 
@@ -9750,6 +8156,6 @@
 static char *yy_last_accepting_cpos;
 
-extern int fortran_flex_debug;
-int fortran_flex_debug = 0;
+extern int fortran__flex_debug;
+int fortran__flex_debug = 0;
 
 /* The intent behind this definition is that it'll catch
@@ -9760,5 +8166,5 @@
 #define YY_MORE_ADJ 0
 #define YY_RESTORE_YY_MORE_OFFSET
-char *fortrantext;
+char *fortran_text;
 #line 1 "fortran.lex"
 /******************************************************************************/
@@ -9801,17 +8207,17 @@
 
 
-#line 41 "fortran.lex"
+#line 44 "fortran.lex"
 #include <math.h>
 #include <stdlib.h>
 #include <string.h>
-extern FILE * fortranin;
+extern FILE * fortran_in;
 #define MAX_INCLUDE_DEPTH 30
-#define tabsize 6
 YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
-int line_num_fortran=1;
-int line_num_fortran_common=1;
+int line_num_input = 1;
 int newlinef90 = 0;
-char *tmp;
 char tmpc;
+#define PRINT_LINE_NUM()     // { fprintf(stderr,"== Parsing l.%4d...\n", line_num_input); }
+#define INCREMENT_LINE_NUM() { line_num_input++; PRINT_LINE_NUM(); }
+
 /******************************************************************************/
 /**************PETITS PB NON PREVUS *******************************************/
@@ -9823,21 +8229,9 @@
 /*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
 /******************************************************************************/
-#define YY_USER_ACTION \
-        {\
-           if (firstpass == 0) \
-           {\
-              strcat(curbuf,fortrantext); \
-              Save_Length(curbuf,38); \
-              strcpy(motparse,fortrantext);\
-              Save_Length(motparse,32); \
-              colnum = colnum + strlen(motparse);\
-              ECHO; \
-           }\
-           strcpy(motparse1,fortrantext);\
-/*           printf("fortrantext = %s\n",fortrantext);*/\
-        /*if ( firstpass == 1 ) 
-                      printf("fortrantext = %s %d\n",fortrantext,strlen(fortrantext));*/\
-        }
-#line 2979 "fortran.yy.c"
+#define YY_USER_ACTION  if (firstpass == 0) ECHO;
+
+void out_of_donottreat(void);
+
+#line 1826 "fortran.yy.c"
 
 #define INITIAL 0
@@ -9865,29 +8259,29 @@
    These are made visible to non-reentrant scanners for convenience. */
 
-int fortranlex_destroy (void );
-
-int fortranget_debug (void );
-
-void fortranset_debug (int debug_flag  );
-
-YY_EXTRA_TYPE fortranget_extra (void );
-
-void fortranset_extra (YY_EXTRA_TYPE user_defined  );
-
-FILE *fortranget_in (void );
-
-void fortranset_in  (FILE * in_str  );
-
-FILE *fortranget_out (void );
-
-void fortranset_out  (FILE * out_str  );
-
-yy_size_t fortranget_leng (void );
-
-char *fortranget_text (void );
-
-int fortranget_lineno (void );
-
-void fortranset_lineno (int line_number  );
+int fortran_lex_destroy (void );
+
+int fortran_get_debug (void );
+
+void fortran_set_debug (int debug_flag  );
+
+YY_EXTRA_TYPE fortran_get_extra (void );
+
+void fortran_set_extra (YY_EXTRA_TYPE user_defined  );
+
+FILE *fortran_get_in (void );
+
+void fortran_set_in  (FILE * in_str  );
+
+FILE *fortran_get_out (void );
+
+void fortran_set_out  (FILE * out_str  );
+
+yy_size_t fortran_get_leng (void );
+
+char *fortran_get_text (void );
+
+int fortran_get_lineno (void );
+
+void fortran_set_lineno (int line_number  );
 
 /* Macros after this point can all be overridden by user definitions in
@@ -9897,7 +8291,7 @@
 #ifndef YY_SKIP_YYWRAP
 #ifdef __cplusplus
-extern "C" int fortranwrap (void );
+extern "C" int fortran_wrap (void );
 #else
-extern int fortranwrap (void );
+extern int fortran_wrap (void );
 #endif
 #endif
@@ -9933,5 +8327,5 @@
  * we now use fwrite().
  */
-#define ECHO fwrite( fortrantext, fortranleng, 1, fortranout )
+#define ECHO fwrite( fortran_text, fortran_leng, 1, fortran_out )
 #endif
 
@@ -9946,9 +8340,9 @@
 		yy_size_t n; \
 		for ( n = 0; n < max_size && \
-			     (c = getc( fortranin )) != EOF && c != '\n'; ++n ) \
+			     (c = getc( fortran_in )) != EOF && c != '\n'; ++n ) \
 			buf[n] = (char) c; \
 		if ( c == '\n' ) \
 			buf[n++] = (char) c; \
-		if ( c == EOF && ferror( fortranin ) ) \
+		if ( c == EOF && ferror( fortran_in ) ) \
 			YY_FATAL_ERROR( "input in flex scanner failed" ); \
 		result = n; \
@@ -9957,5 +8351,5 @@
 		{ \
 		errno=0; \
-		while ( (result = fread(buf, 1, max_size, fortranin))==0 && ferror(fortranin)) \
+		while ( (result = fread(buf, 1, max_size, fortran_in))==0 && ferror(fortran_in)) \
 			{ \
 			if( errno != EINTR) \
@@ -9965,5 +8359,5 @@
 				} \
 			errno=0; \
-			clearerr(fortranin); \
+			clearerr(fortran_in); \
 			} \
 		}\
@@ -9998,10 +8392,10 @@
 #define YY_DECL_IS_OURS 1
 
-extern int fortranlex (void);
-
-#define YY_DECL int fortranlex (void)
+extern int fortran_lex (void);
+
+#define YY_DECL int fortran_lex (void)
 #endif /* !YY_DECL */
 
-/* Code executed at the beginning of each rule, after fortrantext and fortranleng
+/* Code executed at the beginning of each rule, after fortran_text and fortran_leng
  * have been set up.
  */
@@ -10016,7 +8410,7 @@
 
 #define YY_RULE_SETUP \
-	if ( fortranleng > 0 ) \
+	if ( fortran_leng > 0 ) \
 		YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \
-				(fortrantext[fortranleng - 1] == '\n'); \
+				(fortran_text[fortran_leng - 1] == '\n'); \
 	YY_USER_ACTION
 
@@ -10029,10 +8423,10 @@
 	register int yy_act;
     
-#line 107 "fortran.lex"
+#line 97 "fortran.lex"
 
   if (infixed) BEGIN(fortran77style) ;
-  if (infree) BEGIN(fortran90style)  ;
-
-#line 3174 "fortran.yy.c"
+  if (infree)  BEGIN(fortran90style) ;
+
+#line 2021 "fortran.yy.c"
 
 	if ( !(yy_init) )
@@ -10047,17 +8441,17 @@
 			(yy_start) = 1;	/* first start state */
 
-		if ( ! fortranin )
-			fortranin = stdin;
-
-		if ( ! fortranout )
-			fortranout = stdout;
+		if ( ! fortran_in )
+			fortran_in = stdin;
+
+		if ( ! fortran_out )
+			fortran_out = stdout;
 
 		if ( ! YY_CURRENT_BUFFER ) {
-			fortranensure_buffer_stack ();
+			fortran_ensure_buffer_stack ();
 			YY_CURRENT_BUFFER_LVALUE =
-				fortran_create_buffer(fortranin,YY_BUF_SIZE );
+				fortran__create_buffer(fortran_in,YY_BUF_SIZE );
 		}
 
-		fortran_load_buffer_state( );
+		fortran__load_buffer_state( );
 		}
 
@@ -10066,5 +8460,5 @@
 		yy_cp = (yy_c_buf_p);
 
-		/* Support of fortrantext. */
+		/* Support of fortran_text. */
 		*yy_cp = (yy_hold_char);
 
@@ -10088,5 +8482,5 @@
 				{
 				yy_current_state = (int) yy_def[yy_current_state];
-				if ( yy_current_state >= 1162 )
+				if ( yy_current_state >= 1132 )
 					yy_c = yy_meta[(unsigned int) yy_c];
 				}
@@ -10094,5 +8488,5 @@
 			++yy_cp;
 			}
-		while ( yy_base[yy_current_state] != 9159 );
+		while ( yy_base[yy_current_state] != 4012 );
 
 yy_find_action:
@@ -10120,969 +8514,913 @@
 case 1:
 YY_RULE_SETUP
+#line 101 "fortran.lex"
+{ return TOK_REAL8; }
+	YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 102 "fortran.lex"
+{ return TOK_SUBROUTINE; }
+	YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 103 "fortran.lex"
+{ return TOK_PROGRAM; }
+	YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 104 "fortran.lex"
+{ inallocate = 1; return TOK_ALLOCATE; }
+	YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 105 "fortran.lex"
+{ return TOK_NULLIFY; }
+	YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 106 "fortran.lex"
+{ return TOK_NULL_PTR; }
+	YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 107 "fortran.lex"
+{ inallocate = 1; return TOK_DEALLOCATE; }
+	YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 108 "fortran.lex"
+{ return TOK_RESULT; }
+	YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 109 "fortran.lex"
+{ return TOK_FUNCTION; }
+	YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 110 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ENDPROGRAM;}
+	YY_BREAK
+case 11:
+YY_RULE_SETUP
 #line 111 "fortran.lex"
-return TOK_DEBUT;
-	YY_BREAK
-case 2:
+{ strcpy(yylval.na,fortran_text); return TOK_ENDMODULE; }
+	YY_BREAK
+case 12:
 YY_RULE_SETUP
 #line 112 "fortran.lex"
-return TOK_FIN;
-	YY_BREAK
-case 3:
+{ strcpy(yylval.na,fortran_text); return TOK_ENDSUBROUTINE;}
+	YY_BREAK
+case 13:
 YY_RULE_SETUP
 #line 113 "fortran.lex"
-return TOK_OMP;
-	YY_BREAK
-case 4:
+{ strcpy(yylval.na,fortran_text); return TOK_ENDFUNCTION;}
+	YY_BREAK
+case 14:
 YY_RULE_SETUP
 #line 114 "fortran.lex"
-return TOK_DOLLAR;
-	YY_BREAK
-case 5:
+{ strcpy(yylval.na,fortran_text); return TOK_ENDUNIT;}
+	YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 115 "fortran.lex"
+{ pos_curinclude = setposcur()-9; return TOK_INCLUDE;}
+	YY_BREAK
+case 16:
 YY_RULE_SETUP
 #line 116 "fortran.lex"
-{return TOK_REAL8;}
-	YY_BREAK
-case 6:
-YY_RULE_SETUP
-#line 117 "fortran.lex"
-{return TOK_SUBROUTINE;}
-	YY_BREAK
-case 7:
-YY_RULE_SETUP
-#line 118 "fortran.lex"
-{return TOK_PROGRAM;}
-	YY_BREAK
-case 8:
-YY_RULE_SETUP
-#line 119 "fortran.lex"
-{inallocate = 1; return TOK_ALLOCATE;}
-	YY_BREAK
-case 9:
-YY_RULE_SETUP
-#line 120 "fortran.lex"
-{return TOK_NULLIFY;}
-	YY_BREAK
-case 10:
-YY_RULE_SETUP
-#line 121 "fortran.lex"
-{inallocate = 1; return TOK_DEALLOCATE;}
-	YY_BREAK
-case 11:
+{ strcpy(yylval.na,fortran_text);
+                              tmpc = (char) input(); unput(tmpc);
+                              if ( ( tmpc >= 'a' && tmpc <= 'z' ) ||
+                                   ( tmpc >= 'A' && tmpc <= 'Z' )  )  return TOK_USE;
+                              else                                    return TOK_NAME;
+                            }
+	YY_BREAK
+case 17:
 YY_RULE_SETUP
 #line 122 "fortran.lex"
-{return TOK_RESULT;}
-	YY_BREAK
-case 12:
+{ return TOK_REWIND; }
+	YY_BREAK
+case 18:
 YY_RULE_SETUP
 #line 123 "fortran.lex"
-{return TOK_FUNCTION;}
-	YY_BREAK
-case 13:
+{ return TOK_IMPLICIT; }
+	YY_BREAK
+case 19:
 YY_RULE_SETUP
 #line 124 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDSUBROUTINE;}
-	YY_BREAK
-case 14:
+{ return TOK_NONE; }
+	YY_BREAK
+case 20:
 YY_RULE_SETUP
 #line 125 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDPROGRAM;}
-	YY_BREAK
-case 15:
+{ return TOK_CALL; }
+	YY_BREAK
+case 21:
 YY_RULE_SETUP
 #line 126 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDFUNCTION;}
-	YY_BREAK
-case 16:
+{ return TOK_TRUE; }
+	YY_BREAK
+case 22:
 YY_RULE_SETUP
 #line 127 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDUNIT;}
-	YY_BREAK
-case 17:
+{ return TOK_FALSE; }
+	YY_BREAK
+case 23:
 YY_RULE_SETUP
 #line 128 "fortran.lex"
-return TOK_INCLUDE;
-	YY_BREAK
-case 18:
+{ return TOK_POINT_TO; }
+	YY_BREAK
+case 24:
 YY_RULE_SETUP
 #line 129 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ASSIGNTYPE;}
+	YY_BREAK
+case 25:
+YY_RULE_SETUP
+#line 130 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DASTER; }
+	YY_BREAK
+case 26:
+YY_RULE_SETUP
+#line 131 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_EQV; }
+	YY_BREAK
+case 27:
+YY_RULE_SETUP
+#line 132 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_EQ;  }
+	YY_BREAK
+case 28:
+YY_RULE_SETUP
+#line 133 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_GT;  }
+	YY_BREAK
+case 29:
+YY_RULE_SETUP
+#line 134 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_GE;  }
+	YY_BREAK
+case 30:
+YY_RULE_SETUP
+#line 135 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_LT;  }
+	YY_BREAK
+case 31:
+YY_RULE_SETUP
+#line 136 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_LE;  }
+	YY_BREAK
+case 32:
+YY_RULE_SETUP
+#line 137 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NEQV;}
+	YY_BREAK
+case 33:
+YY_RULE_SETUP
+#line 138 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NE;  }
+	YY_BREAK
+case 34:
+YY_RULE_SETUP
+#line 139 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NOT; }
+	YY_BREAK
+case 35:
+YY_RULE_SETUP
+#line 140 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_OR;  }
+	YY_BREAK
+case 36:
+YY_RULE_SETUP
+#line 141 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_XOR; }
+	YY_BREAK
+case 37:
+YY_RULE_SETUP
+#line 142 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_AND; }
+	YY_BREAK
+case 38:
+YY_RULE_SETUP
+#line 143 "fortran.lex"
+{ return TOK_MODULE; }
+	YY_BREAK
+case 39:
+YY_RULE_SETUP
+#line 144 "fortran.lex"
+{ return TOK_WHILE; }
+	YY_BREAK
+case 40:
+YY_RULE_SETUP
+#line 145 "fortran.lex"
+{ return TOK_CONCURRENT; }
+	YY_BREAK
+case 41:
+YY_RULE_SETUP
+#line 146 "fortran.lex"
+{ return TOK_ENDDO; }
+	YY_BREAK
+case 42:
+YY_RULE_SETUP
+#line 147 "fortran.lex"
+{ return TOK_PLAINDO;}
+	YY_BREAK
+case 43:
+YY_RULE_SETUP
+#line 148 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_REAL; }
+	YY_BREAK
+case 44:
+YY_RULE_SETUP
+#line 149 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_INTEGER; }
+	YY_BREAK
+case 45:
+YY_RULE_SETUP
+#line 150 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_LOGICAL; }
+	YY_BREAK
+case 46:
+YY_RULE_SETUP
+#line 151 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_CHARACTER; }
+	YY_BREAK
+case 47:
+YY_RULE_SETUP
+#line 152 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_HEXA;}
+	YY_BREAK
+case 48:
+YY_RULE_SETUP
+#line 153 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DOUBLEPRECISION; }
+	YY_BREAK
+case 49:
+YY_RULE_SETUP
+#line 154 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DOUBLECOMPLEX; }
+	YY_BREAK
+case 50:
+YY_RULE_SETUP
+#line 155 "fortran.lex"
+{ return TOK_COMPLEX; }
+	YY_BREAK
+case 51:
+YY_RULE_SETUP
+#line 156 "fortran.lex"
+{ return TOK_ALLOCATABLE; }
+	YY_BREAK
+case 52:
+YY_RULE_SETUP
+#line 157 "fortran.lex"
+{ return TOK_CLOSE; }
+	YY_BREAK
+case 53:
+YY_RULE_SETUP
+#line 158 "fortran.lex"
+{ return TOK_INQUIRE; }
+	YY_BREAK
+case 54:
+YY_RULE_SETUP
+#line 159 "fortran.lex"
+{ return TOK_DIMENSION; }
+	YY_BREAK
+case 55:
+YY_RULE_SETUP
+#line 160 "fortran.lex"
+{ return TOK_PAUSE; }
+	YY_BREAK
+case 56:
+YY_RULE_SETUP
+#line 161 "fortran.lex"
+{ return TOK_EQUIVALENCE; }
+	YY_BREAK
+case 57:
+YY_RULE_SETUP
+#line 162 "fortran.lex"
+{ return TOK_STOP; }
+	YY_BREAK
+case 58:
+YY_RULE_SETUP
+#line 163 "fortran.lex"
+{ return TOK_WHERE; }
+	YY_BREAK
+case 59:
+YY_RULE_SETUP
+#line 164 "fortran.lex"
+{ return TOK_ENDWHERE; }
+	YY_BREAK
+case 60:
+YY_RULE_SETUP
+#line 165 "fortran.lex"
+{ return TOK_ELSEWHEREPAR; }
+	YY_BREAK
+case 61:
+YY_RULE_SETUP
+#line 166 "fortran.lex"
+{ return TOK_ELSEWHERE; }
+	YY_BREAK
+case 62:
+YY_RULE_SETUP
+#line 167 "fortran.lex"
+{ return TOK_CONTAINS; }
+	YY_BREAK
+case 63:
+YY_RULE_SETUP
+#line 168 "fortran.lex"
+{ return TOK_ONLY; }
+	YY_BREAK
+case 64:
+YY_RULE_SETUP
+#line 169 "fortran.lex"
+{ return TOK_PARAMETER; }
+	YY_BREAK
+case 65:
+YY_RULE_SETUP
+#line 170 "fortran.lex"
+{ return TOK_RECURSIVE; }
+	YY_BREAK
+case 66:
+YY_RULE_SETUP
+#line 171 "fortran.lex"
+{ return TOK_COMMON; }
+	YY_BREAK
+case 67:
+YY_RULE_SETUP
+#line 172 "fortran.lex"
+{ return TOK_GLOBAL; }
+	YY_BREAK
+case 68:
+YY_RULE_SETUP
+#line 173 "fortran.lex"
+{ return TOK_EXTERNAL; }
+	YY_BREAK
+case 69:
+YY_RULE_SETUP
+#line 174 "fortran.lex"
+{ return TOK_INTENT; }
+	YY_BREAK
+case 70:
+YY_RULE_SETUP
+#line 175 "fortran.lex"
+{ return TOK_POINTER; }
+	YY_BREAK
+case 71:
+YY_RULE_SETUP
+#line 176 "fortran.lex"
+{ return TOK_OPTIONAL; }
+	YY_BREAK
+case 72:
+YY_RULE_SETUP
+#line 177 "fortran.lex"
+{ return TOK_SAVE; }
+	YY_BREAK
+case 73:
+YY_RULE_SETUP
+#line 178 "fortran.lex"
+{ pos_cur_decl = setposcur()-5; return TOK_TYPEPAR; }
+	YY_BREAK
+case 74:
+YY_RULE_SETUP
+#line 179 "fortran.lex"
+{ return TOK_TYPE; }
+	YY_BREAK
+case 75:
+YY_RULE_SETUP
+#line 180 "fortran.lex"
+{ return TOK_ENDTYPE; }
+	YY_BREAK
+case 76:
+YY_RULE_SETUP
+#line 181 "fortran.lex"
+{ if (inallocate == 1) return TOK_STAT; else { strcpy(yylval.na,fortran_text); return TOK_NAME; } }
+	YY_BREAK
+case 77:
+YY_RULE_SETUP
+#line 182 "fortran.lex"
+{ return TOK_OPEN; }
+	YY_BREAK
+case 78:
+YY_RULE_SETUP
+#line 183 "fortran.lex"
+{ return TOK_RETURN; }
+	YY_BREAK
+case 79:
+/* rule 79 can match eol */
+YY_RULE_SETUP
+#line 184 "fortran.lex"
+{ return TOK_EXIT; }
+	YY_BREAK
+case 80:
+YY_RULE_SETUP
+#line 185 "fortran.lex"
+{ return TOK_PRINT; }
+	YY_BREAK
+case 81:
+YY_RULE_SETUP
+#line 186 "fortran.lex"
+{ return TOK_PROCEDURE; }
+	YY_BREAK
+case 82:
+YY_RULE_SETUP
+#line 187 "fortran.lex"
+{ return TOK_READ; }
+	YY_BREAK
+case 83:
+YY_RULE_SETUP
+#line 188 "fortran.lex"
+{ return TOK_NAMELIST; }
+	YY_BREAK
+case 84:
+YY_RULE_SETUP
+#line 189 "fortran.lex"
+{ return TOK_WRITE; }
+	YY_BREAK
+case 85:
+YY_RULE_SETUP
+#line 190 "fortran.lex"
+{ return TOK_FLUSH; }
+	YY_BREAK
+case 86:
+YY_RULE_SETUP
+#line 191 "fortran.lex"
+{ return TOK_TARGET; }
+	YY_BREAK
+case 87:
+YY_RULE_SETUP
+#line 192 "fortran.lex"
+{ return TOK_PUBLIC; }
+	YY_BREAK
+case 88:
+YY_RULE_SETUP
+#line 193 "fortran.lex"
+{ return TOK_PRIVATE; }
+	YY_BREAK
+case 89:
+YY_RULE_SETUP
+#line 194 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_IN; }
+	YY_BREAK
+case 90:
+YY_RULE_SETUP
+#line 195 "fortran.lex"
+{ pos_curdata = setposcur()-strlen(fortran_text); Init_List_Data_Var(); return TOK_DATA; }
+	YY_BREAK
+case 91:
+YY_RULE_SETUP
+#line 196 "fortran.lex"
+{ return TOK_CONTINUE; }
+	YY_BREAK
+case 92:
+YY_RULE_SETUP
+#line 197 "fortran.lex"
+{ return TOK_PLAINGOTO; }
+	YY_BREAK
+case 93:
+YY_RULE_SETUP
+#line 198 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_OUT; }
+	YY_BREAK
+case 94:
+YY_RULE_SETUP
+#line 199 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_INOUT; }
+	YY_BREAK
+case 95:
+YY_RULE_SETUP
+#line 200 "fortran.lex"
+{ return TOK_INTRINSIC; }
+	YY_BREAK
+case 96:
+YY_RULE_SETUP
+#line 201 "fortran.lex"
+{ return TOK_THEN; }
+	YY_BREAK
+case 97:
+YY_RULE_SETUP
+#line 202 "fortran.lex"
+{ return TOK_ELSEIF; }
+	YY_BREAK
+case 98:
+YY_RULE_SETUP
+#line 203 "fortran.lex"
+{ return TOK_ELSE; }
+	YY_BREAK
+case 99:
+YY_RULE_SETUP
+#line 204 "fortran.lex"
+{ return TOK_ENDIF; }
+	YY_BREAK
+case 100:
+YY_RULE_SETUP
+#line 205 "fortran.lex"
+{ return TOK_LOGICALIF; }
+	YY_BREAK
+case 101:
+YY_RULE_SETUP
+#line 206 "fortran.lex"
+{ return TOK_SUM; }
+	YY_BREAK
+case 102:
+YY_RULE_SETUP
+#line 207 "fortran.lex"
+{ return TOK_MAX; }
+	YY_BREAK
+case 103:
+YY_RULE_SETUP
+#line 208 "fortran.lex"
+{ return TOK_TANH; }
+	YY_BREAK
+case 104:
+YY_RULE_SETUP
+#line 209 "fortran.lex"
+{ return TOK_MAXVAL; }
+	YY_BREAK
+case 105:
+YY_RULE_SETUP
+#line 210 "fortran.lex"
+{ return TOK_TRIM; }
+	YY_BREAK
+case 106:
+YY_RULE_SETUP
+#line 211 "fortran.lex"
+{ return TOK_SQRT; }
+	YY_BREAK
+case 107:
+YY_RULE_SETUP
+#line 212 "fortran.lex"
+{ return TOK_SELECTCASE; }
+	YY_BREAK
+case 108:
+YY_RULE_SETUP
+#line 213 "fortran.lex"
+{ return TOK_CASE; }
+	YY_BREAK
+case 109:
+YY_RULE_SETUP
+#line 214 "fortran.lex"
+{ return TOK_DEFAULT; }
+	YY_BREAK
+case 110:
+YY_RULE_SETUP
+#line 215 "fortran.lex"
+{ return TOK_ENDSELECT; }
+	YY_BREAK
+case 111:
+YY_RULE_SETUP
+#line 216 "fortran.lex"
+{ return TOK_FILE; }
+	YY_BREAK
+case 112:
+YY_RULE_SETUP
+#line 217 "fortran.lex"
+{ return TOK_UNIT; }
+	YY_BREAK
+case 113:
+YY_RULE_SETUP
+#line 218 "fortran.lex"
+{ return TOK_FMT; }
+	YY_BREAK
+case 114:
+YY_RULE_SETUP
+#line 219 "fortran.lex"
+{ return TOK_NML; }
+	YY_BREAK
+case 115:
+YY_RULE_SETUP
+#line 220 "fortran.lex"
+{ return TOK_END; }
+	YY_BREAK
+case 116:
+YY_RULE_SETUP
+#line 221 "fortran.lex"
+{ return TOK_EOR; }
+	YY_BREAK
+case 117:
+YY_RULE_SETUP
+#line 222 "fortran.lex"
+{ return TOK_ERR; }
+	YY_BREAK
+case 118:
+YY_RULE_SETUP
+#line 223 "fortran.lex"
+{ return TOK_EXIST; }
+	YY_BREAK
+case 119:
+YY_RULE_SETUP
+#line 224 "fortran.lex"
+{ return TOK_MIN; }
+	YY_BREAK
+case 120:
+YY_RULE_SETUP
+#line 225 "fortran.lex"
+{ return TOK_NINT; }
+	YY_BREAK
+case 121:
+YY_RULE_SETUP
+#line 226 "fortran.lex"
+{ return TOK_FLOAT; }
+	YY_BREAK
+case 122:
+YY_RULE_SETUP
+#line 227 "fortran.lex"
+{ return TOK_EXP; }
+	YY_BREAK
+case 123:
+YY_RULE_SETUP
+#line 228 "fortran.lex"
+{ return TOK_COS; }
+	YY_BREAK
+case 124:
+YY_RULE_SETUP
+#line 229 "fortran.lex"
+{ return TOK_COSH; }
+	YY_BREAK
+case 125:
+YY_RULE_SETUP
+#line 230 "fortran.lex"
+{ return TOK_ACOS; }
+	YY_BREAK
+case 126:
+YY_RULE_SETUP
+#line 231 "fortran.lex"
+{ return TOK_SIN; }
+	YY_BREAK
+case 127:
+YY_RULE_SETUP
+#line 232 "fortran.lex"
+{ return TOK_SINH; }
+	YY_BREAK
+case 128:
+YY_RULE_SETUP
+#line 233 "fortran.lex"
+{ return TOK_ASIN; }
+	YY_BREAK
+case 129:
+YY_RULE_SETUP
+#line 234 "fortran.lex"
+{ return TOK_LOG; }
+	YY_BREAK
+case 130:
+YY_RULE_SETUP
+#line 235 "fortran.lex"
+{ return TOK_TAN; }
+	YY_BREAK
+case 131:
+YY_RULE_SETUP
+#line 236 "fortran.lex"
+{ return TOK_ATAN; }
+	YY_BREAK
+case 132:
+YY_RULE_SETUP
+#line 237 "fortran.lex"
+{ return TOK_CYCLE; }
+	YY_BREAK
+case 133:
+YY_RULE_SETUP
+#line 238 "fortran.lex"
+{ return TOK_ABS; }
+	YY_BREAK
+case 134:
+YY_RULE_SETUP
+#line 239 "fortran.lex"
+{ return TOK_MOD; }
+	YY_BREAK
+case 135:
+YY_RULE_SETUP
+#line 240 "fortran.lex"
+{ return TOK_SIGN; }
+	YY_BREAK
+case 136:
+YY_RULE_SETUP
+#line 241 "fortran.lex"
+{ return TOK_MINLOC; }
+	YY_BREAK
+case 137:
+YY_RULE_SETUP
+#line 242 "fortran.lex"
+{ return TOK_MAXLOC; }
+	YY_BREAK
+case 138:
+YY_RULE_SETUP
+#line 243 "fortran.lex"
+{ return TOK_MINVAL; }
+	YY_BREAK
+case 139:
+YY_RULE_SETUP
+#line 244 "fortran.lex"
+{ return TOK_BACKSPACE; }
+	YY_BREAK
+case 140:
+YY_RULE_SETUP
+#line 245 "fortran.lex"
+{ return TOK_FOURDOTS;  }
+	YY_BREAK
+case 141:
+YY_RULE_SETUP
+#line 246 "fortran.lex"
+{ return TOK_LEFTAB; }
+	YY_BREAK
+case 142:
+YY_RULE_SETUP
+#line 247 "fortran.lex"
+{ return TOK_RIGHTAB; }
+	YY_BREAK
+case 143:
+/* rule 143 can match eol */
+YY_RULE_SETUP
+#line 248 "fortran.lex"
 {
-                            strcpy(yylval.na,fortrantext);
-                            tmpc = input();
-                            unput(tmpc);
-                            if ( (
-                               tmpc >= 'a' && tmpc <= 'z'
-                                  ) || (
-                               tmpc >= 'A' && tmpc <= 'Z'
-                               )  )
-                               {
-                                  return TOK_USE;
-                               }
-                               else
-                               {
-                                  return TOK_NAME;
-                               }
-                         }
-	YY_BREAK
-case 19:
-YY_RULE_SETUP
-#line 146 "fortran.lex"
-{return TOK_REWIND;}
-	YY_BREAK
-case 20:
-YY_RULE_SETUP
-#line 147 "fortran.lex"
-return TOK_IMPLICIT;
-	YY_BREAK
-case 21:
-YY_RULE_SETUP
-#line 148 "fortran.lex"
-return TOK_NONE;
-	YY_BREAK
-case 22:
-YY_RULE_SETUP
-#line 149 "fortran.lex"
-return TOK_CALL;
-	YY_BREAK
-case 23:
-YY_RULE_SETUP
-#line 150 "fortran.lex"
-return TOK_TRUE;
-	YY_BREAK
-case 24:
-YY_RULE_SETUP
-#line 151 "fortran.lex"
-return TOK_FALSE;
-	YY_BREAK
-case 25:
-YY_RULE_SETUP
-#line 152 "fortran.lex"
-{return TOK_POINT_TO;}
-	YY_BREAK
-case 26:
-YY_RULE_SETUP
-#line 153 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DASTER;}
-	YY_BREAK
-case 27:
-YY_RULE_SETUP
-#line 154 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_EQV;}
-	YY_BREAK
-case 28:
-YY_RULE_SETUP
-#line 155 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_EQ;}
-	YY_BREAK
-case 29:
-YY_RULE_SETUP
-#line 156 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_GT;}
-	YY_BREAK
-case 30:
-YY_RULE_SETUP
-#line 157 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_GE;}
-	YY_BREAK
-case 31:
-YY_RULE_SETUP
-#line 158 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_LT;}
-	YY_BREAK
-case 32:
-YY_RULE_SETUP
-#line 159 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_LE;}
-	YY_BREAK
-case 33:
-YY_RULE_SETUP
-#line 160 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NEQV;}
-	YY_BREAK
-case 34:
-YY_RULE_SETUP
-#line 161 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NE;}
-	YY_BREAK
-case 35:
-YY_RULE_SETUP
-#line 162 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NOT;}
-	YY_BREAK
-case 36:
-YY_RULE_SETUP
-#line 163 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_OR;}
-	YY_BREAK
-case 37:
-YY_RULE_SETUP
-#line 164 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_XOR;}
-	YY_BREAK
-case 38:
-YY_RULE_SETUP
-#line 165 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_AND;}
-	YY_BREAK
-case 39:
-YY_RULE_SETUP
-#line 166 "fortran.lex"
-{return TOK_MODULE;}
-	YY_BREAK
-case 40:
-YY_RULE_SETUP
-#line 167 "fortran.lex"
-{return TOK_DOWHILE;}
-	YY_BREAK
-case 41:
-YY_RULE_SETUP
-#line 168 "fortran.lex"
-return TOK_ENDMODULE;
-	YY_BREAK
-case 42:
-YY_RULE_SETUP
-#line 169 "fortran.lex"
-return TOK_ENDDO;
-	YY_BREAK
-case 43:
-YY_RULE_SETUP
-#line 170 "fortran.lex"
-{return TOK_PLAINDO;}
-	YY_BREAK
-case 44:
-YY_RULE_SETUP
-#line 171 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_REAL;}
-	YY_BREAK
-case 45:
-YY_RULE_SETUP
-#line 172 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_INTEGER;}
-	YY_BREAK
-case 46:
-YY_RULE_SETUP
-#line 173 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_LOGICAL;}
-	YY_BREAK
-case 47:
-YY_RULE_SETUP
-#line 174 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHARACTER;}
-	YY_BREAK
-case 48:
-YY_RULE_SETUP
-#line 175 "fortran.lex"
-{return TOK_ALLOCATABLE;}
-	YY_BREAK
-case 49:
-YY_RULE_SETUP
-#line 176 "fortran.lex"
-return TOK_CLOSE;
-	YY_BREAK
-case 50:
-YY_RULE_SETUP
-#line 177 "fortran.lex"
-return TOK_INQUIRE;
-	YY_BREAK
-case 51:
-YY_RULE_SETUP
-#line 178 "fortran.lex"
-{return TOK_DIMENSION;}
-	YY_BREAK
-case 52:
-YY_RULE_SETUP
-#line 179 "fortran.lex"
-return TOK_PAUSE;
-	YY_BREAK
-case 53:
-YY_RULE_SETUP
-#line 180 "fortran.lex"
-return TOK_EQUIVALENCE;
-	YY_BREAK
-case 54:
-YY_RULE_SETUP
-#line 181 "fortran.lex"
-return TOK_STOP;
-	YY_BREAK
-case 55:
-YY_RULE_SETUP
-#line 182 "fortran.lex"
-return TOK_WHERE;
-	YY_BREAK
-case 56:
-YY_RULE_SETUP
-#line 183 "fortran.lex"
-return TOK_ENDWHERE;
-	YY_BREAK
-case 57:
-YY_RULE_SETUP
-#line 184 "fortran.lex"
-return TOK_ELSEWHERE;
-	YY_BREAK
-case 58:
-YY_RULE_SETUP
-#line 185 "fortran.lex"
-{return TOK_COMPLEX;}
-	YY_BREAK
-case 59:
-YY_RULE_SETUP
-#line 186 "fortran.lex"
-{return TOK_CONTAINS;}
-	YY_BREAK
-case 60:
-YY_RULE_SETUP
-#line 187 "fortran.lex"
-{return TOK_ONLY;}
-	YY_BREAK
-case 61:
-YY_RULE_SETUP
-#line 188 "fortran.lex"
-{return TOK_PARAMETER;}
-	YY_BREAK
-case 62:
-YY_RULE_SETUP
-#line 189 "fortran.lex"
-{return TOK_RECURSIVE;}
-	YY_BREAK
-case 63:
-YY_RULE_SETUP
-#line 190 "fortran.lex"
-{return TOK_COMMON;}
-	YY_BREAK
-case 64:
-YY_RULE_SETUP
-#line 191 "fortran.lex"
-{return TOK_GLOBAL;}
-	YY_BREAK
-case 65:
-YY_RULE_SETUP
-#line 192 "fortran.lex"
-{return TOK_EXTERNAL;}
-	YY_BREAK
-case 66:
-YY_RULE_SETUP
-#line 193 "fortran.lex"
-{return TOK_INTENT;}
-	YY_BREAK
-case 67:
-YY_RULE_SETUP
-#line 194 "fortran.lex"
-{return TOK_POINTER;}
-	YY_BREAK
-case 68:
-YY_RULE_SETUP
-#line 195 "fortran.lex"
-{return TOK_OPTIONAL;}
-	YY_BREAK
-case 69:
-YY_RULE_SETUP
-#line 196 "fortran.lex"
-{return TOK_SAVE;}
-	YY_BREAK
-case 70:
-YY_RULE_SETUP
-#line 197 "fortran.lex"
-{return TOK_TYPE;}
-	YY_BREAK
-case 71:
-YY_RULE_SETUP
-#line 198 "fortran.lex"
-{return TOK_TYPEPAR;}
-	YY_BREAK
-case 72:
-YY_RULE_SETUP
-#line 199 "fortran.lex"
-{if (inallocate == 1) return TOK_STAT; else {strcpy(yylval.na,fortrantext);return TOK_NAME;}}
-	YY_BREAK
-case 73:
-YY_RULE_SETUP
-#line 200 "fortran.lex"
-{return TOK_ENDTYPE;}
-	YY_BREAK
-case 74:
-YY_RULE_SETUP
-#line 201 "fortran.lex"
-return TOK_OPEN;
-	YY_BREAK
-case 75:
-YY_RULE_SETUP
-#line 202 "fortran.lex"
-return TOK_RETURN;
-	YY_BREAK
-case 76:
-/* rule 76 can match eol */
-YY_RULE_SETUP
-#line 203 "fortran.lex"
-return TOK_EXIT;
-	YY_BREAK
-case 77:
-YY_RULE_SETUP
-#line 204 "fortran.lex"
-return TOK_PRINT;
-	YY_BREAK
-case 78:
-YY_RULE_SETUP
-#line 205 "fortran.lex"
-{return TOK_PROCEDURE;}
-	YY_BREAK
-case 79:
-YY_RULE_SETUP
-#line 206 "fortran.lex"
-{return TOK_READ;}
-	YY_BREAK
-case 80:
-YY_RULE_SETUP
-#line 207 "fortran.lex"
-{return TOK_NAMELIST;}
-	YY_BREAK
-case 81:
-YY_RULE_SETUP
-#line 208 "fortran.lex"
-{return TOK_WRITE;}
-	YY_BREAK
-case 82:
-YY_RULE_SETUP
-#line 209 "fortran.lex"
-{return TOK_TARGET;}
-	YY_BREAK
-case 83:
-YY_RULE_SETUP
-#line 210 "fortran.lex"
-{return TOK_PUBLIC;}
-	YY_BREAK
-case 84:
-YY_RULE_SETUP
-#line 211 "fortran.lex"
-{return TOK_PRIVATE;}
-	YY_BREAK
-case 85:
-YY_RULE_SETUP
-#line 212 "fortran.lex"
-{strcpy(yylval.nac,fortrantext);return TOK_IN;}
-	YY_BREAK
-case 86:
-YY_RULE_SETUP
-#line 213 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DATA;}
-	YY_BREAK
-case 87:
-YY_RULE_SETUP
-#line 214 "fortran.lex"
-return TOK_CONTINUE;
-	YY_BREAK
-case 88:
-YY_RULE_SETUP
-#line 215 "fortran.lex"
-{return TOK_PLAINGOTO;}
-	YY_BREAK
-case 89:
-YY_RULE_SETUP
-#line 216 "fortran.lex"
-{strcpy(yylval.nac,fortrantext);return TOK_OUT;}
-	YY_BREAK
-case 90:
-YY_RULE_SETUP
-#line 217 "fortran.lex"
-{strcpy(yylval.nac,fortrantext);return TOK_INOUT;}
-	YY_BREAK
-case 91:
-YY_RULE_SETUP
-#line 218 "fortran.lex"
-{return TOK_INTRINSIC;}
-	YY_BREAK
-case 92:
-YY_RULE_SETUP
-#line 219 "fortran.lex"
-{return TOK_THEN;}
-	YY_BREAK
-case 93:
-YY_RULE_SETUP
-#line 220 "fortran.lex"
-{return TOK_ELSEIF;}
-	YY_BREAK
-case 94:
-YY_RULE_SETUP
-#line 221 "fortran.lex"
-{return TOK_ELSE;}
-	YY_BREAK
-case 95:
-YY_RULE_SETUP
-#line 222 "fortran.lex"
-{return TOK_ENDIF;}
-	YY_BREAK
-case 96:
-YY_RULE_SETUP
-#line 223 "fortran.lex"
-{return TOK_LOGICALIF;}
-	YY_BREAK
-case 97:
-YY_RULE_SETUP
-#line 224 "fortran.lex"
-{return TOK_SUM;}
-	YY_BREAK
-case 98:
-YY_RULE_SETUP
-#line 225 "fortran.lex"
-{return TOK_MAX;}
-	YY_BREAK
-case 99:
-YY_RULE_SETUP
-#line 226 "fortran.lex"
-{return TOK_TANH;}
-	YY_BREAK
-case 100:
-YY_RULE_SETUP
-#line 227 "fortran.lex"
-{return TOK_MAXVAL;}
-	YY_BREAK
-case 101:
-YY_RULE_SETUP
-#line 228 "fortran.lex"
-{return TOK_TRIM;}
-	YY_BREAK
-case 102:
-YY_RULE_SETUP
-#line 229 "fortran.lex"
-{return TOK_SQRT;}
-	YY_BREAK
-case 103:
-YY_RULE_SETUP
-#line 230 "fortran.lex"
-{return TOK_SELECTCASE;}
-	YY_BREAK
-case 104:
-YY_RULE_SETUP
-#line 231 "fortran.lex"
-{return TOK_CASE;}
-	YY_BREAK
-case 105:
-YY_RULE_SETUP
-#line 232 "fortran.lex"
-{return TOK_CASEDEFAULT;}
-	YY_BREAK
-case 106:
-YY_RULE_SETUP
-#line 233 "fortran.lex"
-{return TOK_ENDSELECT;}
-	YY_BREAK
-case 107:
-YY_RULE_SETUP
-#line 234 "fortran.lex"
-{return TOK_FILE;}
-	YY_BREAK
-case 108:
-YY_RULE_SETUP
-#line 235 "fortran.lex"
-{return TOK_END;}
-	YY_BREAK
-case 109:
-YY_RULE_SETUP
-#line 236 "fortran.lex"
-{return TOK_ERR;}
-	YY_BREAK
-case 110:
-YY_RULE_SETUP
-#line 237 "fortran.lex"
-{return TOK_EXIST;}
-	YY_BREAK
-case 111:
-YY_RULE_SETUP
-#line 238 "fortran.lex"
-{return TOK_MIN;}
-	YY_BREAK
-case 112:
-YY_RULE_SETUP
-#line 239 "fortran.lex"
-{return TOK_NINT;}
-	YY_BREAK
-case 113:
-YY_RULE_SETUP
-#line 240 "fortran.lex"
-{return TOK_FLOAT;}
-	YY_BREAK
-case 114:
-YY_RULE_SETUP
-#line 241 "fortran.lex"
-{return TOK_EXP;}
-	YY_BREAK
-case 115:
-YY_RULE_SETUP
-#line 242 "fortran.lex"
-{return TOK_COS;}
-	YY_BREAK
-case 116:
-YY_RULE_SETUP
-#line 243 "fortran.lex"
-{return TOK_COSH;}
-	YY_BREAK
-case 117:
-YY_RULE_SETUP
-#line 244 "fortran.lex"
-{return TOK_ACOS;}
-	YY_BREAK
-case 118:
-YY_RULE_SETUP
-#line 245 "fortran.lex"
-{return TOK_SIN;}
-	YY_BREAK
-case 119:
-YY_RULE_SETUP
-#line 246 "fortran.lex"
-{return TOK_SINH;}
-	YY_BREAK
-case 120:
-YY_RULE_SETUP
-#line 247 "fortran.lex"
-{return TOK_ASIN;}
-	YY_BREAK
-case 121:
-YY_RULE_SETUP
-#line 248 "fortran.lex"
-{return TOK_LOG;}
-	YY_BREAK
-case 122:
-YY_RULE_SETUP
-#line 249 "fortran.lex"
-{return TOK_TAN;}
-	YY_BREAK
-case 123:
+                              return TOK_FORMAT; }
+	YY_BREAK
+case 144:
 YY_RULE_SETUP
 #line 250 "fortran.lex"
-{return TOK_ATAN;}
-	YY_BREAK
-case 124:
+{ strcpy(yylval.na,fortran_text); return TOK_SLASH; }
+	YY_BREAK
+case 145:
 YY_RULE_SETUP
 #line 251 "fortran.lex"
-{return TOK_CYCLE;}
-	YY_BREAK
-case 125:
+{ strcpy(yylval.na,fortran_text); return TOK_DSLASH; }
+	YY_BREAK
+case 146:
+/* rule 146 can match eol */
 YY_RULE_SETUP
 #line 252 "fortran.lex"
-{return TOK_ABS;}
-	YY_BREAK
-case 126:
-YY_RULE_SETUP
-#line 253 "fortran.lex"
-{return TOK_MOD;}
-	YY_BREAK
-case 127:
+{
+                              strcpy(yylval.na,fortran_text); return TOK_CHAR_CUT; }
+	YY_BREAK
+case 147:
+/* rule 147 can match eol */
 YY_RULE_SETUP
 #line 254 "fortran.lex"
-{return TOK_SIGN;}
-	YY_BREAK
-case 128:
+{ strcpy(yylval.na,fortran_text);return TOK_CHAR_CONSTANT; }
+	YY_BREAK
+case 148:
+/* rule 148 can match eol */
 YY_RULE_SETUP
 #line 255 "fortran.lex"
-{return TOK_MINLOC;}
-	YY_BREAK
-case 129:
+{ strcpy(yylval.na,fortran_text);return TOK_CHAR_MESSAGE; }
+	YY_BREAK
+case 149:
 YY_RULE_SETUP
 #line 256 "fortran.lex"
-{return TOK_MAXLOC;}
-	YY_BREAK
-case 130:
+{ BEGIN(donottreat); }
+	YY_BREAK
+case 150:
+/* rule 150 can match eol */
 YY_RULE_SETUP
 #line 257 "fortran.lex"
-{return TOK_MINVAL;}
-	YY_BREAK
-case 131:
+{ out_of_donottreat(); return '\n'; }
+	YY_BREAK
+case 151:
 YY_RULE_SETUP
 #line 258 "fortran.lex"
-{return TOK_BACKSPACE;}
-	YY_BREAK
-case 132:
+{ strcpy(yylval.na,fortran_text); return TOK_NAME; }
+	YY_BREAK
+case 152:
+/* rule 152 can match eol */
+*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */
+(yy_c_buf_p) = yy_cp -= 1;
+YY_DO_BEFORE_ACTION; /* set up fortran_text again */
 YY_RULE_SETUP
 #line 259 "fortran.lex"
-{return TOK_LEFTAB;}
-	YY_BREAK
-case 133:
-YY_RULE_SETUP
-#line 260 "fortran.lex"
-{return TOK_RIGHTAB;}
-	YY_BREAK
-case 134:
-/* rule 134 can match eol */
+{  // REAL1
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+	YY_BREAK
+case 153:
 YY_RULE_SETUP
 #line 261 "fortran.lex"
-{return TOK_FORMAT;}
-	YY_BREAK
-case 135:
-YY_RULE_SETUP
-#line 262 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DOUBLEPRECISION;}
-	YY_BREAK
-case 136:
+{  // REAL2
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+	YY_BREAK
+case 154:
 YY_RULE_SETUP
 #line 263 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DOUBLECOMPLEX;}
-	YY_BREAK
-case 137:
+{ strcpy(yylval.na,fortran_text); return TOK_CSTINT; }
+	YY_BREAK
+case 155:
 YY_RULE_SETUP
 #line 264 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_SLASH;}
-	YY_BREAK
-case 138:
+{}
+	YY_BREAK
+case 156:
 YY_RULE_SETUP
 #line 265 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DSLASH;}
-	YY_BREAK
-case 139:
-/* rule 139 can match eol */
+{}
+	YY_BREAK
+case 157:
 YY_RULE_SETUP
 #line 266 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_CUT;}
-	YY_BREAK
-case 140:
+{ strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+	YY_BREAK
+case 158:
 YY_RULE_SETUP
 #line 267 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_CONSTANT;}
-	YY_BREAK
-case 141:
+{ strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+	YY_BREAK
+case 159:
 YY_RULE_SETUP
 #line 268 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_MESSAGE;}
-	YY_BREAK
-case 142:
+{ return TOK_SEMICOLON; }
+	YY_BREAK
+case 160:
 YY_RULE_SETUP
 #line 269 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_INT;}
-	YY_BREAK
-case 143:
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 161:
 YY_RULE_SETUP
 #line 270 "fortran.lex"
-{printf("debug interfacer\n");BEGIN(donottreat);}
-	YY_BREAK
-case 144:
-/* rule 144 can match eol */
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 162:
 YY_RULE_SETUP
 #line 271 "fortran.lex"
-{
-						BEGIN(INITIAL);
-                        if (infixed) BEGIN(fortran77style) ;
-                        if (infree) BEGIN(fortran90style)  ;
-                        line_num_fortran++;line_num_fortran_common++;
-                        return '\n';
-						}
-	YY_BREAK
-case 145:
-YY_RULE_SETUP
-#line 278 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NAME;}
-	YY_BREAK
-case 146:
-YY_RULE_SETUP
-#line 279 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREAL;}
-	YY_BREAK
-case 147:
-YY_RULE_SETUP
-#line 280 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREALDP;}
-	YY_BREAK
-case 148:
-YY_RULE_SETUP
-#line 281 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREALQP;}
-	YY_BREAK
-case 149:
-/* rule 149 can match eol */
-*yy_cp = (yy_hold_char); /* undo effects of setting up fortrantext */
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 163:
+YY_RULE_SETUP
+#line 272 "fortran.lex"
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 164:
+/* rule 164 can match eol */
+YY_RULE_SETUP
+#line 273 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; return '\n'; }
+	YY_BREAK
+case 165:
+*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */
 (yy_c_buf_p) = yy_cp -= 1;
-YY_DO_BEFORE_ACTION; /* set up fortrantext again */
-YY_RULE_SETUP
-#line 282 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREAL;}
-	YY_BREAK
-case 150:
-YY_RULE_SETUP
-#line 283 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTINT;}
-	YY_BREAK
-case 151:
-YY_RULE_SETUP
-#line 284 "fortran.lex"
+YY_DO_BEFORE_ACTION; /* set up fortran_text again */
+YY_RULE_SETUP
+#line 274 "fortran.lex"
 {}
 	YY_BREAK
-case 152:
-YY_RULE_SETUP
-#line 285 "fortran.lex"
-{return TOK_QUOTE;}
-	YY_BREAK
-case 153:
-YY_RULE_SETUP
-#line 286 "fortran.lex"
+case 166:
+YY_RULE_SETUP
+#line 275 "fortran.lex"
 {}
 	YY_BREAK
-case 154:
-YY_RULE_SETUP
-#line 287 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return (int) *fortrantext;}
-	YY_BREAK
-case 155:
-YY_RULE_SETUP
-#line 288 "fortran.lex"
-{afterpercent = 1; strcpy(yylval.na,fortrantext);return (int) *fortrantext;}
-	YY_BREAK
-case 156:
-YY_RULE_SETUP
-#line 289 "fortran.lex"
-{return TOK_SEMICOLON;}
-	YY_BREAK
-case 157:
-YY_RULE_SETUP
-#line 290 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 158:
-YY_RULE_SETUP
-#line 291 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 159:
-YY_RULE_SETUP
-#line 292 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 160:
-YY_RULE_SETUP
-#line 293 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 161:
-/* rule 161 can match eol */
-YY_RULE_SETUP
-#line 294 "fortran.lex"
-{colnum=0;line_num_fortran++;line_num_fortran_common++; return (int) *fortrantext;}
-	YY_BREAK
-case 162:
-*yy_cp = (yy_hold_char); /* undo effects of setting up fortrantext */
-(yy_c_buf_p) = yy_cp -= 1;
-YY_DO_BEFORE_ACTION; /* set up fortrantext again */
-YY_RULE_SETUP
-#line 295 "fortran.lex"
-
-	YY_BREAK
-case 163:
-YY_RULE_SETUP
-#line 296 "fortran.lex"
-{if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0;}
-	YY_BREAK
-case 164:
-YY_RULE_SETUP
-#line 297 "fortran.lex"
-
-	YY_BREAK
-case 165:
-YY_RULE_SETUP
-#line 298 "fortran.lex"
-{colnum=colnum-1+tabsize;}
-	YY_BREAK
-case 166:
-YY_RULE_SETUP
-#line 299 "fortran.lex"
-;
-	YY_BREAK
 case 167:
-/* rule 167 can match eol */
-YY_RULE_SETUP
-#line 300 "fortran.lex"
-{line_num_fortran++;line_num_fortran_common++;newlinef90=1;colnum=0;}
+YY_RULE_SETUP
+#line 276 "fortran.lex"
+{ if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0; }
 	YY_BREAK
 case 168:
 /* rule 168 can match eol */
 YY_RULE_SETUP
-#line 301 "fortran.lex"
-{line_num_fortran++;line_num_fortran_common++;colnum=0;}
+#line 277 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; newlinef90=1; }
 	YY_BREAK
 case 169:
 /* rule 169 can match eol */
 YY_RULE_SETUP
-#line 302 "fortran.lex"
-{
-                           convert2lower(motparse1);
-                           if ( strncasecmp(motparse1,"contains",8) == 0 )
-                           {
-                              return TOK_CONTAINS;
-                           }
-                           else
-                           {
-                            /*  colnum=0;line_num_fortran++;line_num_fortran_common++;*/
-                             if ( !strcasecmp(motparse1,"C$AGRIF_DO_NOT_TREAT\n")) 
-                             return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                             unput('\n');
-                           }
-                         }
+#line 278 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
 	YY_BREAK
 case 170:
 /* rule 170 can match eol */
 YY_RULE_SETUP
-#line 317 "fortran.lex"
-{
-                           convert2lower(&motparse1[1]);
-                           if ( strncasecmp(&motparse1[1],"contains",8) == 0 )
-                           {
-                              return TOK_CONTAINS;
-                           }
-                           else
-                           {
-                             /* colnum=0;line_num_fortran++;line_num_fortran_common++;*/
-                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_DO_NOT_TREAT\n")) 
-                             return TOK_DONOTTREAT;
-                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                             unput('\n');
-                           }
-                         }                            
+#line 280 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; BEGIN(donottreat); }
 	YY_BREAK
 case 171:
 /* rule 171 can match eol */
 YY_RULE_SETUP
-#line 332 "fortran.lex"
-{
-						BEGIN(donottreat);
-						}
+#line 281 "fortran.lex"
+{ out_of_donottreat(); return '\n'; }
 	YY_BREAK
 case 172:
 /* rule 172 can match eol */
 YY_RULE_SETUP
-#line 335 "fortran.lex"
-{
-						BEGIN(INITIAL);
-                        if (infixed) BEGIN(fortran77style) ;
-                        if (infree) BEGIN(fortran90style)  ;
-                        line_num_fortran++;line_num_fortran_common++;
-                        return '\n';
-						}
+#line 282 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
 	YY_BREAK
 case 173:
 /* rule 173 can match eol */
 YY_RULE_SETUP
-#line 342 "fortran.lex"
-{line_num_fortran++;line_num_fortran_common++;}
+#line 283 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
 	YY_BREAK
 case 174:
 /* rule 174 can match eol */
 YY_RULE_SETUP
-#line 343 "fortran.lex"
-{
-                             colnum = 0;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                          }
+#line 284 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
 	YY_BREAK
 case 175:
 YY_RULE_SETUP
-#line 348 "fortran.lex"
-{
-                             colnum = 0;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                          }
+#line 285 "fortran.lex"
+{}
 	YY_BREAK
 case 176:
 YY_RULE_SETUP
-#line 353 "fortran.lex"
+#line 286 "fortran.lex"
 ECHO;
 	YY_BREAK
-#line 4224 "fortran.yy.c"
+#line 3015 "fortran.yy.c"
 case YY_STATE_EOF(INITIAL):
 case YY_STATE_EOF(parameter):
@@ -11106,6 +9444,6 @@
 			/* We're scanning a new file or input source.  It's
 			 * possible that this happened because the user
-			 * just pointed fortranin at a new source and called
-			 * fortranlex().  If so, then we have to assure
+			 * just pointed fortran_in at a new source and called
+			 * fortran_lex().  If so, then we have to assure
 			 * consistency between YY_CURRENT_BUFFER and our
 			 * globals.  Here is the right place to do so, because
@@ -11114,5 +9452,5 @@
 			 */
 			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
-			YY_CURRENT_BUFFER_LVALUE->yy_input_file = fortranin;
+			YY_CURRENT_BUFFER_LVALUE->yy_input_file = fortran_in;
 			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
 			}
@@ -11167,9 +9505,9 @@
 				(yy_did_buffer_switch_on_eof) = 0;
 
-				if ( fortranwrap( ) )
+				if ( fortran_wrap( ) )
 					{
 					/* Note: because we've taken care in
 					 * yy_get_next_buffer() to have set up
-					 * fortrantext, we can now set up
+					 * fortran_text, we can now set up
 					 * yy_c_buf_p so that if some total
 					 * hoser (like flex itself) wants to
@@ -11220,5 +9558,5 @@
 	} /* end of action switch */
 		} /* end of scanning one token */
-} /* end of fortranlex */
+} /* end of fortran_lex */
 
 /* yy_get_next_buffer - try to read in a new buffer
@@ -11298,5 +9636,5 @@
 				b->yy_ch_buf = (char *)
 					/* Include room in for 2 EOB chars. */
-					fortranrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
+					fortran_realloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
 				}
 			else
@@ -11330,5 +9668,5 @@
 			{
 			ret_val = EOB_ACT_END_OF_FILE;
-			fortranrestart(fortranin  );
+			fortran_restart(fortran_in  );
 			}
 
@@ -11347,5 +9685,5 @@
 		/* Extend the array by 50%, plus the number we really need. */
 		yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
-		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) fortranrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
+		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) fortran_realloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
 		if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
 			YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
@@ -11382,5 +9720,5 @@
 			{
 			yy_current_state = (int) yy_def[yy_current_state];
-			if ( yy_current_state >= 1162 )
+			if ( yy_current_state >= 1132 )
 				yy_c = yy_meta[(unsigned int) yy_c];
 			}
@@ -11410,9 +9748,9 @@
 		{
 		yy_current_state = (int) yy_def[yy_current_state];
-		if ( yy_current_state >= 1162 )
+		if ( yy_current_state >= 1132 )
 			yy_c = yy_meta[(unsigned int) yy_c];
 		}
 	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
-	yy_is_jam = (yy_current_state == 1161);
+	yy_is_jam = (yy_current_state == 1131);
 
 	return yy_is_jam ? 0 : yy_current_state;
@@ -11425,5 +9763,5 @@
     yy_cp = (yy_c_buf_p);
 
-	/* undo effects of setting up fortrantext */
+	/* undo effects of setting up fortran_text */
 	*yy_cp = (yy_hold_char);
 
@@ -11497,5 +9835,5 @@
 
 					/* Reset buffer status. */
-					fortranrestart(fortranin );
+					fortran_restart(fortran_in );
 
 					/*FALLTHROUGH*/
@@ -11503,5 +9841,5 @@
 				case EOB_ACT_END_OF_FILE:
 					{
-					if ( fortranwrap( ) )
+					if ( fortran_wrap( ) )
 						return 0;
 
@@ -11523,5 +9861,5 @@
 
 	c = *(unsigned char *) (yy_c_buf_p);	/* cast for 8-bit char's */
-	*(yy_c_buf_p) = '\0';	/* preserve fortrantext */
+	*(yy_c_buf_p) = '\0';	/* preserve fortran_text */
 	(yy_hold_char) = *++(yy_c_buf_p);
 
@@ -11537,15 +9875,15 @@
  * @note This function does not reset the start condition to @c INITIAL .
  */
-    void fortranrestart  (FILE * input_file )
+    void fortran_restart  (FILE * input_file )
 {
     
 	if ( ! YY_CURRENT_BUFFER ){
-        fortranensure_buffer_stack ();
+        fortran_ensure_buffer_stack ();
 		YY_CURRENT_BUFFER_LVALUE =
-            fortran_create_buffer(fortranin,YY_BUF_SIZE );
+            fortran__create_buffer(fortran_in,YY_BUF_SIZE );
 	}
 
-	fortran_init_buffer(YY_CURRENT_BUFFER,input_file );
-	fortran_load_buffer_state( );
+	fortran__init_buffer(YY_CURRENT_BUFFER,input_file );
+	fortran__load_buffer_state( );
 }
 
@@ -11554,13 +9892,13 @@
  * 
  */
-    void fortran_switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
+    void fortran__switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
 {
     
 	/* TODO. We should be able to replace this entire function body
 	 * with
-	 *		fortranpop_buffer_state();
-	 *		fortranpush_buffer_state(new_buffer);
+	 *		fortran_pop_buffer_state();
+	 *		fortran_push_buffer_state(new_buffer);
      */
-	fortranensure_buffer_stack ();
+	fortran_ensure_buffer_stack ();
 	if ( YY_CURRENT_BUFFER == new_buffer )
 		return;
@@ -11575,9 +9913,9 @@
 
 	YY_CURRENT_BUFFER_LVALUE = new_buffer;
-	fortran_load_buffer_state( );
+	fortran__load_buffer_state( );
 
 	/* We don't actually know whether we did this switch during
-	 * EOF (fortranwrap()) processing, but the only time this flag
-	 * is looked at is after fortranwrap() is called, so it's safe
+	 * EOF (fortran_wrap()) processing, but the only time this flag
+	 * is looked at is after fortran_wrap() is called, so it's safe
 	 * to go ahead and always set it.
 	 */
@@ -11585,9 +9923,9 @@
 }
 
-static void fortran_load_buffer_state  (void)
+static void fortran__load_buffer_state  (void)
 {
     	(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
 	(yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
-	fortranin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+	fortran_in = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
 	(yy_hold_char) = *(yy_c_buf_p);
 }
@@ -11599,11 +9937,11 @@
  * @return the allocated buffer state.
  */
-    YY_BUFFER_STATE fortran_create_buffer  (FILE * file, int  size )
+    YY_BUFFER_STATE fortran__create_buffer  (FILE * file, int  size )
 {
 	YY_BUFFER_STATE b;
     
-	b = (YY_BUFFER_STATE) fortranalloc(sizeof( struct yy_buffer_state )  );
+	b = (YY_BUFFER_STATE) fortran_alloc(sizeof( struct yy_buffer_state )  );
 	if ( ! b )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_create_buffer()" );
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__create_buffer()" );
 
 	b->yy_buf_size = size;
@@ -11612,11 +9950,11 @@
 	 * we need to put in 2 end-of-buffer characters.
 	 */
-	b->yy_ch_buf = (char *) fortranalloc(b->yy_buf_size + 2  );
+	b->yy_ch_buf = (char *) fortran_alloc(b->yy_buf_size + 2  );
 	if ( ! b->yy_ch_buf )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_create_buffer()" );
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__create_buffer()" );
 
 	b->yy_is_our_buffer = 1;
 
-	fortran_init_buffer(b,file );
+	fortran__init_buffer(b,file );
 
 	return b;
@@ -11624,8 +9962,8 @@
 
 /** Destroy the buffer.
- * @param b a buffer created with fortran_create_buffer()
+ * @param b a buffer created with fortran__create_buffer()
  * 
  */
-    void fortran_delete_buffer (YY_BUFFER_STATE  b )
+    void fortran__delete_buffer (YY_BUFFER_STATE  b )
 {
     
@@ -11637,7 +9975,7 @@
 
 	if ( b->yy_is_our_buffer )
-		fortranfree((void *) b->yy_ch_buf  );
-
-	fortranfree((void *) b  );
+		fortran_free((void *) b->yy_ch_buf  );
+
+	fortran_free((void *) b  );
 }
 
@@ -11648,18 +9986,18 @@
 /* Initializes or reinitializes a buffer.
  * This function is sometimes called more than once on the same buffer,
- * such as during a fortranrestart() or at EOF.
+ * such as during a fortran_restart() or at EOF.
  */
-    static void fortran_init_buffer  (YY_BUFFER_STATE  b, FILE * file )
+    static void fortran__init_buffer  (YY_BUFFER_STATE  b, FILE * file )
 
 {
 	int oerrno = errno;
     
-	fortran_flush_buffer(b );
+	fortran__flush_buffer(b );
 
 	b->yy_input_file = file;
 	b->yy_fill_buffer = 1;
 
-    /* If b is the current buffer, then fortran_init_buffer was _probably_
-     * called from fortranrestart() or through yy_get_next_buffer.
+    /* If b is the current buffer, then fortran__init_buffer was _probably_
+     * called from fortran_restart() or through yy_get_next_buffer.
      * In that case, we don't want to reset the lineno or column.
      */
@@ -11678,5 +10016,5 @@
  * 
  */
-    void fortran_flush_buffer (YY_BUFFER_STATE  b )
+    void fortran__flush_buffer (YY_BUFFER_STATE  b )
 {
     	if ( ! b )
@@ -11698,5 +10036,5 @@
 
 	if ( b == YY_CURRENT_BUFFER )
-		fortran_load_buffer_state( );
+		fortran__load_buffer_state( );
 }
 
@@ -11707,12 +10045,12 @@
  *  
  */
-void fortranpush_buffer_state (YY_BUFFER_STATE new_buffer )
+void fortran_push_buffer_state (YY_BUFFER_STATE new_buffer )
 {
     	if (new_buffer == NULL)
 		return;
 
-	fortranensure_buffer_stack();
-
-	/* This block is copied from fortran_switch_to_buffer. */
+	fortran_ensure_buffer_stack();
+
+	/* This block is copied from fortran__switch_to_buffer. */
 	if ( YY_CURRENT_BUFFER )
 		{
@@ -11728,6 +10066,6 @@
 	YY_CURRENT_BUFFER_LVALUE = new_buffer;
 
-	/* copied from fortran_switch_to_buffer. */
-	fortran_load_buffer_state( );
+	/* copied from fortran__switch_to_buffer. */
+	fortran__load_buffer_state( );
 	(yy_did_buffer_switch_on_eof) = 1;
 }
@@ -11737,10 +10075,10 @@
  *  
  */
-void fortranpop_buffer_state (void)
+void fortran_pop_buffer_state (void)
 {
     	if (!YY_CURRENT_BUFFER)
 		return;
 
-	fortran_delete_buffer(YY_CURRENT_BUFFER );
+	fortran__delete_buffer(YY_CURRENT_BUFFER );
 	YY_CURRENT_BUFFER_LVALUE = NULL;
 	if ((yy_buffer_stack_top) > 0)
@@ -11748,5 +10086,5 @@
 
 	if (YY_CURRENT_BUFFER) {
-		fortran_load_buffer_state( );
+		fortran__load_buffer_state( );
 		(yy_did_buffer_switch_on_eof) = 1;
 	}
@@ -11756,5 +10094,5 @@
  *  Guarantees space for at least one push.
  */
-static void fortranensure_buffer_stack (void)
+static void fortran_ensure_buffer_stack (void)
 {
 	yy_size_t num_to_alloc;
@@ -11767,9 +10105,9 @@
          */
 		num_to_alloc = 1;
-		(yy_buffer_stack) = (struct yy_buffer_state**)fortranalloc
+		(yy_buffer_stack) = (struct yy_buffer_state**)fortran_alloc
 								(num_to_alloc * sizeof(struct yy_buffer_state*)
 								);
 		if ( ! (yy_buffer_stack) )
-			YY_FATAL_ERROR( "out of dynamic memory in fortranensure_buffer_stack()" );
+			YY_FATAL_ERROR( "out of dynamic memory in fortran_ensure_buffer_stack()" );
 								  
 		memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
@@ -11786,10 +10124,10 @@
 
 		num_to_alloc = (yy_buffer_stack_max) + grow_size;
-		(yy_buffer_stack) = (struct yy_buffer_state**)fortranrealloc
+		(yy_buffer_stack) = (struct yy_buffer_state**)fortran_realloc
 								((yy_buffer_stack),
 								num_to_alloc * sizeof(struct yy_buffer_state*)
 								);
 		if ( ! (yy_buffer_stack) )
-			YY_FATAL_ERROR( "out of dynamic memory in fortranensure_buffer_stack()" );
+			YY_FATAL_ERROR( "out of dynamic memory in fortran_ensure_buffer_stack()" );
 
 		/* zero only the new slots.*/
@@ -11805,5 +10143,5 @@
  * @return the newly allocated buffer state object. 
  */
-YY_BUFFER_STATE fortran_scan_buffer  (char * base, yy_size_t  size )
+YY_BUFFER_STATE fortran__scan_buffer  (char * base, yy_size_t  size )
 {
 	YY_BUFFER_STATE b;
@@ -11815,7 +10153,7 @@
 		return 0;
 
-	b = (YY_BUFFER_STATE) fortranalloc(sizeof( struct yy_buffer_state )  );
+	b = (YY_BUFFER_STATE) fortran_alloc(sizeof( struct yy_buffer_state )  );
 	if ( ! b )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_scan_buffer()" );
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__scan_buffer()" );
 
 	b->yy_buf_size = size - 2;	/* "- 2" to take care of EOB's */
@@ -11829,10 +10167,10 @@
 	b->yy_buffer_status = YY_BUFFER_NEW;
 
-	fortran_switch_to_buffer(b  );
+	fortran__switch_to_buffer(b  );
 
 	return b;
 }
 
-/** Setup the input buffer state to scan a string. The next call to fortranlex() will
+/** Setup the input buffer state to scan a string. The next call to fortran_lex() will
  * scan from a @e copy of @a str.
  * @param yystr a NUL-terminated string to scan
@@ -11840,13 +10178,13 @@
  * @return the newly allocated buffer state object.
  * @note If you want to scan bytes that may contain NUL values, then use
- *       fortran_scan_bytes() instead.
+ *       fortran__scan_bytes() instead.
  */
-YY_BUFFER_STATE fortran_scan_string (yyconst char * yystr )
+YY_BUFFER_STATE fortran__scan_string (yyconst char * yystr )
 {
     
-	return fortran_scan_bytes(yystr,strlen(yystr) );
+	return fortran__scan_bytes(yystr,strlen(yystr) );
 }
 
-/** Setup the input buffer state to scan the given bytes. The next call to fortranlex() will
+/** Setup the input buffer state to scan the given bytes. The next call to fortran_lex() will
  * scan from a @e copy of @a bytes.
  * @param bytes the byte buffer to scan
@@ -11855,5 +10193,5 @@
  * @return the newly allocated buffer state object.
  */
-YY_BUFFER_STATE fortran_scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
+YY_BUFFER_STATE fortran__scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
 {
 	YY_BUFFER_STATE b;
@@ -11863,7 +10201,7 @@
 	/* Get memory for full buffer, including space for trailing EOB's. */
 	n = _yybytes_len + 2;
-	buf = (char *) fortranalloc(n  );
+	buf = (char *) fortran_alloc(n  );
 	if ( ! buf )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_scan_bytes()" );
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__scan_bytes()" );
 
 	for ( i = 0; i < _yybytes_len; ++i )
@@ -11872,7 +10210,7 @@
 	buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
 
-	b = fortran_scan_buffer(buf,n );
+	b = fortran__scan_buffer(buf,n );
 	if ( ! b )
-		YY_FATAL_ERROR( "bad buffer in fortran_scan_bytes()" );
+		YY_FATAL_ERROR( "bad buffer in fortran__scan_bytes()" );
 
 	/* It's okay to grow etc. this buffer, and we should throw it
@@ -11900,12 +10238,12 @@
 	do \
 		{ \
-		/* Undo effects of setting up fortrantext. */ \
+		/* Undo effects of setting up fortran_text. */ \
         int yyless_macro_arg = (n); \
         YY_LESS_LINENO(yyless_macro_arg);\
-		fortrantext[fortranleng] = (yy_hold_char); \
-		(yy_c_buf_p) = fortrantext + yyless_macro_arg; \
+		fortran_text[fortran_leng] = (yy_hold_char); \
+		(yy_c_buf_p) = fortran_text + yyless_macro_arg; \
 		(yy_hold_char) = *(yy_c_buf_p); \
 		*(yy_c_buf_p) = '\0'; \
-		fortranleng = yyless_macro_arg; \
+		fortran_leng = yyless_macro_arg; \
 		} \
 	while ( 0 )
@@ -11916,8 +10254,8 @@
  * 
  */
-int fortranget_lineno  (void)
+int fortran_get_lineno  (void)
 {
         
-    return fortranlineno;
+    return fortran_lineno;
 }
 
@@ -11925,7 +10263,7 @@
  * 
  */
-FILE *fortranget_in  (void)
+FILE *fortran_get_in  (void)
 {
-        return fortranin;
+        return fortran_in;
 }
 
@@ -11933,7 +10271,7 @@
  * 
  */
-FILE *fortranget_out  (void)
+FILE *fortran_get_out  (void)
 {
-        return fortranout;
+        return fortran_out;
 }
 
@@ -11941,7 +10279,7 @@
  * 
  */
-yy_size_t fortranget_leng  (void)
+yy_size_t fortran_get_leng  (void)
 {
-        return fortranleng;
+        return fortran_leng;
 }
 
@@ -11950,7 +10288,7 @@
  */
 
-char *fortranget_text  (void)
+char *fortran_get_text  (void)
 {
-        return fortrantext;
+        return fortran_text;
 }
 
@@ -11959,8 +10297,8 @@
  * 
  */
-void fortranset_lineno (int  line_number )
+void fortran_set_lineno (int  line_number )
 {
     
-    fortranlineno = line_number;
+    fortran_lineno = line_number;
 }
 
@@ -11969,24 +10307,24 @@
  * @param in_str A readable stream.
  * 
- * @see fortran_switch_to_buffer
+ * @see fortran__switch_to_buffer
  */
-void fortranset_in (FILE *  in_str )
+void fortran_set_in (FILE *  in_str )
 {
-        fortranin = in_str ;
+        fortran_in = in_str ;
 }
 
-void fortranset_out (FILE *  out_str )
+void fortran_set_out (FILE *  out_str )
 {
-        fortranout = out_str ;
+        fortran_out = out_str ;
 }
 
-int fortranget_debug  (void)
+int fortran_get_debug  (void)
 {
-        return fortran_flex_debug;
+        return fortran__flex_debug;
 }
 
-void fortranset_debug (int  bdebug )
+void fortran_set_debug (int  bdebug )
 {
-        fortran_flex_debug = bdebug ;
+        fortran__flex_debug = bdebug ;
 }
 
@@ -11994,5 +10332,5 @@
 {
         /* Initialization is the same as for the non-reentrant scanner.
-     * This function is called from fortranlex_destroy(), so don't allocate here.
+     * This function is called from fortran_lex_destroy(), so don't allocate here.
      */
 
@@ -12006,34 +10344,34 @@
 /* Defined in main.c */
 #ifdef YY_STDINIT
-    fortranin = stdin;
-    fortranout = stdout;
+    fortran_in = stdin;
+    fortran_out = stdout;
 #else
-    fortranin = (FILE *) 0;
-    fortranout = (FILE *) 0;
+    fortran_in = (FILE *) 0;
+    fortran_out = (FILE *) 0;
 #endif
 
     /* For future reference: Set errno on error, since we are called by
-     * fortranlex_init()
+     * fortran_lex_init()
      */
     return 0;
 }
 
-/* fortranlex_destroy is for both reentrant and non-reentrant scanners. */
-int fortranlex_destroy  (void)
+/* fortran_lex_destroy is for both reentrant and non-reentrant scanners. */
+int fortran_lex_destroy  (void)
 {
     
     /* Pop the buffer stack, destroying each element. */
 	while(YY_CURRENT_BUFFER){
-		fortran_delete_buffer(YY_CURRENT_BUFFER  );
+		fortran__delete_buffer(YY_CURRENT_BUFFER  );
 		YY_CURRENT_BUFFER_LVALUE = NULL;
-		fortranpop_buffer_state();
+		fortran_pop_buffer_state();
 	}
 
 	/* Destroy the stack itself. */
-	fortranfree((yy_buffer_stack) );
+	fortran_free((yy_buffer_stack) );
 	(yy_buffer_stack) = NULL;
 
     /* Reset the globals. This is important in a non-reentrant scanner so the next time
-     * fortranlex() is called, initialization will occur. */
+     * fortran_lex() is called, initialization will occur. */
     yy_init_globals( );
 
@@ -12065,10 +10403,10 @@
 #endif
 
-void *fortranalloc (yy_size_t  size )
+void *fortran_alloc (yy_size_t  size )
 {
 	return (void *) malloc( size );
 }
 
-void *fortranrealloc  (void * ptr, yy_size_t  size )
+void *fortran_realloc  (void * ptr, yy_size_t  size )
 {
 	/* The cast to (char *) in the following accommodates both
@@ -12082,30 +10420,21 @@
 }
 
-void fortranfree (void * ptr )
+void fortran_free (void * ptr )
 {
-	free( (char *) ptr );	/* see fortranrealloc() for (char *) cast */
+	free( (char *) ptr );	/* see fortran_realloc() for (char *) cast */
 }
 
 #define YYTABLES_NAME "yytables"
 
-#line 353 "fortran.lex"
-
-
-
-fortranerror(char *s)
+#line 286 "fortran.lex"
+
+
+
+void out_of_donottreat ( void )
 {
-   if (!strcasecmp(curfile,mainfile))
-   {
-      printf("%s line %d, file %s motclef = %s\n",s,line_num_fortran,curfile,fortrantext);
-   }
-   else
-   {
-      printf("%s line %d, file %s motclef = %s curbuf = %s\n",s,line_num_fortran_common,curfile,fortrantext,curbuf);
-   }
-/*   exit(0);*/
+    BEGIN(INITIAL);
+    if (infixed) BEGIN(fortran77style) ;
+    if (infree)  BEGIN(fortran90style) ;
+    INCREMENT_LINE_NUM() ;
 }
 
-int fortranwrap()
-{
-}
-
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.lex
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.lex	(revision 6807)
+++ 	(revision )
@@ -1,370 +1,0 @@
-/******************************************************************************/
-/*                                                                            */
-/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
-/*                                                                            */
-/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
-/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
-/* This software is governed by the CeCILL-C license under French law and     */
-/* abiding by the rules of distribution of free software.  You can  use,      */
-/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
-/* license as circulated by CEA, CNRS and INRIA at the following URL          */
-/* "http://www.cecill.info".                                                  */
-/*                                                                            */
-/* As a counterpart to the access to the source code and  rights to copy,     */
-/* modify and redistribute granted by the license, users are provided only    */
-/* with a limited warranty  and the software's author,  the holder of the     */
-/* economic rights,  and the successive licensors  have only  limited         */
-/* liability.                                                                 */
-/*                                                                            */
-/* In this respect, the user's attention is drawn to the risks associated     */
-/* with loading,  using,  modifying and/or developing or reproducing the      */
-/* software by the user in light of its specific status of free software,     */
-/* that may mean  that it is complicated to manipulate,  and  that  also      */
-/* therefore means  that it is reserved for developers  and  experienced      */
-/* professionals having in-depth computer knowledge. Users are therefore      */
-/* encouraged to load and test the software's suitability as regards their    */
-/* requirements in conditions enabling the security of their systems and/or   */
-/* data to be ensured and,  more generally, to use and operate it in the      */
-/* same conditions as regards security.                                       */
-/*                                                                            */
-/* The fact that you are presently reading this means that you have had       */
-/* knowledge of the CeCILL-C license and that you accept its terms.           */
-/******************************************************************************/
-/* version 1.7                                                                */
-/******************************************************************************/
-%x parameter
-%s character
-%x donottreat
-%s fortran77style
-%s fortran90style
-%{
-#include <math.h>
-#include <stdlib.h>
-#include <string.h>
-extern FILE * yyin;
-#define MAX_INCLUDE_DEPTH 30
-#define tabsize 6
-YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
-int line_num_fortran=1;
-int line_num_fortran_common=1;
-int newlinef90 = 0;
-char *tmp;
-char tmpc;
-/******************************************************************************/
-/**************PETITS PB NON PREVUS *******************************************/
-/******************************************************************************/
-/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
-/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
-/*            de la 7eme et le debut de la ligne de commande                  */
-/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
-/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
-/******************************************************************************/
-#define YY_USER_ACTION \
-        {\
-           if (firstpass == 0) \
-           {\
-              strcat(curbuf,yytext); \
-              Save_Length(curbuf,38); \
-              strcpy(motparse,yytext);\
-              Save_Length(motparse,32); \
-              colnum = colnum + strlen(motparse);\
-              ECHO; \
-           }\
-           strcpy(motparse1,yytext);\
-/*           printf("yytext = %s\n",yytext);*/\
-        /*if ( firstpass == 1 ) 
-                      printf("yytext = %s %d\n",yytext,strlen(yytext));*/\
-        }
-%}
-AGRIFDEB "Agrif_debut"
-AGRIFFIN "Agrif_fin"
-REAL8 "real*8"[ \t]*"(a-h,o-z)"
-NOTTREAT Agrif_do_not_treat
-ENDNOTTREAT Agrif_end_do_not_treat
-
-NIMPORTEQUOI .
-SLASH "/"
-DSLASH "/"[ \t]*"/"
-NAME [a-zA-Z\_][a-zA-Z0-9\_]*
-DIGIT [0-9]+
-INT {DIGIT}
-EXPONENT e[-+]?{DIGIT}
-DEXPONENT d[-+]?{DIGIT}
-QEXPONENT q[-+]?{DIGIT}
-REAL (({DIGIT}\.[0-9]+|[0-9]*\.{DIGIT}){EXPONENT}?)|{DIGIT}\.{EXPONENT}
-REALDP (({DIGIT}\.[0-9]+|[0-9]*\.{DIGIT}){DEXPONENT}?)|{DIGIT}\.{DEXPONENT}
-REALQP (({DIGIT}\.[0-9]+|[0-9]*\.{DIGIT}){QEXPONENT}?)|{DIGIT}\.{QEXPONENT}
-ENDFUNCTION end[ \t]*function
-DOUBLEPRECISION double[ \t]*precision
-DOUBLECOMPLEX double[ \t]*complex
-
-COMMENTAIRESFORTRAN77 ^([Cc*](([ \t]*\n)|([^AaHhOo\n]{NIMPORTEQUOI}*\n)))
-COMMENTAIRESFORTRAN77_2 \n([Cc*](([ \t]*\n)|([^AaHhOo\n]{NIMPORTEQUOI}*\n)))
-COMMENTAIRESFORTRAN90 ^([ \t]*!{NIMPORTEQUOI}*\n)
-COMMENTAIRESFORTRAN90_2 (!{NIMPORTEQUOI}*)
-NEXTLINEF90 "&"{NIMPORTEQUOI}*[\n]*
-NEXTLINEF77 [\n \t]*\n[ \t]{5}("&"|"+"|"$"|"*"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"|"."|"#")
-%%
-  if (infixed) BEGIN(fortran77style) ;
-  if (infree) BEGIN(fortran90style)  ;
-
-^C${AGRIFDEB}            return TOK_DEBUT;
-^C${AGRIFFIN}            return TOK_FIN;
-^C$OMP[ \t]*{NIMPORTEQUOI}* return TOK_OMP;
-^C$[ \t]*{NIMPORTEQUOI}* return TOK_DOLLAR;
-
-{REAL8}                 {return TOK_REAL8;}
-subroutine              {return TOK_SUBROUTINE;}
-program                 {return TOK_PROGRAM;}
-allocate                {inallocate = 1; return TOK_ALLOCATE;}
-nullify			{return TOK_NULLIFY;}
-deallocate              {inallocate = 1; return TOK_DEALLOCATE;}
-result                  {return TOK_RESULT;}
-function                {return TOK_FUNCTION;}
-end[ \t]*subroutine     {strcpy(yylval.na,yytext);return TOK_ENDSUBROUTINE;}
-end[ \t]*program        {strcpy(yylval.na,yytext);return TOK_ENDPROGRAM;}
-end[ \t]*function       {strcpy(yylval.na,yytext);return TOK_ENDFUNCTION;}
-end                     {strcpy(yylval.na,yytext);return TOK_ENDUNIT;}
-include                  return TOK_INCLUDE;
-^[ \t]*use[ ]+           {
-                            strcpy(yylval.na,yytext);
-                            tmpc = input();
-                            unput(tmpc);
-                            if ( (
-                               tmpc >= 'a' && tmpc <= 'z'
-                                  ) || (
-                               tmpc >= 'A' && tmpc <= 'Z'
-                               )  )
-                               {
-                                  return TOK_USE;
-                               }
-                               else
-                               {
-                                  return TOK_NAME;
-                               }
-                         }
-rewind                  {return TOK_REWIND;}
-implicit                 return TOK_IMPLICIT;
-none                     return TOK_NONE;
-call                     return TOK_CALL;
-.true.                   return TOK_TRUE;
-.false.                  return TOK_FALSE;
-\=\>                    {return TOK_POINT_TO;}
-\*\*                    {strcpy(yylval.na,yytext);return TOK_DASTER;}
-\.[ \t]*eqv\.            {strcpy(yylval.na,yytext);return TOK_EQV;}
-\.[ \t]*eq\.            {strcpy(yylval.na,yytext);return TOK_EQ;}
-\.[ \t]*gt\.            {strcpy(yylval.na,yytext);return TOK_GT;}
-\.[ \t]*ge\.            {strcpy(yylval.na,yytext);return TOK_GE;}
-\.[ \t]*lt\.            {strcpy(yylval.na,yytext);return TOK_LT;}
-\.[ \t]*le\.            {strcpy(yylval.na,yytext);return TOK_LE;}
-\.[ \t]*neqv\.          {strcpy(yylval.na,yytext);return TOK_NEQV;}
-\.[ \t]*ne\.            {strcpy(yylval.na,yytext);return TOK_NE;}
-\.[ \t]*not\.           {strcpy(yylval.na,yytext);return TOK_NOT;}
-\.[ \t]*or\.            {strcpy(yylval.na,yytext);return TOK_OR;}
-\.[ \t]*xor\.           {strcpy(yylval.na,yytext);return TOK_XOR;}
-\.[ \t]*and\.           {strcpy(yylval.na,yytext);return TOK_AND;}
-module                  {return TOK_MODULE;}
-do[ 0-9\t]*while           {return TOK_DOWHILE;}
-end[ \t]*module          return TOK_ENDMODULE;
-end[ \t]*do              return TOK_ENDDO;
-do                      {return TOK_PLAINDO;}
-real                    {strcpy(yylval.na,yytext);return TOK_REAL;}
-integer                 {strcpy(yylval.na,yytext);return TOK_INTEGER;}
-logical                 {strcpy(yylval.na,yytext);return TOK_LOGICAL;}
-character               {strcpy(yylval.na,yytext);return TOK_CHARACTER;}
-allocatable             {return TOK_ALLOCATABLE;}
-close                    return TOK_CLOSE;
-inquire                  return TOK_INQUIRE;
-dimension               {return TOK_DIMENSION;}
-pause                    return TOK_PAUSE;
-equivalence              return TOK_EQUIVALENCE;
-stop                     return TOK_STOP;
-where                    return TOK_WHERE;
-end[ \t]*where           return TOK_ENDWHERE;
-else[ \t]*where          return TOK_ELSEWHERE;
-complex                 {return TOK_COMPLEX;}
-^[ \t]*contains         {return TOK_CONTAINS;}
-only                    {return TOK_ONLY;}
-parameter               {return TOK_PARAMETER;}
-recursive               {return TOK_RECURSIVE;}
-common                  {return TOK_COMMON;}
-^[ \t]*global[ \t]+     {return TOK_GLOBAL;}
-external                {return TOK_EXTERNAL;}
-intent                  {return TOK_INTENT;}
-pointer                 {return TOK_POINTER;}
-optional                {return TOK_OPTIONAL;}
-save                    {return TOK_SAVE;}
-^[ \t]*type[ \t\,]+       {return TOK_TYPE;}
-^[ \t]*type[ \t]*\(     {return TOK_TYPEPAR;}
-stat                    {if (inallocate == 1) return TOK_STAT; else {strcpy(yylval.na,yytext);return TOK_NAME;}}
-end[ \t]*type           {return TOK_ENDTYPE;}
-open                     return TOK_OPEN;
-return                   return TOK_RETURN;
-exit[^(]                 return TOK_EXIT;
-print                    return TOK_PRINT;
-module[ \t]*procedure   {return TOK_PROCEDURE;}
-read                    {return TOK_READ;}
-namelist                {return TOK_NAMELIST;}
-write                   {return TOK_WRITE;}
-target                  {return TOK_TARGET;}
-public                  {return TOK_PUBLIC;}
-private                 {return TOK_PRIVATE;}
-in                      {strcpy(yylval.nac,yytext);return TOK_IN;}
-^[ \t]*data[ \t]+       {strcpy(yylval.na,yytext);return TOK_DATA;}
-continue                 return TOK_CONTINUE;
-go[ \t]*to              {return TOK_PLAINGOTO;}
-out                     {strcpy(yylval.nac,yytext);return TOK_OUT;}
-inout                   {strcpy(yylval.nac,yytext);return TOK_INOUT;}
-intrinsic               {return TOK_INTRINSIC;}
-then                    {return TOK_THEN;}
-else[ \t]*if            {return TOK_ELSEIF;}
-else                    {return TOK_ELSE;}
-end[ \t]*if             {return TOK_ENDIF;}
-if[ \t]*\(              {return TOK_LOGICALIF;}
-sum[ \t]*\(             {return TOK_SUM;}
-max[ \t]*\(             {return TOK_MAX;}
-tanh                    {return TOK_TANH;}
-maxval                  {return TOK_MAXVAL;}
-trim                    {return TOK_TRIM;}
-sqrt\(                  {return TOK_SQRT;}
-select[ \t]*case        {return TOK_SELECTCASE;}
-^[ \t]*case[ \t]*\(     {return TOK_CASE;}
-^[ \t]*case[ \t]*default       {return TOK_CASEDEFAULT;}
-end[ \t]*select         {return TOK_ENDSELECT;}
-file[ \t]*\=            {return TOK_FILE;}
-end[ \t]*\=             {return TOK_END;}
-err[ \t]*\=             {return TOK_ERR;}
-exist[ \t]*\=           {return TOK_EXIST;}
-min[ \t]*\(             {return TOK_MIN;}
-nint                    {return TOK_NINT;}
-float                   {return TOK_FLOAT;}
-exp                     {return TOK_EXP;}
-cos                     {return TOK_COS;}
-cosh                    {return TOK_COSH;}
-acos                    {return TOK_ACOS;}
-sin                     {return TOK_SIN;}
-sinh                    {return TOK_SINH;}
-asin                    {return TOK_ASIN;}
-log                     {return TOK_LOG;}
-tan                     {return TOK_TAN;}
-atan                    {return TOK_ATAN;}
-cycle                   {return TOK_CYCLE;}
-abs\(                   {return TOK_ABS;}
-mod                     {return TOK_MOD;}
-sign                    {return TOK_SIGN;}
-minloc                  {return TOK_MINLOC;}
-maxloc                  {return TOK_MAXLOC;}
-minval                  {return TOK_MINVAL;}
-backspace               {return TOK_BACKSPACE;}
-\({SLASH}               {return TOK_LEFTAB;}
-{SLASH}\)               {return TOK_RIGHTAB;}
-format[ \t]*\(({NIMPORTEQUOI}|{NEXTLINEF90}|{NEXTLINEF77})*\)  {return TOK_FORMAT;}
-{DOUBLEPRECISION}       {strcpy(yylval.na,yytext);return TOK_DOUBLEPRECISION;}
-{DOUBLECOMPLEX}         {strcpy(yylval.na,yytext);return TOK_DOUBLECOMPLEX;}
-{SLASH}                 {strcpy(yylval.na,yytext);return TOK_SLASH;}
-DSLASH                  {strcpy(yylval.na,yytext);return TOK_DSLASH;}
-(\')[^']*&{0,1}\n[ \t]*&{0,1}[^']*(\')         {strcpy(yylval.na,yytext);return TOK_CHAR_CUT;}
-(\')[^\n']*(\')         {strcpy(yylval.na,yytext);return TOK_CHAR_CONSTANT;}
-(\")[^\n"]*(\")         {strcpy(yylval.na,yytext);return TOK_CHAR_MESSAGE;}
-({NAME}{REAL})          {strcpy(yylval.na,yytext);return TOK_CHAR_INT;}
-^[ \t]*interface        {printf("debug interfacer\n");BEGIN(donottreat);}
-<donottreat>^[ \t]*end[ \t]*interface[ \t]*\n {
-						BEGIN(INITIAL);
-                        if (infixed) BEGIN(fortran77style) ;
-                        if (infree) BEGIN(fortran90style)  ;
-                        line_num_fortran++;line_num_fortran_common++;
-                        return '\n';
-						}
-{NAME}                  {strcpy(yylval.na,yytext);return TOK_NAME;}
-{REAL}                  {strcpy(yylval.na,yytext);return TOK_CSTREAL;}
-{REALDP}                {strcpy(yylval.na,yytext);return TOK_CSTREALDP;}
-{REALQP}                {strcpy(yylval.na,yytext);return TOK_CSTREALQP;}
-({DIGIT}\.)/[^{NAME}|"and."|"false."|"true."|"eq."|"or."|"gt."|"ge."|"lt."|"le."|"not."|"ne."] {strcpy(yylval.na,yytext);return TOK_CSTREAL;}
-{INT}                   {strcpy(yylval.na,yytext);return TOK_CSTINT;}
-\$ {}
-\'|\"                   {return TOK_QUOTE;}
-\.                      {}
-\(|\)|:|\[|\]|\+|\-|\* {strcpy(yylval.na,yytext);return (int) *yytext;}
-\%                     {afterpercent = 1; strcpy(yylval.na,yytext);return (int) *yytext;}
-\;                      {return TOK_SEMICOLON;}
-\,                      {return (int) *yytext;}
-\=                      {return (int) *yytext;}
-\<                      {return (int) *yytext;}
-\>                      {return (int) *yytext;}
-\n                      {colnum=0;line_num_fortran++;line_num_fortran_common++; return (int) *yytext;}
-^[ ]*$
-^(((" "|[0-9]){1,5})|([ \t]{1,5}))[ &]+ {if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0;}
-[ ]+
-[\t]+                   {colnum=colnum-1+tabsize;}
-[ \t]+ ;
-{NEXTLINEF90}           {line_num_fortran++;line_num_fortran_common++;newlinef90=1;colnum=0;}
-{NEXTLINEF77}           {line_num_fortran++;line_num_fortran_common++;colnum=0;}
-<fortran77style>{COMMENTAIRESFORTRAN77} {
-                           convert2lower(motparse1);
-                           if ( strncasecmp(motparse1,"contains",8) == 0 )
-                           {
-                              return TOK_CONTAINS;
-                           }
-                           else
-                           {
-                            /*  colnum=0;line_num_fortran++;line_num_fortran_common++;*/
-                             if ( !strcasecmp(motparse1,"C$AGRIF_DO_NOT_TREAT\n")) 
-                             return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                             unput('\n');
-                           }
-                         }
-<fortran77style>{COMMENTAIRESFORTRAN77_2} {
-                           convert2lower(&motparse1[1]);
-                           if ( strncasecmp(&motparse1[1],"contains",8) == 0 )
-                           {
-                              return TOK_CONTAINS;
-                           }
-                           else
-                           {
-                             /* colnum=0;line_num_fortran++;line_num_fortran_common++;*/
-                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_DO_NOT_TREAT\n")) 
-                             return TOK_DONOTTREAT;
-                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                             unput('\n');
-                           }
-                         }                            
-^"!$AGRIF_DO_NOT_TREAT"[ \t]*\n {
-						BEGIN(donottreat);
-						}
-<donottreat>^"!$AGRIF_END_DO_NOT_TREAT"[ \t]*\n {
-						BEGIN(INITIAL);
-                        if (infixed) BEGIN(fortran77style) ;
-                        if (infree) BEGIN(fortran90style)  ;
-                        line_num_fortran++;line_num_fortran_common++;
-                        return '\n';
-						}
-<donottreat>.*\n        {line_num_fortran++;line_num_fortran_common++;}
-{COMMENTAIRESFORTRAN90}   {
-                             colnum = 0;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                          }
-{COMMENTAIRESFORTRAN90_2} {
-                             colnum = 0;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                          }
-%%
-
-fortranerror(char *s)
-{
-   if (!strcasecmp(curfile,mainfile))
-   {
-      printf("%s line %d, file %s motclef = %s\n",s,line_num_fortran,curfile,yytext);
-   }
-   else
-   {
-      printf("%s line %d, file %s motclef = %s curbuf = %s\n",s,line_num_fortran_common,curfile,yytext,curbuf);
-   }
-/*   exit(0);*/
-}
-
-int fortranwrap()
-{
-}
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.tab.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.tab.c	(revision 6807)
+++ 	(revision )
@@ -1,6863 +1,0 @@
-/* A Bison parser, made by GNU Bison 2.3.  */
-
-/* Skeleton implementation for Bison's Yacc-like parsers in C
-
-   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
-   Free Software Foundation, Inc.
-
-   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, 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., 51 Franklin Street, Fifth Floor,
-   Boston, MA 02110-1301, USA.  */
-
-/* As a special exception, you may create a larger work that contains
-   part or all of the Bison parser skeleton and distribute that work
-   under terms of your choice, so long as that work isn't itself a
-   parser generator using the skeleton or a modified version thereof
-   as a parser skeleton.  Alternatively, if you modify or redistribute
-   the parser skeleton itself, you may (at your option) remove this
-   special exception, which will cause the skeleton and the resulting
-   Bison output files to be licensed under the GNU General Public
-   License without this special exception.
-
-   This special exception was added by the Free Software Foundation in
-   version 2.2 of Bison.  */
-
-/* C LALR(1) parser skeleton written by Richard Stallman, by
-   simplifying the original so-called "semantic" parser.  */
-
-/* All symbols defined below should begin with yy or YY, to avoid
-   infringing on user name space.  This should be done even for local
-   variables, as they might otherwise be expanded by user macros.
-   There are some unavoidable exceptions within include files to
-   define necessary library symbols; they are noted "INFRINGES ON
-   USER NAME SPACE" below.  */
-
-/* Identify Bison output.  */
-#define YYBISON 1
-
-/* Bison version.  */
-#define YYBISON_VERSION "2.3"
-
-/* Skeleton name.  */
-#define YYSKELETON_NAME "yacc.c"
-
-/* Pure parsers.  */
-#define YYPURE 0
-
-/* Using locations.  */
-#define YYLSP_NEEDED 0
-
-/* Substitute the variable and function names.  */
-#define yyparse fortranparse
-#define yylex   fortranlex
-#define yyerror fortranerror
-#define yylval  fortranlval
-#define yychar  fortranchar
-#define yydebug fortrandebug
-#define yynerrs fortrannerrs
-
-
-/* Tokens.  */
-#ifndef YYTOKENTYPE
-# define YYTOKENTYPE
-   /* Put the tokens into the symbol table, so that GDB and other debuggers
-      know about them.  */
-   enum yytokentype {
-     TOK_BINARY_OP = 258,
-     TOK_NEQV = 259,
-     TOK_EQV = 260,
-     TOK_XOR = 261,
-     TOK_OR = 262,
-     TOK_AND = 263,
-     TOK_NOT = 264,
-     TOK_NE = 265,
-     TOK_EQ = 266,
-     TOK_GE = 267,
-     TOK_LE = 268,
-     TOK_GT = 269,
-     TOK_LT = 270,
-     TOK_UNARY_OP = 271,
-     TOK_DSLASH = 272,
-     TOK_SLASH = 273,
-     TOK_DASTER = 274,
-     TOK_SEP = 275,
-     TOK_SEMICOLON = 276,
-     TOK_NEXTLINE = 277,
-     TOK_PARAMETER = 278,
-     TOK_RESULT = 279,
-     TOK_ONLY = 280,
-     TOK_INCLUDE = 281,
-     TOK_SUBROUTINE = 282,
-     TOK_PROGRAM = 283,
-     TOK_FUNCTION = 284,
-     TOK_OMP = 285,
-     TOK_DOLLAR = 286,
-     TOK_FORMAT = 287,
-     TOK_MAX = 288,
-     TOK_TANH = 289,
-     TOK_WHERE = 290,
-     TOK_ELSEWHERE = 291,
-     TOK_ENDWHERE = 292,
-     TOK_MAXVAL = 293,
-     TOK_TRIM = 294,
-     TOK_SUM = 295,
-     TOK_SQRT = 296,
-     TOK_CASE = 297,
-     TOK_SELECTCASE = 298,
-     TOK_FILE = 299,
-     TOK_END = 300,
-     TOK_ERR = 301,
-     TOK_DONOTTREAT = 302,
-     TOK_ENDDONOTTREAT = 303,
-     TOK_EXIST = 304,
-     TOK_MIN = 305,
-     TOK_FLOAT = 306,
-     TOK_EXP = 307,
-     TOK_COS = 308,
-     TOK_COSH = 309,
-     TOK_ACOS = 310,
-     TOK_NINT = 311,
-     TOK_CYCLE = 312,
-     TOK_SIN = 313,
-     TOK_SINH = 314,
-     TOK_ASIN = 315,
-     TOK_EQUIVALENCE = 316,
-     TOK_BACKSPACE = 317,
-     TOK_LOG = 318,
-     TOK_TAN = 319,
-     TOK_ATAN = 320,
-     TOK_RECURSIVE = 321,
-     TOK_ABS = 322,
-     TOK_MOD = 323,
-     TOK_SIGN = 324,
-     TOK_MINLOC = 325,
-     TOK_MAXLOC = 326,
-     TOK_EXIT = 327,
-     TOK_MINVAL = 328,
-     TOK_PUBLIC = 329,
-     TOK_PRIVATE = 330,
-     TOK_ALLOCATABLE = 331,
-     TOK_RETURN = 332,
-     TOK_THEN = 333,
-     TOK_ELSEIF = 334,
-     TOK_ELSE = 335,
-     TOK_ENDIF = 336,
-     TOK_PRINT = 337,
-     TOK_PLAINGOTO = 338,
-     TOK_CONSTRUCTID = 339,
-     TOK_LOGICALIF = 340,
-     TOK_PLAINDO = 341,
-     TOK_CONTAINS = 342,
-     TOK_ENDDO = 343,
-     TOK_MODULE = 344,
-     TOK_ENDMODULE = 345,
-     TOK_DOWHILE = 346,
-     TOK_ALLOCATE = 347,
-     TOK_OPEN = 348,
-     TOK_CLOSE = 349,
-     TOK_INQUIRE = 350,
-     TOK_WRITE = 351,
-     TOK_READ = 352,
-     TOK_REWIND = 353,
-     TOK_DEALLOCATE = 354,
-     TOK_NULLIFY = 355,
-     TOK_FIN = 356,
-     TOK_DEBUT = 357,
-     TOK_DIMENSION = 358,
-     TOK_ENDSELECT = 359,
-     TOK_EXTERNAL = 360,
-     TOK_INTENT = 361,
-     TOK_INTRINSIC = 362,
-     TOK_NAMELIST = 363,
-     TOK_CASEDEFAULT = 364,
-     TOK_OPTIONAL = 365,
-     TOK_POINTER = 366,
-     TOK_CONTINUE = 367,
-     TOK_SAVE = 368,
-     TOK_TARGET = 369,
-     TOK_QUOTE = 370,
-     TOK_IMPLICIT = 371,
-     TOK_NONE = 372,
-     TOK_CALL = 373,
-     TOK_STAT = 374,
-     TOK_POINT_TO = 375,
-     TOK_COMMON = 376,
-     TOK_GLOBAL = 377,
-     TOK_INTERFACE = 378,
-     TOK_ENDINTERFACE = 379,
-     TOK_LEFTAB = 380,
-     TOK_RIGHTAB = 381,
-     TOK_PAUSE = 382,
-     TOK_PROCEDURE = 383,
-     TOK_STOP = 384,
-     TOK_NAMEEQ = 385,
-     TOK_REAL8 = 386,
-     TOK_OUT = 387,
-     TOK_INOUT = 388,
-     TOK_IN = 389,
-     TOK_USE = 390,
-     TOK_TRUE = 391,
-     TOK_FALSE = 392,
-     TOK_LABEL = 393,
-     TOK_TYPE = 394,
-     TOK_TYPEPAR = 395,
-     TOK_ENDTYPE = 396,
-     TOK_REAL = 397,
-     TOK_INTEGER = 398,
-     TOK_LOGICAL = 399,
-     TOK_DOUBLEPRECISION = 400,
-     TOK_DOUBLEREAL = 401,
-     TOK_ENDSUBROUTINE = 402,
-     TOK_ENDFUNCTION = 403,
-     TOK_ENDPROGRAM = 404,
-     TOK_ENDUNIT = 405,
-     TOK_CHARACTER = 406,
-     TOK_CHAR_CONSTANT = 407,
-     TOK_CHAR_CUT = 408,
-     TOK_DATA = 409,
-     TOK_CHAR_INT = 410,
-     TOK_CHAR_MESSAGE = 411,
-     TOK_CSTREAL = 412,
-     TOK_CSTREALDP = 413,
-     TOK_CSTREALQP = 414,
-     TOK_SFREAL = 415,
-     TOK_COMPLEX = 416,
-     TOK_DOUBLECOMPLEX = 417,
-     TOK_NAME = 418,
-     TOK_NAME_CHAR = 419,
-     TOK_PROBTYPE = 420,
-     TOK_INTERPTYPE = 421,
-     TOK_VARTYPE = 422,
-     TOK_BC = 423,
-     TOK_OP = 424,
-     TOK_CSTINT = 425,
-     TOK_COMMENT = 426,
-     TOK_FILENAME = 427
-   };
-#endif
-/* Tokens.  */
-#define TOK_BINARY_OP 258
-#define TOK_NEQV 259
-#define TOK_EQV 260
-#define TOK_XOR 261
-#define TOK_OR 262
-#define TOK_AND 263
-#define TOK_NOT 264
-#define TOK_NE 265
-#define TOK_EQ 266
-#define TOK_GE 267
-#define TOK_LE 268
-#define TOK_GT 269
-#define TOK_LT 270
-#define TOK_UNARY_OP 271
-#define TOK_DSLASH 272
-#define TOK_SLASH 273
-#define TOK_DASTER 274
-#define TOK_SEP 275
-#define TOK_SEMICOLON 276
-#define TOK_NEXTLINE 277
-#define TOK_PARAMETER 278
-#define TOK_RESULT 279
-#define TOK_ONLY 280
-#define TOK_INCLUDE 281
-#define TOK_SUBROUTINE 282
-#define TOK_PROGRAM 283
-#define TOK_FUNCTION 284
-#define TOK_OMP 285
-#define TOK_DOLLAR 286
-#define TOK_FORMAT 287
-#define TOK_MAX 288
-#define TOK_TANH 289
-#define TOK_WHERE 290
-#define TOK_ELSEWHERE 291
-#define TOK_ENDWHERE 292
-#define TOK_MAXVAL 293
-#define TOK_TRIM 294
-#define TOK_SUM 295
-#define TOK_SQRT 296
-#define TOK_CASE 297
-#define TOK_SELECTCASE 298
-#define TOK_FILE 299
-#define TOK_END 300
-#define TOK_ERR 301
-#define TOK_DONOTTREAT 302
-#define TOK_ENDDONOTTREAT 303
-#define TOK_EXIST 304
-#define TOK_MIN 305
-#define TOK_FLOAT 306
-#define TOK_EXP 307
-#define TOK_COS 308
-#define TOK_COSH 309
-#define TOK_ACOS 310
-#define TOK_NINT 311
-#define TOK_CYCLE 312
-#define TOK_SIN 313
-#define TOK_SINH 314
-#define TOK_ASIN 315
-#define TOK_EQUIVALENCE 316
-#define TOK_BACKSPACE 317
-#define TOK_LOG 318
-#define TOK_TAN 319
-#define TOK_ATAN 320
-#define TOK_RECURSIVE 321
-#define TOK_ABS 322
-#define TOK_MOD 323
-#define TOK_SIGN 324
-#define TOK_MINLOC 325
-#define TOK_MAXLOC 326
-#define TOK_EXIT 327
-#define TOK_MINVAL 328
-#define TOK_PUBLIC 329
-#define TOK_PRIVATE 330
-#define TOK_ALLOCATABLE 331
-#define TOK_RETURN 332
-#define TOK_THEN 333
-#define TOK_ELSEIF 334
-#define TOK_ELSE 335
-#define TOK_ENDIF 336
-#define TOK_PRINT 337
-#define TOK_PLAINGOTO 338
-#define TOK_CONSTRUCTID 339
-#define TOK_LOGICALIF 340
-#define TOK_PLAINDO 341
-#define TOK_CONTAINS 342
-#define TOK_ENDDO 343
-#define TOK_MODULE 344
-#define TOK_ENDMODULE 345
-#define TOK_DOWHILE 346
-#define TOK_ALLOCATE 347
-#define TOK_OPEN 348
-#define TOK_CLOSE 349
-#define TOK_INQUIRE 350
-#define TOK_WRITE 351
-#define TOK_READ 352
-#define TOK_REWIND 353
-#define TOK_DEALLOCATE 354
-#define TOK_NULLIFY 355
-#define TOK_FIN 356
-#define TOK_DEBUT 357
-#define TOK_DIMENSION 358
-#define TOK_ENDSELECT 359
-#define TOK_EXTERNAL 360
-#define TOK_INTENT 361
-#define TOK_INTRINSIC 362
-#define TOK_NAMELIST 363
-#define TOK_CASEDEFAULT 364
-#define TOK_OPTIONAL 365
-#define TOK_POINTER 366
-#define TOK_CONTINUE 367
-#define TOK_SAVE 368
-#define TOK_TARGET 369
-#define TOK_QUOTE 370
-#define TOK_IMPLICIT 371
-#define TOK_NONE 372
-#define TOK_CALL 373
-#define TOK_STAT 374
-#define TOK_POINT_TO 375
-#define TOK_COMMON 376
-#define TOK_GLOBAL 377
-#define TOK_INTERFACE 378
-#define TOK_ENDINTERFACE 379
-#define TOK_LEFTAB 380
-#define TOK_RIGHTAB 381
-#define TOK_PAUSE 382
-#define TOK_PROCEDURE 383
-#define TOK_STOP 384
-#define TOK_NAMEEQ 385
-#define TOK_REAL8 386
-#define TOK_OUT 387
-#define TOK_INOUT 388
-#define TOK_IN 389
-#define TOK_USE 390
-#define TOK_TRUE 391
-#define TOK_FALSE 392
-#define TOK_LABEL 393
-#define TOK_TYPE 394
-#define TOK_TYPEPAR 395
-#define TOK_ENDTYPE 396
-#define TOK_REAL 397
-#define TOK_INTEGER 398
-#define TOK_LOGICAL 399
-#define TOK_DOUBLEPRECISION 400
-#define TOK_DOUBLEREAL 401
-#define TOK_ENDSUBROUTINE 402
-#define TOK_ENDFUNCTION 403
-#define TOK_ENDPROGRAM 404
-#define TOK_ENDUNIT 405
-#define TOK_CHARACTER 406
-#define TOK_CHAR_CONSTANT 407
-#define TOK_CHAR_CUT 408
-#define TOK_DATA 409
-#define TOK_CHAR_INT 410
-#define TOK_CHAR_MESSAGE 411
-#define TOK_CSTREAL 412
-#define TOK_CSTREALDP 413
-#define TOK_CSTREALQP 414
-#define TOK_SFREAL 415
-#define TOK_COMPLEX 416
-#define TOK_DOUBLECOMPLEX 417
-#define TOK_NAME 418
-#define TOK_NAME_CHAR 419
-#define TOK_PROBTYPE 420
-#define TOK_INTERPTYPE 421
-#define TOK_VARTYPE 422
-#define TOK_BC 423
-#define TOK_OP 424
-#define TOK_CSTINT 425
-#define TOK_COMMENT 426
-#define TOK_FILENAME 427
-
-
-
-
-/* Copy the first part of user declarations.  */
-#line 36 "fortran.y"
-
-#define YYMAXDEPTH 1000
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include "decl.h"
-extern int line_num_fortran;
-extern int line_num_fortran_common;
-char *tmp;
-char c_selectorname[LONG_C];
-char ligne[LONG_C];
-char truename[LONGNOM];
-char identcopy[LONG_C];
-int c_selectorgiven=0;
-int incom;
-listvar *curlistvar;
-typedim c_selectordim;
-listcouple *coupletmp;
-listdim *parcoursdim;
-int removeline=0;
-listvar *test;
-
-
-/* Enabling traces.  */
-#ifndef YYDEBUG
-# define YYDEBUG 0
-#endif
-
-/* Enabling verbose error messages.  */
-#ifdef YYERROR_VERBOSE
-# undef YYERROR_VERBOSE
-# define YYERROR_VERBOSE 1
-#else
-# define YYERROR_VERBOSE 0
-#endif
-
-/* Enabling the token table.  */
-#ifndef YYTOKEN_TABLE
-# define YYTOKEN_TABLE 0
-#endif
-
-#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
-typedef union YYSTYPE
-#line 59 "fortran.y"
-{
-       char      nac[LONG_C];
-       char      na[LONGNOM];
-       listdim  *d;
-       listvar  *l;
-       listnom  *ln;
-       listcouple  *lc;
-       listname *lnn;
-       typedim   dim1;
-       variable *v;
-       }
-/* Line 193 of yacc.c.  */
-#line 483 "fortran.tab.c"
-	YYSTYPE;
-# define yystype YYSTYPE /* obsolescent; will be withdrawn */
-# define YYSTYPE_IS_DECLARED 1
-# define YYSTYPE_IS_TRIVIAL 1
-#endif
-
-
-
-/* Copy the second part of user declarations.  */
-
-
-/* Line 216 of yacc.c.  */
-#line 496 "fortran.tab.c"
-
-#ifdef short
-# undef short
-#endif
-
-#ifdef YYTYPE_UINT8
-typedef YYTYPE_UINT8 yytype_uint8;
-#else
-typedef unsigned char yytype_uint8;
-#endif
-
-#ifdef YYTYPE_INT8
-typedef YYTYPE_INT8 yytype_int8;
-#elif (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-typedef signed char yytype_int8;
-#else
-typedef short int yytype_int8;
-#endif
-
-#ifdef YYTYPE_UINT16
-typedef YYTYPE_UINT16 yytype_uint16;
-#else
-typedef unsigned short int yytype_uint16;
-#endif
-
-#ifdef YYTYPE_INT16
-typedef YYTYPE_INT16 yytype_int16;
-#else
-typedef short int yytype_int16;
-#endif
-
-#ifndef YYSIZE_T
-# ifdef __SIZE_TYPE__
-#  define YYSIZE_T __SIZE_TYPE__
-# elif defined size_t
-#  define YYSIZE_T size_t
-# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
-#  define YYSIZE_T size_t
-# else
-#  define YYSIZE_T unsigned int
-# endif
-#endif
-
-#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
-
-#ifndef YY_
-# if defined YYENABLE_NLS && YYENABLE_NLS
-#  if ENABLE_NLS
-#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
-#   define YY_(msgid) dgettext ("bison-runtime", msgid)
-#  endif
-# endif
-# ifndef YY_
-#  define YY_(msgid) msgid
-# endif
-#endif
-
-/* Suppress unused-variable warnings by "using" E.  */
-#if ! defined lint || defined __GNUC__
-# define YYUSE(e) ((void) (e))
-#else
-# define YYUSE(e) /* empty */
-#endif
-
-/* Identity function, used to suppress warnings about constant conditions.  */
-#ifndef lint
-# define YYID(n) (n)
-#else
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static int
-YYID (int i)
-#else
-static int
-YYID (i)
-    int i;
-#endif
-{
-  return i;
-}
-#endif
-
-#if ! defined yyoverflow || YYERROR_VERBOSE
-
-/* The parser invokes alloca or malloc; define the necessary symbols.  */
-
-# ifdef YYSTACK_USE_ALLOCA
-#  if YYSTACK_USE_ALLOCA
-#   ifdef __GNUC__
-#    define YYSTACK_ALLOC __builtin_alloca
-#   elif defined __BUILTIN_VA_ARG_INCR
-#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
-#   elif defined _AIX
-#    define YYSTACK_ALLOC __alloca
-#   elif defined _MSC_VER
-#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
-#    define alloca _alloca
-#   else
-#    define YYSTACK_ALLOC alloca
-#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-#     ifndef _STDLIB_H
-#      define _STDLIB_H 1
-#     endif
-#    endif
-#   endif
-#  endif
-# endif
-
-# ifdef YYSTACK_ALLOC
-   /* Pacify GCC's `empty if-body' warning.  */
-#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
-#  ifndef YYSTACK_ALLOC_MAXIMUM
-    /* The OS might guarantee only one guard page at the bottom of the stack,
-       and a page size can be as small as 4096 bytes.  So we cannot safely
-       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
-       to allow for a few compiler-allocated temporary stack slots.  */
-#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
-#  endif
-# else
-#  define YYSTACK_ALLOC YYMALLOC
-#  define YYSTACK_FREE YYFREE
-#  ifndef YYSTACK_ALLOC_MAXIMUM
-#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
-#  endif
-#  if (defined __cplusplus && ! defined _STDLIB_H \
-       && ! ((defined YYMALLOC || defined malloc) \
-	     && (defined YYFREE || defined free)))
-#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-#   ifndef _STDLIB_H
-#    define _STDLIB_H 1
-#   endif
-#  endif
-#  ifndef YYMALLOC
-#   define YYMALLOC malloc
-#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
-#   endif
-#  endif
-#  ifndef YYFREE
-#   define YYFREE free
-#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-void free (void *); /* INFRINGES ON USER NAME SPACE */
-#   endif
-#  endif
-# endif
-#endif /* ! defined yyoverflow || YYERROR_VERBOSE */
-
-
-#if (! defined yyoverflow \
-     && (! defined __cplusplus \
-	 || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
-
-/* A type that is properly aligned for any stack member.  */
-union yyalloc
-{
-  yytype_int16 yyss;
-  YYSTYPE yyvs;
-  };
-
-/* The size of the maximum gap between one aligned stack and the next.  */
-# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
-
-/* The size of an array large to enough to hold all stacks, each with
-   N elements.  */
-# define YYSTACK_BYTES(N) \
-     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \
-      + YYSTACK_GAP_MAXIMUM)
-
-/* Copy COUNT objects from FROM to TO.  The source and destination do
-   not overlap.  */
-# ifndef YYCOPY
-#  if defined __GNUC__ && 1 < __GNUC__
-#   define YYCOPY(To, From, Count) \
-      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
-#  else
-#   define YYCOPY(To, From, Count)		\
-      do					\
-	{					\
-	  YYSIZE_T yyi;				\
-	  for (yyi = 0; yyi < (Count); yyi++)	\
-	    (To)[yyi] = (From)[yyi];		\
-	}					\
-      while (YYID (0))
-#  endif
-# endif
-
-/* Relocate STACK from its old location to the new one.  The
-   local variables YYSIZE and YYSTACKSIZE give the old and new number of
-   elements in the stack, and YYPTR gives the new location of the
-   stack.  Advance YYPTR to a properly aligned location for the next
-   stack.  */
-# define YYSTACK_RELOCATE(Stack)					\
-    do									\
-      {									\
-	YYSIZE_T yynewbytes;						\
-	YYCOPY (&yyptr->Stack, Stack, yysize);				\
-	Stack = &yyptr->Stack;						\
-	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
-	yyptr += yynewbytes / sizeof (*yyptr);				\
-      }									\
-    while (YYID (0))
-
-#endif
-
-/* YYFINAL -- State number of the termination state.  */
-#define YYFINAL  2
-/* YYLAST -- Last index in YYTABLE.  */
-#define YYLAST   6070
-
-/* YYNTOKENS -- Number of terminals.  */
-#define YYNTOKENS  190
-/* YYNNTS -- Number of nonterminals.  */
-#define YYNNTS  184
-/* YYNRULES -- Number of rules.  */
-#define YYNRULES  555
-/* YYNRULES -- Number of states.  */
-#define YYNSTATES  982
-
-/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
-#define YYUNDEFTOK  2
-#define YYMAXUTOK   427
-
-#define YYTRANSLATE(YYX)						\
-  ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
-
-/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.  */
-static const yytype_uint8 yytranslate[] =
-{
-       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-     187,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,   183,     2,     2,     2,   189,     2,     2,
-     179,   180,    23,    21,     3,    22,     2,   188,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     4,     2,
-     185,     5,   186,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,   181,     2,   182,     2,   184,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     1,     2,     6,     7,
-       8,     9,    10,    11,    12,    13,    14,    15,    16,    17,
-      18,    19,    20,    24,    25,    26,    27,    28,    29,    30,
-      31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
-      41,    42,    43,    44,    45,    46,    47,    48,    49,    50,
-      51,    52,    53,    54,    55,    56,    57,    58,    59,    60,
-      61,    62,    63,    64,    65,    66,    67,    68,    69,    70,
-      71,    72,    73,    74,    75,    76,    77,    78,    79,    80,
-      81,    82,    83,    84,    85,    86,    87,    88,    89,    90,
-      91,    92,    93,    94,    95,    96,    97,    98,    99,   100,
-     101,   102,   103,   104,   105,   106,   107,   108,   109,   110,
-     111,   112,   113,   114,   115,   116,   117,   118,   119,   120,
-     121,   122,   123,   124,   125,   126,   127,   128,   129,   130,
-     131,   132,   133,   134,   135,   136,   137,   138,   139,   140,
-     141,   142,   143,   144,   145,   146,   147,   148,   149,   150,
-     151,   152,   153,   154,   155,   156,   157,   158,   159,   160,
-     161,   162,   163,   164,   165,   166,   167,   168,   169,   170,
-     171,   172,   173,   174,   175,   176,   177,   178
-};
-
-#if YYDEBUG
-/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
-   YYRHS.  */
-static const yytype_uint16 yyprhs[] =
-{
-       0,     0,     3,     4,     7,    10,    13,    15,    19,    23,
-      25,    29,    32,    35,    39,    43,    46,    49,    52,    54,
-      56,    58,    60,    61,    62,    65,    66,    68,    69,    70,
-      72,    73,    78,    81,    88,    93,    96,    98,    99,   101,
-     103,   104,   107,   111,   112,   115,   119,   121,   125,   127,
-     129,   132,   137,   140,   143,   148,   151,   153,   155,   157,
-     159,   161,   163,   165,   167,   169,   171,   176,   180,   184,
-     187,   191,   192,   194,   196,   198,   200,   202,   204,   206,
-     208,   210,   212,   214,   216,   218,   220,   222,   224,   226,
-     228,   230,   232,   234,   236,   238,   240,   242,   244,   248,
-     252,   258,   260,   264,   268,   271,   276,   278,   282,   283,
-     286,   289,   293,   295,   297,   299,   304,   311,   316,   318,
-     322,   325,   329,   335,   339,   341,   342,   345,   347,   352,
-     356,   359,   363,   367,   371,   375,   376,   378,   381,   384,
-     388,   394,   398,   399,   402,   405,   407,   413,   419,   422,
-     426,   429,   433,   435,   439,   442,   446,   452,   454,   457,
-     459,   463,   466,   468,   472,   473,   475,   477,   481,   485,
-     488,   490,   494,   497,   500,   501,   508,   516,   517,   520,
-     523,   527,   531,   533,   534,   537,   542,   546,   550,   555,
-     558,   560,   562,   564,   566,   568,   570,   572,   574,   575,
-     578,   580,   584,   585,   588,   592,   594,   598,   601,   605,
-     607,   609,   611,   613,   614,   618,   619,   622,   627,   629,
-     633,   635,   637,   639,   642,   644,   649,   651,   653,   655,
-     657,   659,   661,   663,   665,   667,   669,   670,   674,   676,
-     680,   682,   684,   687,   690,   694,   696,   698,   700,   704,
-     706,   708,   712,   716,   721,   726,   730,   735,   740,   744,
-     749,   754,   759,   764,   769,   774,   779,   784,   789,   794,
-     799,   804,   809,   813,   818,   823,   828,   833,   835,   839,
-     841,   843,   845,   848,   851,   854,   856,   858,   861,   864,
-     867,   870,   873,   876,   879,   882,   885,   888,   891,   895,
-     898,   902,   905,   908,   911,   914,   917,   920,   923,   924,
-     926,   929,   932,   935,   937,   939,   941,   943,   944,   946,
-     949,   954,   960,   965,   969,   973,   975,   978,   980,   984,
-     986,   988,   992,   998,  1003,  1007,  1010,  1013,  1015,  1017,
-    1019,  1021,  1023,  1025,  1027,  1029,  1032,  1035,  1037,  1040,
-    1042,  1044,  1045,  1047,  1053,  1054,  1056,  1058,  1060,  1061,
-    1065,  1069,  1070,  1076,  1079,  1084,  1091,  1098,  1100,  1102,
-    1104,  1108,  1112,  1114,  1118,  1122,  1124,  1126,  1132,  1138,
-    1143,  1145,  1148,  1151,  1154,  1157,  1159,  1162,  1168,  1170,
-    1172,  1175,  1181,  1183,  1186,  1190,  1195,  1197,  1199,  1201,
-    1203,  1205,  1207,  1209,  1211,  1215,  1219,  1223,  1226,  1229,
-    1230,  1236,  1244,  1245,  1248,  1250,  1252,  1253,  1255,  1257,
-    1259,  1261,  1264,  1266,  1268,  1270,  1276,  1282,  1285,  1288,
-    1291,  1294,  1296,  1297,  1302,  1309,  1311,  1315,  1318,  1321,
-    1324,  1325,  1329,  1330,  1332,  1335,  1337,  1339,  1343,  1345,
-    1348,  1350,  1352,  1355,  1358,  1361,  1365,  1368,  1370,  1371,
-    1373,  1376,  1379,  1380,  1383,  1387,  1391,  1395,  1399,  1401,
-    1405,  1407,  1409,  1413,  1415,  1417,  1419,  1423,  1426,  1431,
-    1436,  1439,  1442,  1444,  1446,  1448,  1450,  1452,  1454,  1456,
-    1458,  1460,  1464,  1466,  1468,  1472,  1476,  1480,  1484,  1487,
-    1491,  1494,  1497,  1500,  1503,  1507,  1509,  1511,  1513,  1515,
-    1519,  1520,  1522,  1525,  1530,  1533,  1536,  1542,  1543,  1545,
-    1548,  1550,  1552,  1554,  1558,  1562,  1566,  1570,  1574,  1578,
-    1580,  1582,  1584,  1588,  1594,  1600,  1606,  1612,  1620,  1622,
-    1631,  1634,  1636,  1638,  1642,  1644,  1646,  1648,  1653,  1655,
-    1659,  1660,  1665,  1667,  1671,  1675
-};
-
-/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
-static const yytype_int16 yyrhs[] =
-{
-     191,     0,    -1,    -1,   191,   192,    -1,   187,   198,    -1,
-     199,   193,    -1,   177,    -1,   197,   200,   205,    -1,     1,
-     205,   201,    -1,   194,    -1,   193,    27,   194,    -1,   203,
-     196,    -1,   212,   196,    -1,   206,   207,   196,    -1,   315,
-     200,   205,    -1,   195,   196,    -1,   298,     4,    -1,   198,
-     200,    -1,    53,    -1,    54,    -1,    36,    -1,    37,    -1,
-      -1,    -1,   144,   201,    -1,    -1,   177,    -1,    -1,    -1,
-      72,    -1,    -1,   202,    33,   204,   208,    -1,    34,   204,
-      -1,   202,    35,   204,   208,    30,   209,    -1,   202,    35,
-     204,   208,    -1,    95,   169,    -1,   169,    -1,    -1,    32,
-      -1,   158,    -1,    -1,   179,   180,    -1,   179,   210,   180,
-      -1,    -1,   179,   180,    -1,   179,   210,   180,    -1,   211,
-      -1,   210,     3,   211,    -1,   169,    -1,    23,    -1,   257,
-     222,    -1,   145,   213,   221,   324,    -1,   147,   324,    -1,
-     117,   216,    -1,   224,   179,   249,   180,    -1,   224,   249,
-      -1,   243,    -1,   228,    -1,   253,    -1,   239,    -1,   241,
-      -1,   240,    -1,   308,    -1,   251,    -1,   237,    -1,   234,
-      -1,    68,   179,   280,   180,    -1,   111,   221,   242,    -1,
-     113,   221,   215,    -1,    67,   217,    -1,   225,   226,   187,
-      -1,    -1,   275,    -1,    46,    -1,    40,    -1,    44,    -1,
-      56,    -1,    79,    -1,    45,    -1,    47,    -1,    62,    -1,
-      57,    -1,    58,    -1,    59,    -1,    60,    -1,    61,    -1,
-      64,    -1,    65,    -1,    66,    -1,    69,    -1,    70,    -1,
-      71,    -1,    74,    -1,    75,    -1,    76,    -1,    77,    -1,
-     169,    -1,   214,    -1,   215,     3,   214,    -1,   179,   220,
-     180,    -1,   216,     3,   179,   220,   180,    -1,   218,    -1,
-     217,     3,   218,    -1,   179,   219,   180,    -1,   298,   276,
-      -1,   219,     3,   298,   276,    -1,   280,    -1,   220,     3,
-     280,    -1,    -1,     4,     4,    -1,   255,   256,    -1,   223,
-     204,   208,    -1,    35,    -1,    29,    -1,   160,    -1,   169,
-      24,   227,    24,    -1,   226,   248,   169,    24,   227,    24,
-      -1,   231,    24,   227,    24,    -1,   232,    -1,   232,     3,
-     227,    -1,   229,   230,    -1,   229,   247,   230,    -1,   228,
-     248,   247,   248,   230,    -1,   228,     3,   230,    -1,   119,
-      -1,    -1,   169,   276,    -1,   169,    -1,   169,   179,   280,
-     180,    -1,   231,     3,   231,    -1,   233,   299,    -1,   232,
-      21,   232,    -1,   232,    22,   232,    -1,   232,    23,   232,
-      -1,   232,   188,   232,    -1,    -1,   284,    -1,   235,   236,
-      -1,   114,   298,    -1,   114,   247,   298,    -1,   235,   248,
-     247,   248,   298,    -1,   235,     3,   298,    -1,    -1,   129,
-     324,    -1,   130,   324,    -1,   109,    -1,   238,   248,   169,
-     276,   264,    -1,   239,     3,   169,   276,   264,    -1,    81,
-     187,    -1,    81,   221,   242,    -1,    80,   187,    -1,    80,
-     221,   242,    -1,   169,    -1,   242,     3,   169,    -1,   244,
-     245,    -1,   244,   247,   245,    -1,   243,   248,   247,   248,
-     245,    -1,   127,    -1,   128,   127,    -1,   246,    -1,   245,
-       3,   246,    -1,   169,   276,    -1,    20,    -1,    24,   169,
-      24,    -1,    -1,     3,    -1,   250,    -1,   249,     3,   250,
-      -1,   169,     5,   280,    -1,   134,   252,    -1,   169,    -1,
-     252,     3,   169,    -1,   122,   123,    -1,   122,   137,    -1,
-      -1,   271,   254,   169,   276,   264,   305,    -1,   255,     3,
-     254,   169,   276,   264,   305,    -1,    -1,   262,   266,    -1,
-     261,   259,    -1,   263,    23,   176,    -1,   258,   268,   180,
-      -1,   146,    -1,    -1,    23,   176,    -1,    23,   179,   260,
-     180,    -1,   179,   260,   180,    -1,   169,   269,   270,    -1,
-     169,     5,   269,   270,    -1,   269,   270,    -1,   157,    -1,
-     263,    -1,   149,    -1,   148,    -1,   167,    -1,   151,    -1,
-     168,    -1,   150,    -1,    -1,    23,   265,    -1,   280,    -1,
-     179,    23,   180,    -1,    -1,    23,   267,    -1,   179,   268,
-     180,    -1,   280,    -1,   179,    23,   180,    -1,   169,   269,
-      -1,   169,     5,   269,    -1,   169,    -1,   176,    -1,   280,
-      -1,    23,    -1,    -1,     3,   169,   269,    -1,    -1,     4,
-       4,    -1,     3,   272,     4,     4,    -1,   273,    -1,   272,
-       3,   273,    -1,    29,    -1,   275,    -1,    82,    -1,   109,
-     276,    -1,   111,    -1,   112,   179,   274,   180,    -1,   113,
-      -1,   116,    -1,   117,    -1,   119,    -1,   120,    -1,   140,
-      -1,   138,    -1,   139,    -1,    80,    -1,    81,    -1,    -1,
-     179,   277,   180,    -1,   278,    -1,   277,     3,   278,    -1,
-     279,    -1,     4,    -1,   280,     4,    -1,     4,   280,    -1,
-     280,     4,   279,    -1,    23,    -1,   280,    -1,   283,    -1,
-     179,   280,   180,    -1,   307,    -1,   281,    -1,    46,   282,
-     180,    -1,    39,   282,   180,    -1,    40,   179,   282,   180,
-      -1,    44,   179,   282,   180,    -1,    56,   282,   180,    -1,
-      79,   179,   282,   180,    -1,    45,   179,   280,   180,    -1,
-      47,   280,   180,    -1,   148,   179,   282,   180,    -1,    62,
-     179,   280,   180,    -1,    57,   179,   280,   180,    -1,    58,
-     179,   280,   180,    -1,    59,   179,   280,   180,    -1,    60,
-     179,   280,   180,    -1,    61,   179,   280,   180,    -1,    64,
-     179,   280,   180,    -1,    65,   179,   280,   180,    -1,    66,
-     179,   280,   180,    -1,    69,   179,   280,   180,    -1,    70,
-     179,   280,   180,    -1,    71,   179,   280,   180,    -1,    73,
-     280,   180,    -1,    74,   179,   282,   180,    -1,    75,   179,
-     282,   180,    -1,    76,   179,   282,   180,    -1,    77,   179,
-     282,   180,    -1,   280,    -1,   282,     3,   280,    -1,   288,
-      -1,   299,    -1,   293,    -1,   280,   285,    -1,   284,   280,
-      -1,    12,   280,    -1,    21,    -1,    22,    -1,    21,   280,
-      -1,    22,   280,    -1,    23,   280,    -1,    25,   280,    -1,
-      14,   280,    -1,     8,   280,    -1,    17,   280,    -1,   186,
-     280,    -1,    18,   280,    -1,   185,   280,    -1,    15,   280,
-      -1,   186,     5,   280,    -1,    16,   280,    -1,   185,     5,
-     280,    -1,    13,   280,    -1,     7,   280,    -1,     9,   280,
-      -1,    10,   280,    -1,    11,   280,    -1,    24,   286,    -1,
-       5,   287,    -1,    -1,   280,    -1,     5,   280,    -1,    24,
-     280,    -1,     5,   280,    -1,   280,    -1,   298,    -1,   292,
-      -1,   290,    -1,    -1,   291,    -1,   291,   302,    -1,   292,
-     179,   294,   180,    -1,   292,   179,   294,   180,   302,    -1,
-     298,   179,   294,   180,    -1,   288,   189,   288,    -1,   131,
-     360,   132,    -1,   289,    -1,   289,   295,    -1,   296,    -1,
-     295,     3,   296,    -1,   280,    -1,   297,    -1,   280,     4,
-     280,    -1,   280,     4,   280,     4,   280,    -1,     4,   280,
-       4,   280,    -1,     4,     4,   280,    -1,     4,   280,    -1,
-     280,     4,    -1,     4,    -1,   169,    -1,   142,    -1,   143,
-      -1,   176,    -1,   163,    -1,   164,    -1,   165,    -1,   299,
-     169,    -1,   300,   301,    -1,   158,    -1,   300,   158,    -1,
-     162,    -1,   159,    -1,    -1,   302,    -1,   179,   303,     4,
-     303,   180,    -1,    -1,   280,    -1,   187,    -1,   280,    -1,
-      -1,   306,     5,   280,    -1,   306,   126,   280,    -1,    -1,
-     179,   283,     3,   283,   180,    -1,   309,   310,    -1,   309,
-     310,     3,   311,    -1,   309,   310,     3,    31,     4,   187,
-      -1,   309,   310,     3,    31,     4,   313,    -1,   141,    -1,
-     169,    -1,   312,    -1,   311,     3,   312,    -1,   169,   126,
-     169,    -1,   314,    -1,   313,     3,   314,    -1,   169,   126,
-     169,    -1,   169,    -1,   328,    -1,    98,   179,   366,   370,
-     180,    -1,   105,   179,   369,   370,   180,    -1,   106,   179,
-     371,   180,    -1,   317,    -1,   318,   324,    -1,   316,   324,
-      -1,   319,   324,    -1,    96,   324,    -1,   321,    -1,   372,
-     328,    -1,    41,   179,   280,   180,   304,    -1,    42,    -1,
-      43,    -1,   372,    84,    -1,    85,   179,   280,   180,    84,
-      -1,    86,    -1,    87,   324,    -1,    48,   320,   180,    -1,
-      49,   179,   280,   180,    -1,   115,    -1,   110,    -1,    93,
-      -1,   153,    -1,   156,    -1,   155,    -1,   154,    -1,   280,
-      -1,   320,     3,   280,    -1,   320,     4,   280,    -1,   326,
-     323,   322,    -1,   327,   280,    -1,    94,   325,    -1,    -1,
-     373,     5,   280,     3,   280,    -1,   373,     5,   280,     3,
-     280,     3,   280,    -1,    -1,   176,   248,    -1,   187,    -1,
-     169,    -1,    -1,   169,    -1,    92,    -1,    97,    -1,   118,
-      -1,   330,   332,    -1,   365,    -1,   341,    -1,   333,    -1,
-      98,   179,   366,   370,   180,    -1,   105,   179,   369,   370,
-     180,    -1,    78,   303,    -1,    83,   304,    -1,    63,   304,
-      -1,   340,   304,    -1,   331,    -1,    -1,   298,   329,   276,
-     276,    -1,   330,   189,   298,   329,   276,   276,    -1,   176,
-      -1,   331,     3,   176,    -1,     5,   280,    -1,   126,   280,
-      -1,   336,   334,    -1,    -1,   179,   335,   180,    -1,    -1,
-     338,    -1,   337,   169,    -1,   124,    -1,   339,    -1,   338,
-       3,   339,    -1,   280,    -1,    23,   364,    -1,   133,    -1,
-     135,    -1,   349,   345,    -1,   351,   343,    -1,   352,   345,
-      -1,   352,   345,   360,    -1,   104,   346,    -1,    38,    -1,
-      -1,   356,    -1,   345,   342,    -1,   350,   344,    -1,    -1,
-       3,   356,    -1,   179,   347,   180,    -1,   179,   353,   180,
-      -1,   179,   298,   180,    -1,   179,   176,   180,    -1,   176,
-      -1,   179,   283,   180,    -1,   169,    -1,   348,    -1,   347,
-       3,   348,    -1,   353,    -1,    23,    -1,    25,    -1,   298,
-     280,   276,    -1,   298,   280,    -1,   298,   280,   189,   330,
-      -1,   298,   179,   297,   180,    -1,   298,    23,    -1,   298,
-      25,    -1,    99,    -1,   100,    -1,   354,    -1,    23,    -1,
-     103,    -1,   101,    -1,    88,    -1,   102,    -1,   354,    -1,
-     179,   353,   180,    -1,   288,    -1,   299,    -1,   353,   355,
-     353,    -1,   353,    23,   353,    -1,   353,    24,   353,    -1,
-     353,    25,   353,    -1,   355,   353,    -1,   353,    20,   353,
-      -1,    50,   280,    -1,    55,   280,    -1,    52,   280,    -1,
-      51,   280,    -1,   169,     5,   280,    -1,   281,    -1,    21,
-      -1,    22,    -1,   358,    -1,   356,     3,   358,    -1,    -1,
-     288,    -1,   357,   359,    -1,   179,   356,   180,   359,    -1,
-     281,   359,    -1,   299,   359,    -1,   179,   356,     3,   363,
-     180,    -1,    -1,   285,    -1,   359,   285,    -1,   283,    -1,
-     362,    -1,   361,    -1,   283,     3,   280,    -1,   283,     3,
-     362,    -1,   362,     3,   280,    -1,   362,     3,   362,    -1,
-     361,     3,   280,    -1,   361,     3,   362,    -1,   283,    -1,
-     281,    -1,   307,    -1,   179,   280,   180,    -1,   179,   283,
-       3,   363,   180,    -1,   179,   362,     3,   363,   180,    -1,
-     179,   361,     3,   363,   180,    -1,   169,     5,   280,     3,
-     280,    -1,   169,     5,   280,     3,   280,     3,   280,    -1,
-     176,    -1,    89,   179,   280,     3,   280,   180,     3,   280,
-      -1,    89,   364,    -1,   367,    -1,   330,    -1,   366,     3,
-     367,    -1,   298,    -1,   292,    -1,   368,    -1,   298,   179,
-     295,   180,    -1,   367,    -1,   369,     3,   367,    -1,    -1,
-       3,   125,     5,   298,    -1,   298,    -1,   371,     3,   298,
-      -1,    91,   280,   180,    -1,   298,    -1
-};
-
-/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
-static const yytype_uint16 yyrline[] =
-{
-       0,   336,   336,   337,   339,   340,   341,   342,   343,   346,
-     347,   349,   350,   351,   360,   361,   363,   365,   367,   374,
-     379,   380,   382,   384,   385,   387,   388,   394,   397,   398,
-     401,   402,   430,   448,   481,   515,   532,   539,   541,   545,
-     550,   553,   556,   561,   562,   563,   571,   582,   594,   595,
-     597,   605,   613,   619,   620,   635,   648,   649,   655,   656,
-     693,   706,   707,   708,   709,   710,   711,   712,   713,   714,
-     715,   734,   735,   741,   742,   743,   744,   745,   746,   747,
-     748,   749,   750,   751,   752,   753,   754,   755,   756,   757,
-     758,   759,   760,   761,   762,   763,   764,   766,   767,   769,
-     770,   772,   773,   775,   777,   778,   780,   781,   783,   784,
-     786,   870,   907,   913,   918,   923,   937,   951,   966,   973,
-     982,   983,   984,   985,   987,   992,   993,   998,  1002,  1007,
-    1012,  1014,  1016,  1018,  1020,  1024,  1025,  1028,  1030,  1031,
-    1032,  1033,  1035,  1037,  1042,  1047,  1053,  1069,  1086,  1087,
-    1089,  1093,  1098,  1102,  1107,  1113,  1124,  1136,  1141,  1147,
-    1152,  1156,  1166,  1175,  1185,  1186,  1188,  1192,  1197,  1220,
-    1222,  1223,  1225,  1235,  1237,  1239,  1272,  1307,  1309,  1311,
-    1315,  1320,  1326,  1334,  1335,  1337,  1338,  1340,  1341,  1342,
-    1344,  1349,  1351,  1356,  1360,  1363,  1369,  1371,  1377,  1378,
-    1380,  1381,  1383,  1384,  1385,  1387,  1388,  1390,  1391,  1400,
-    1404,  1409,  1411,  1414,  1415,  1417,  1418,  1419,  1421,  1422,
-    1424,  1428,  1429,  1431,  1436,  1438,  1440,  1441,  1442,  1443,
-    1449,  1452,  1453,  1454,  1456,  1458,  1461,  1466,  1470,  1472,
-    1476,  1481,  1485,  1490,  1495,  1503,  1504,  1506,  1507,  1509,
-    1511,  1515,  1517,  1519,  1521,  1523,  1525,  1527,  1529,  1531,
-    1533,  1535,  1537,  1539,  1541,  1543,  1545,  1547,  1549,  1551,
-    1553,  1555,  1557,  1559,  1561,  1563,  1565,  1568,  1569,  1573,
-    1574,  1576,  1578,  1580,  1582,  1585,  1586,  1588,  1590,  1592,
-    1594,  1596,  1598,  1600,  1602,  1604,  1606,  1608,  1610,  1612,
-    1614,  1616,  1618,  1620,  1622,  1624,  1626,  1628,  1631,  1632,
-    1634,  1636,  1639,  1641,  1645,  1650,  1655,  1661,  1673,  1678,
-    1680,  1683,  1687,  1697,  1703,  1706,  1707,  1710,  1711,  1714,
-    1715,  1717,  1719,  1722,  1724,  1725,  1726,  1727,  1729,  1787,
-    1789,  1790,  1791,  1792,  1793,  1794,  1796,  1798,  1800,  1801,
-    1803,  1806,  1807,  1809,  1812,  1813,  1815,  1816,  1818,  1819,
-    1827,  1836,  1838,  1841,  1861,  1895,  1915,  1966,  1974,  1977,
-    1981,  1991,  2002,  2006,  2016,  2028,  2037,  2038,  2044,  2050,
-    2051,  2101,  2119,  2139,  2158,  2203,  2204,  2205,  2206,  2207,
-    2208,  2209,  2210,  2211,  2212,  2213,  2214,  2215,  2216,  2260,
-    2270,  2279,  2288,  2297,  2298,  2299,  2301,  2302,  2303,  2305,
-    2306,  2307,  2308,  2309,  2311,  2312,  2314,  2315,  2317,  2319,
-    2326,  2327,  2328,  2329,  2330,  2331,  2337,  2343,  2344,  2345,
-    2346,  2347,  2349,  2350,  2360,  2362,  2363,  2365,  2366,  2368,
-    2396,  2397,  2399,  2400,  2402,  2432,  2434,  2435,  2438,  2452,
-    2455,  2456,  2459,  2460,  2461,  2462,  2463,  2464,  2476,  2477,
-    2479,  2480,  2485,  2486,  2488,  2489,  2491,  2492,  2493,  2494,
-    2495,  2497,  2498,  2500,  2501,  2502,  2503,  2504,  2505,  2506,
-    2507,  2508,  2510,  2511,  2513,  2514,  2517,  2518,  2519,  2522,
-    2525,  2526,  2528,  2529,  2530,  2531,  2532,  2533,  2534,  2535,
-    2536,  2537,  2538,  2539,  2540,  2541,  2543,  2544,  2546,  2547,
-    2549,  2550,  2552,  2553,  2554,  2555,  2556,  2558,  2559,  2560,
-    2562,  2563,  2564,  2566,  2568,  2570,  2572,  2574,  2576,  2578,
-    2579,  2581,  2583,  2585,  2587,  2589,  2593,  2596,  2603,  2605,
-    2606,  2608,  2609,  2610,  2612,  2614,  2615,  2617,  2624,  2625,
-    2627,  2628,  2630,  2631,  2639,  2641
-};
-#endif
-
-#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
-/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
-   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
-static const char *const yytname[] =
-{
-  "$end", "error", "$undefined", "','", "':'", "'='", "TOK_BINARY_OP",
-  "TOK_NEQV", "TOK_EQV", "TOK_XOR", "TOK_OR", "TOK_AND", "TOK_NOT",
-  "TOK_NE", "TOK_EQ", "TOK_GE", "TOK_LE", "TOK_GT", "TOK_LT",
-  "TOK_UNARY_OP", "TOK_DSLASH", "'+'", "'-'", "'*'", "TOK_SLASH",
-  "TOK_DASTER", "TOK_SEP", "TOK_SEMICOLON", "TOK_NEXTLINE",
-  "TOK_PARAMETER", "TOK_RESULT", "TOK_ONLY", "TOK_INCLUDE",
-  "TOK_SUBROUTINE", "TOK_PROGRAM", "TOK_FUNCTION", "TOK_OMP", "TOK_DOLLAR",
-  "TOK_FORMAT", "TOK_MAX", "TOK_TANH", "TOK_WHERE", "TOK_ELSEWHERE",
-  "TOK_ENDWHERE", "TOK_MAXVAL", "TOK_TRIM", "TOK_SUM", "TOK_SQRT",
-  "TOK_CASE", "TOK_SELECTCASE", "TOK_FILE", "TOK_END", "TOK_ERR",
-  "TOK_DONOTTREAT", "TOK_ENDDONOTTREAT", "TOK_EXIST", "TOK_MIN",
-  "TOK_FLOAT", "TOK_EXP", "TOK_COS", "TOK_COSH", "TOK_ACOS", "TOK_NINT",
-  "TOK_CYCLE", "TOK_SIN", "TOK_SINH", "TOK_ASIN", "TOK_EQUIVALENCE",
-  "TOK_BACKSPACE", "TOK_LOG", "TOK_TAN", "TOK_ATAN", "TOK_RECURSIVE",
-  "TOK_ABS", "TOK_MOD", "TOK_SIGN", "TOK_MINLOC", "TOK_MAXLOC", "TOK_EXIT",
-  "TOK_MINVAL", "TOK_PUBLIC", "TOK_PRIVATE", "TOK_ALLOCATABLE",
-  "TOK_RETURN", "TOK_THEN", "TOK_ELSEIF", "TOK_ELSE", "TOK_ENDIF",
-  "TOK_PRINT", "TOK_PLAINGOTO", "TOK_CONSTRUCTID", "TOK_LOGICALIF",
-  "TOK_PLAINDO", "TOK_CONTAINS", "TOK_ENDDO", "TOK_MODULE",
-  "TOK_ENDMODULE", "TOK_DOWHILE", "TOK_ALLOCATE", "TOK_OPEN", "TOK_CLOSE",
-  "TOK_INQUIRE", "TOK_WRITE", "TOK_READ", "TOK_REWIND", "TOK_DEALLOCATE",
-  "TOK_NULLIFY", "TOK_FIN", "TOK_DEBUT", "TOK_DIMENSION", "TOK_ENDSELECT",
-  "TOK_EXTERNAL", "TOK_INTENT", "TOK_INTRINSIC", "TOK_NAMELIST",
-  "TOK_CASEDEFAULT", "TOK_OPTIONAL", "TOK_POINTER", "TOK_CONTINUE",
-  "TOK_SAVE", "TOK_TARGET", "TOK_QUOTE", "TOK_IMPLICIT", "TOK_NONE",
-  "TOK_CALL", "TOK_STAT", "TOK_POINT_TO", "TOK_COMMON", "TOK_GLOBAL",
-  "TOK_INTERFACE", "TOK_ENDINTERFACE", "TOK_LEFTAB", "TOK_RIGHTAB",
-  "TOK_PAUSE", "TOK_PROCEDURE", "TOK_STOP", "TOK_NAMEEQ", "TOK_REAL8",
-  "TOK_OUT", "TOK_INOUT", "TOK_IN", "TOK_USE", "TOK_TRUE", "TOK_FALSE",
-  "TOK_LABEL", "TOK_TYPE", "TOK_TYPEPAR", "TOK_ENDTYPE", "TOK_REAL",
-  "TOK_INTEGER", "TOK_LOGICAL", "TOK_DOUBLEPRECISION", "TOK_DOUBLEREAL",
-  "TOK_ENDSUBROUTINE", "TOK_ENDFUNCTION", "TOK_ENDPROGRAM", "TOK_ENDUNIT",
-  "TOK_CHARACTER", "TOK_CHAR_CONSTANT", "TOK_CHAR_CUT", "TOK_DATA",
-  "TOK_CHAR_INT", "TOK_CHAR_MESSAGE", "TOK_CSTREAL", "TOK_CSTREALDP",
-  "TOK_CSTREALQP", "TOK_SFREAL", "TOK_COMPLEX", "TOK_DOUBLECOMPLEX",
-  "TOK_NAME", "TOK_NAME_CHAR", "TOK_PROBTYPE", "TOK_INTERPTYPE",
-  "TOK_VARTYPE", "TOK_BC", "TOK_OP", "TOK_CSTINT", "TOK_COMMENT",
-  "TOK_FILENAME", "'('", "')'", "'['", "']'", "'!'", "'_'", "'<'", "'>'",
-  "'\\n'", "'/'", "'%'", "$accept", "input", "line", "suite_line_list",
-  "suite_line", "instr", "fin_line", "keyword", "position", "thislabel",
-  "cmnt", "nulcurbuf", "opt_recursive", "entry", "name_routine",
-  "writedeclar", "before_include", "filename", "arglist", "arglist1",
-  "args", "arg", "spec", "opt_spec", "name_intrinsic",
-  "use_intrinsic_list", "list_couple", "list_expr_equi", "expr_equi",
-  "list_expr_equi1", "list_expr", "opt_sep", "after_type",
-  "before_function", "before_parameter", "before_data", "data",
-  "datavallist", "save", "before_save", "varsave", "datanamelist",
-  "expr_data", "opt_signe", "namelist", "namelist_action",
-  "after_namelist", "interface", "before_dimension", "dimension",
-  "private", "public", "use_name_list", "common", "before_common",
-  "var_common_list", "var_common", "comblock", "opt_comma", "paramlist",
-  "paramitem", "module_proc_stmt", "proc_name_list", "implicit",
-  "opt_retour", "dcl", "nodimsgiven", "type", "before_typepar",
-  "c_selector", "c_attribute", "before_character", "typespec", "typename",
-  "lengspec", "proper_lengspec", "selector", "proper_selector",
-  "attribute", "clause", "opt_clause", "options", "attr_spec_list",
-  "attr_spec", "intent_spec", "access_spec", "dims", "dimlist", "dim",
-  "ubound", "expr", "predefinedfunction", "minmaxlist", "uexpr", "signe",
-  "operation", "after_slash", "after_equal", "lhs", "beforefunctionuse",
-  "array_ele_substring_func_ref", "begin_array", "structure_component",
-  "vec", "funarglist", "funargs", "funarg", "triplet", "ident",
-  "simple_const", "string_constant", "opt_substring", "substring",
-  "optexpr", "opt_expr", "initial_value", "before_initial",
-  "complex_const", "use_stat", "word_use", "module_name", "rename_list",
-  "rename_name", "only_list", "only_name", "exec", "word_endsubroutine",
-  "word_endunit", "word_endprogram", "word_endfunction", "caselist",
-  "boucledo", "do_arg", "opt_int", "opt_name", "optname", "worddo",
-  "wordwhile", "iffable", "before_dims", "ident_dims", "int_list",
-  "after_ident_dims", "call", "opt_call", "opt_callarglist", "keywordcall",
-  "before_call", "callarglist", "callarg", "stop", "io", "option_inlist",
-  "option_read", "opt_inlist", "ioctl", "after_rewind", "ctllist",
-  "ioclause", "iofctl", "infmt", "read", "write", "fexpr", "unpar_fexpr",
-  "addop", "inlist", "opt_lhs", "inelt", "opt_operation", "outlist",
-  "out2", "other", "dospec", "label", "goto", "allocation_list",
-  "allocate_object", "array_element", "allocate_object_list",
-  "opt_stat_spec", "pointer_name_list", "logif", "do_var", 0
-};
-#endif
-
-# ifdef YYPRINT
-/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
-   token YYLEX-NUM.  */
-static const yytype_uint16 yytoknum[] =
-{
-       0,   256,   257,    44,    58,    61,   258,   259,   260,   261,
-     262,   263,   264,   265,   266,   267,   268,   269,   270,   271,
-     272,    43,    45,    42,   273,   274,   275,   276,   277,   278,
-     279,   280,   281,   282,   283,   284,   285,   286,   287,   288,
-     289,   290,   291,   292,   293,   294,   295,   296,   297,   298,
-     299,   300,   301,   302,   303,   304,   305,   306,   307,   308,
-     309,   310,   311,   312,   313,   314,   315,   316,   317,   318,
-     319,   320,   321,   322,   323,   324,   325,   326,   327,   328,
-     329,   330,   331,   332,   333,   334,   335,   336,   337,   338,
-     339,   340,   341,   342,   343,   344,   345,   346,   347,   348,
-     349,   350,   351,   352,   353,   354,   355,   356,   357,   358,
-     359,   360,   361,   362,   363,   364,   365,   366,   367,   368,
-     369,   370,   371,   372,   373,   374,   375,   376,   377,   378,
-     379,   380,   381,   382,   383,   384,   385,   386,   387,   388,
-     389,   390,   391,   392,   393,   394,   395,   396,   397,   398,
-     399,   400,   401,   402,   403,   404,   405,   406,   407,   408,
-     409,   410,   411,   412,   413,   414,   415,   416,   417,   418,
-     419,   420,   421,   422,   423,   424,   425,   426,   427,    40,
-      41,    91,    93,    33,    95,    60,    62,    10,    47,    37
-};
-# endif
-
-/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
-static const yytype_uint16 yyr1[] =
-{
-       0,   190,   191,   191,   192,   192,   192,   192,   192,   193,
-     193,   194,   194,   194,   194,   194,   195,   196,   197,   197,
-     197,   197,   198,   199,   199,   200,   200,   201,   202,   202,
-     203,   203,   203,   203,   203,   203,   204,   205,   206,   207,
-     208,   208,   208,   209,   209,   209,   210,   210,   211,   211,
-     212,   212,   212,   212,   212,   212,   212,   212,   212,   212,
-     212,   212,   212,   212,   212,   212,   212,   212,   212,   212,
-     212,   213,   213,   214,   214,   214,   214,   214,   214,   214,
-     214,   214,   214,   214,   214,   214,   214,   214,   214,   214,
-     214,   214,   214,   214,   214,   214,   214,   215,   215,   216,
-     216,   217,   217,   218,   219,   219,   220,   220,   221,   221,
-     222,   222,   223,   224,   225,   226,   226,   226,   227,   227,
-     228,   228,   228,   228,   229,   230,   230,   231,   231,   231,
-     232,   232,   232,   232,   232,   233,   233,   234,   235,   235,
-     235,   235,   236,   237,   237,   238,   239,   239,   240,   240,
-     241,   241,   242,   242,   243,   243,   243,   244,   244,   245,
-     245,   246,   247,   247,   248,   248,   249,   249,   250,   251,
-     252,   252,   253,   253,   254,   255,   255,   256,   257,   257,
-     257,   257,   258,   259,   259,   259,   259,   260,   260,   260,
-     261,   262,   263,   263,   263,   263,   263,   263,   264,   264,
-     265,   265,   266,   266,   266,   267,   267,   268,   268,   268,
-     268,   269,   269,   270,   270,   271,   271,   271,   272,   272,
-     273,   273,   273,   273,   273,   273,   273,   273,   273,   273,
-     273,   274,   274,   274,   275,   275,   276,   276,   277,   277,
-     278,   278,   278,   278,   278,   279,   279,   280,   280,   280,
-     280,   281,   281,   281,   281,   281,   281,   281,   281,   281,
-     281,   281,   281,   281,   281,   281,   281,   281,   281,   281,
-     281,   281,   281,   281,   281,   281,   281,   282,   282,   283,
-     283,   283,   283,   283,   283,   284,   284,   285,   285,   285,
-     285,   285,   285,   285,   285,   285,   285,   285,   285,   285,
-     285,   285,   285,   285,   285,   285,   285,   285,   286,   286,
-     286,   286,   287,   287,   288,   288,   288,   289,   290,   290,
-     290,   290,   291,   292,   293,   294,   294,   295,   295,   296,
-     296,   297,   297,   297,   297,   297,   297,   297,   298,   299,
-     299,   299,   299,   299,   299,   299,   299,   300,   300,   300,
-     300,   301,   301,   302,   303,   303,   304,   304,   305,   305,
-     305,   306,   307,   308,   308,   308,   308,   309,   310,   311,
-     311,   312,   313,   313,   314,   314,   315,   315,   315,   315,
-     315,   315,   315,   315,   315,   315,   315,   315,   315,   315,
-     315,   315,   315,   315,   315,   315,   315,   315,   315,   316,
-     317,   318,   319,   320,   320,   320,   321,   321,   321,   322,
-     322,   322,   323,   323,   324,   324,   325,   325,   326,   327,
-     328,   328,   328,   328,   328,   328,   328,   328,   328,   328,
-     328,   328,   329,   330,   330,   331,   331,   332,   332,   333,
-     334,   334,   335,   335,   336,   337,   338,   338,   339,   339,
-     340,   340,   341,   341,   341,   341,   341,   341,   342,   342,
-     343,   343,   344,   344,   345,   345,   346,   346,   346,   346,
-     346,   347,   347,   348,   348,   348,   348,   348,   348,   348,
-     348,   348,   349,   349,   350,   350,   351,   351,   351,   352,
-     353,   353,   354,   354,   354,   354,   354,   354,   354,   354,
-     354,   354,   354,   354,   354,   354,   355,   355,   356,   356,
-     357,   357,   358,   358,   358,   358,   358,   359,   359,   359,
-     360,   360,   360,   361,   361,   361,   361,   361,   361,   361,
-     361,   362,   362,   362,   362,   362,   363,   363,   364,   365,
-     365,   366,   366,   366,   367,   367,   367,   368,   369,   369,
-     370,   370,   371,   371,   372,   373
-};
-
-/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN.  */
-static const yytype_uint8 yyr2[] =
-{
-       0,     2,     0,     2,     2,     2,     1,     3,     3,     1,
-       3,     2,     2,     3,     3,     2,     2,     2,     1,     1,
-       1,     1,     0,     0,     2,     0,     1,     0,     0,     1,
-       0,     4,     2,     6,     4,     2,     1,     0,     1,     1,
-       0,     2,     3,     0,     2,     3,     1,     3,     1,     1,
-       2,     4,     2,     2,     4,     2,     1,     1,     1,     1,
-       1,     1,     1,     1,     1,     1,     4,     3,     3,     2,
-       3,     0,     1,     1,     1,     1,     1,     1,     1,     1,
-       1,     1,     1,     1,     1,     1,     1,     1,     1,     1,
-       1,     1,     1,     1,     1,     1,     1,     1,     3,     3,
-       5,     1,     3,     3,     2,     4,     1,     3,     0,     2,
-       2,     3,     1,     1,     1,     4,     6,     4,     1,     3,
-       2,     3,     5,     3,     1,     0,     2,     1,     4,     3,
-       2,     3,     3,     3,     3,     0,     1,     2,     2,     3,
-       5,     3,     0,     2,     2,     1,     5,     5,     2,     3,
-       2,     3,     1,     3,     2,     3,     5,     1,     2,     1,
-       3,     2,     1,     3,     0,     1,     1,     3,     3,     2,
-       1,     3,     2,     2,     0,     6,     7,     0,     2,     2,
-       3,     3,     1,     0,     2,     4,     3,     3,     4,     2,
-       1,     1,     1,     1,     1,     1,     1,     1,     0,     2,
-       1,     3,     0,     2,     3,     1,     3,     2,     3,     1,
-       1,     1,     1,     0,     3,     0,     2,     4,     1,     3,
-       1,     1,     1,     2,     1,     4,     1,     1,     1,     1,
-       1,     1,     1,     1,     1,     1,     0,     3,     1,     3,
-       1,     1,     2,     2,     3,     1,     1,     1,     3,     1,
-       1,     3,     3,     4,     4,     3,     4,     4,     3,     4,
-       4,     4,     4,     4,     4,     4,     4,     4,     4,     4,
-       4,     4,     3,     4,     4,     4,     4,     1,     3,     1,
-       1,     1,     2,     2,     2,     1,     1,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     3,     2,
-       3,     2,     2,     2,     2,     2,     2,     2,     0,     1,
-       2,     2,     2,     1,     1,     1,     1,     0,     1,     2,
-       4,     5,     4,     3,     3,     1,     2,     1,     3,     1,
-       1,     3,     5,     4,     3,     2,     2,     1,     1,     1,
-       1,     1,     1,     1,     1,     2,     2,     1,     2,     1,
-       1,     0,     1,     5,     0,     1,     1,     1,     0,     3,
-       3,     0,     5,     2,     4,     6,     6,     1,     1,     1,
-       3,     3,     1,     3,     3,     1,     1,     5,     5,     4,
-       1,     2,     2,     2,     2,     1,     2,     5,     1,     1,
-       2,     5,     1,     2,     3,     4,     1,     1,     1,     1,
-       1,     1,     1,     1,     3,     3,     3,     2,     2,     0,
-       5,     7,     0,     2,     1,     1,     0,     1,     1,     1,
-       1,     2,     1,     1,     1,     5,     5,     2,     2,     2,
-       2,     1,     0,     4,     6,     1,     3,     2,     2,     2,
-       0,     3,     0,     1,     2,     1,     1,     3,     1,     2,
-       1,     1,     2,     2,     2,     3,     2,     1,     0,     1,
-       2,     2,     0,     2,     3,     3,     3,     3,     1,     3,
-       1,     1,     3,     1,     1,     1,     3,     2,     4,     4,
-       2,     2,     1,     1,     1,     1,     1,     1,     1,     1,
-       1,     3,     1,     1,     3,     3,     3,     3,     2,     3,
-       2,     2,     2,     2,     3,     1,     1,     1,     1,     3,
-       0,     1,     2,     4,     2,     2,     5,     0,     1,     2,
-       1,     1,     1,     3,     3,     3,     3,     3,     3,     1,
-       1,     1,     3,     5,     5,     5,     5,     7,     1,     8,
-       2,     1,     1,     3,     1,     1,     1,     4,     1,     3,
-       0,     4,     1,     3,     3,     1
-};
-
-/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
-   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
-   means the default is an error.  */
-static const yytype_uint16 yydefact[] =
-{
-       2,     0,     1,    37,    20,    21,    18,    19,    27,     6,
-      22,     3,    25,    30,    27,    24,     4,    26,    37,   113,
-      38,     0,   457,     0,   388,   389,     0,     0,     0,     0,
-       0,    29,   354,   108,   108,     0,     0,   392,     0,   488,
-       0,     0,   418,   398,   416,     0,     0,   419,     0,   482,
-     483,   487,   489,   486,     0,     0,     0,   145,   397,   108,
-     108,     0,   396,     0,   420,   124,     0,   445,   157,     0,
-       0,     0,   450,     0,   451,   367,    71,   182,     0,   193,
-     192,   197,   195,   399,   402,   401,   400,   190,   114,   194,
-     196,   338,   435,     5,     9,    22,     0,    22,     0,    22,
-       0,     0,    57,   125,    65,   142,    64,   164,    59,    61,
-      60,    56,     0,    63,    58,   215,     0,   183,   202,   191,
-     432,    62,     0,    25,     0,   380,     0,     0,   385,   412,
-       0,   376,     0,   431,   424,   440,     0,     0,   423,     0,
-       0,     0,   422,     0,     8,     7,    36,    32,     0,     0,
-     285,   286,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   339,   340,
-       0,   347,   350,   349,   342,   343,   344,   341,     0,   403,
-     250,   247,     0,   279,   316,   318,   315,   281,   314,   280,
-     351,   249,     0,     0,   356,   357,   429,     0,    69,   101,
-       0,   355,   427,     0,   150,     0,   148,     0,   428,     0,
-     415,   414,   393,   538,     0,   540,     0,   417,   408,    35,
-     384,     0,   470,   468,     0,   456,     0,     0,     0,     0,
-     162,     0,     0,   138,     0,    53,   172,   173,   158,   143,
-     144,   170,   169,   234,   235,   108,    72,    52,    30,    15,
-      25,     0,     0,    11,    39,    22,    12,     0,     0,    55,
-     166,   127,   164,     0,   125,     0,   236,   120,   125,   165,
-     137,     0,   165,     0,     0,     0,   236,   154,   159,     0,
-       0,     0,   112,    50,     0,   177,   174,   209,   210,     0,
-       0,     0,   179,     0,     0,   178,     0,    16,   236,   368,
-     363,    37,   382,   381,   383,   164,   409,   407,     0,     0,
-       0,   421,     0,   442,   439,   444,   430,     0,   452,   506,
-     507,   485,     0,     0,     0,     0,   338,     0,   505,   492,
-     493,   453,   458,   462,     0,   484,     0,   454,   390,     0,
-       0,   432,   386,     0,   284,   277,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,   530,   520,   249,     0,   522,   521,     0,
-       0,   247,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   308,     0,     0,
-       0,   282,   283,     0,   354,   319,   317,   317,   345,   348,
-     346,   352,     0,     0,   394,     0,     0,   236,     0,     0,
-     109,   152,   151,   149,     0,     0,   554,     0,   545,   432,
-     542,   550,   541,   546,   341,   247,   314,   544,   548,   550,
-     552,     0,    67,    74,    75,    78,    73,    79,    76,    81,
-      82,    83,    84,    85,    80,    86,    87,    88,    89,    90,
-      91,    92,    93,    94,    95,    77,    96,    97,    68,     0,
-     139,     0,   106,     0,     0,     0,    10,    17,    40,    40,
-      13,     0,     0,     0,   135,     0,    70,     0,     0,   135,
-     123,   164,     0,   126,   121,   141,   164,   236,   236,   164,
-     161,     0,   155,   220,   222,   236,   224,     0,   226,   227,
-     228,   229,   230,     0,   218,   221,   216,    40,   174,   110,
-       0,     0,   212,   207,   211,   181,   184,     0,   338,     0,
-     213,     0,   203,   205,     0,   180,   236,     0,    14,   413,
-     555,   406,     0,   437,   438,   432,   436,     0,   448,     0,
-     443,   446,   474,   475,     0,   314,     0,   471,   473,   490,
-     500,   503,   502,   501,     0,   473,   510,   517,   511,   517,
-     460,   459,   517,   508,   510,   461,     0,     0,     0,     0,
-       0,   498,   455,     0,     0,     0,     0,   252,     0,     0,
-       0,   251,   258,   255,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   272,     0,     0,     0,
-       0,     0,     0,   247,     0,     0,     0,   324,     0,     0,
-       0,   248,     0,     0,   313,   307,   302,   292,   303,   304,
-     305,   301,   291,   297,   299,   293,   295,   287,   288,   289,
-       0,     0,   309,   306,   290,     0,   296,     0,   294,   323,
-       0,   325,     0,     0,   404,   405,   395,     0,   103,   104,
-     102,    66,     0,     0,     0,   317,     0,     0,   467,   469,
-     466,     0,     0,     0,   379,     0,   163,     0,    99,     0,
-     171,    51,     0,    31,    34,   168,    54,   167,     0,   118,
-       0,   136,     0,     0,   127,   129,     0,   125,   241,   245,
-       0,   238,   240,   246,     0,   198,   198,     0,   160,   223,
-       0,     0,     0,   111,     0,   236,   208,     0,     0,   213,
-     186,     0,   189,     0,   204,   433,     0,     0,   364,   369,
-       0,   236,   449,   441,     0,     0,   480,   481,   317,   236,
-       0,   464,   465,   504,   465,     0,   518,   514,   515,   510,
-     512,   463,   499,   495,   496,   497,   494,   550,   550,   387,
-     278,   253,   254,   257,   261,   262,   263,   264,   265,   260,
-     266,   267,   268,   269,   270,   271,   273,   274,   275,   276,
-     256,   248,     0,     0,     0,   523,   524,   527,   528,   525,
-     526,   259,   247,   312,   310,   311,   300,   298,   354,   337,
-     329,   326,   327,   330,   320,   322,   236,   153,   391,     0,
-       0,     0,   543,   377,   549,   378,   553,    98,   107,     0,
-      49,    48,    41,     0,    46,    43,   115,   135,   135,   135,
-     135,   135,   130,   128,   135,   117,   122,   243,     0,   237,
-     242,   140,     0,   146,   147,   156,   232,   233,   231,     0,
-     219,   217,   236,   198,   185,   213,   187,     0,   206,     0,
-       0,     0,     0,   236,   447,   491,     0,     0,     0,   476,
-     472,   473,   510,   517,   519,   509,     0,     0,   338,     0,
-       0,     0,   362,     0,     0,   335,   336,     0,   321,   105,
-       0,   547,     0,   100,     0,    42,     0,    33,   119,   131,
-     132,   133,   134,     0,   239,   244,   246,     0,   199,   200,
-     225,   198,   358,   188,   214,   375,   365,   366,   372,   371,
-     370,     0,   434,   479,   478,     0,   513,   425,   426,     0,
-     533,   535,   534,   353,   334,     0,   331,   328,     0,   551,
-      47,    44,     0,   116,     0,   358,   175,     0,     0,     0,
-     410,   516,     0,   333,     0,   539,    45,   201,   176,     0,
-       0,   374,   373,     0,     0,   332,   359,   360,   411,   536,
-       0,   537
-};
-
-/* YYDEFGOTO[NTERM-NUM].  */
-static const yytype_int16 yydefgoto[] =
-{
-      -1,     1,    11,    93,    94,    95,   259,    12,   260,    13,
-      18,    15,    96,    97,   147,    14,    98,   265,   693,   907,
-     833,   834,    99,   255,   477,   478,   245,   208,   209,   426,
-     481,   215,   293,   294,   100,   101,   272,   698,   102,   103,
-     277,   273,   699,   700,   104,   105,   280,   106,   107,   108,
-     109,   110,   432,   111,   112,   287,   288,   242,   275,   269,
-     270,   113,   252,   114,   530,   295,   529,   115,   116,   302,
-     539,   117,   118,   119,   853,   918,   305,   542,   299,   540,
-     732,   296,   523,   524,   859,   525,   503,   710,   711,   712,
-     355,   190,   356,   191,   192,   411,   653,   635,   193,   661,
-     194,   195,   196,   197,   663,   811,   812,   813,   198,   199,
-     200,   420,   415,   212,   206,   956,   957,   201,   121,   122,
-     310,   738,   739,   927,   928,   123,   124,   125,   126,   127,
-     202,   128,   551,   316,   222,   228,   129,   130,   131,   308,
-     132,   133,   321,   134,   324,   559,   135,   136,   560,   561,
-     137,   138,   580,   341,   585,   328,   235,   566,   567,   139,
-     343,   140,   141,   344,   569,   346,   581,   582,   583,   757,
-     386,   387,   388,   889,   225,   142,   441,   442,   443,   449,
-     677,   451,   143,   552
-};
-
-/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
-   STATE-NUM.  */
-#define YYPACT_NINF -711
-static const yytype_int16 yypact[] =
-{
-    -711,   923,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,   -98,  5724,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,   -51,  -711,   -47,  -711,  -711,  4731,    54,  2666,    70,
-     115,  -711,  4731,    34,    40,  2666,   117,  -711,   -63,  -711,
-       7,  4731,  -711,  -711,   -39,    66,   -63,  -711,   137,  -711,
-    -711,  -711,  -711,  -711,   184,   141,   170,  -711,  -711,   199,
-     199,   155,  -711,   175,  -711,  -711,    37,  -711,  -711,    92,
-     -63,   -63,  -711,   129,  -711,  -711,   116,  -711,   -63,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,   217,  -711,  -711,    31,  -711,    96,  -711,
-     -64,   187,    97,   156,  -711,   149,  -711,   384,   390,  -711,
-    -711,   395,   165,  -711,  -711,    91,   -15,    80,   125,   372,
-     416,  -711,   253,   -98,   -63,  -711,   -63,   -63,  -711,   247,
-    4731,  -711,    24,   434,  -711,   267,   278,  2666,  -711,   270,
-    5575,   270,  -711,  2341,  -711,  -711,  -711,  -711,  4731,  4731,
-    -711,  -711,  4731,   276,   279,   280,  4731,  4731,  4731,   285,
-     291,   292,   296,   299,   301,   309,   310,   313,   316,   317,
-     318,  4731,   319,   325,   328,   329,   330,  4859,  -711,  -711,
-     331,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  4731,  2530,
-    -711,  -711,  4731,   304,  -711,   334,   342,  -711,   343,   354,
-     -33,  -711,    43,  4731,  -711,  2530,  -711,   356,   528,  -711,
-    4731,  2530,  -711,   534,  -711,   376,  -711,   376,  -711,  4731,
-    -711,  -711,  -711,  -711,  4731,  -711,  1494,  -711,  -711,  -711,
-    -711,   356,  -711,  -711,  4987,  -711,   356,   356,   376,  2588,
-    -711,   377,   356,  -711,  4731,   544,  -711,  -711,  -711,  -711,
-    -711,  -711,   546,  -711,  -711,   199,  -711,  -711,  5724,  -711,
-     -98,   -51,   -51,  -711,  -711,  -711,  -711,   557,   394,   561,
-    -711,    21,    33,   144,   397,   139,   388,  -711,   397,   356,
-    -711,   139,  -711,   399,   402,   139,   388,   571,  -711,   407,
-     733,   575,  -711,  -711,   -51,   572,  -711,  3067,  -711,   401,
-     215,  3963,  -711,  5115,   -15,  -711,   425,  -711,   388,  -711,
-     601,  -711,  -711,  -711,  -711,   384,   356,  2530,  4731,  4731,
-     356,  -711,   429,  4091,  -711,  -711,  -711,  5430,  -711,  -711,
-    -711,  -711,  4731,  4731,  4731,  4731,   610,  5430,  -711,   304,
-     354,  -711,  1098,   616,   588,   618,  5621,  4859,  -711,   441,
-     443,  -711,  -711,  1515,   670,  2530,    27,  4731,  4731,  4731,
-      36,  1550,    45,  4731,  4731,  4731,  4731,  4731,  4731,  4731,
-    4731,  4731,  4731,  4731,  4731,  1572,  4731,  4731,  4731,  4731,
-    4731,  4859,  2530,  1594,   782,  -711,   500,   630,   631,  4731,
-    1615,   633,  3451,  4731,  4731,  4731,  4731,  4731,  4731,  4731,
-    4731,  4731,  4731,  4731,  4731,  4731,  4731,  3195,  4731,  3579,
-    3707,  -711,   128,   356,  4731,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  4731,  4731,  -711,  1637,    48,   388,    70,  1697,
-    -711,  -711,   641,   641,  1819,  1173,  -711,   304,   -24,    -1,
-     457,   647,  -711,  -711,   471,   472,   151,    -1,  -711,   650,
-    -711,    62,   641,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,   651,   634,
-    -711,    71,  2530,   476,   488,   -63,  -711,  -711,   480,   480,
-    -711,  4731,    72,   394,   314,  4731,  -711,   491,   495,   314,
-    -711,   384,  2538,  -711,  -711,  -711,   384,   388,   388,   384,
-    -711,   407,   571,  -711,  -711,   388,  -711,   486,  -711,  -711,
-    -711,  -711,  -711,   358,  -711,  -711,  -711,   480,  -711,  -711,
-     497,  4219,  -711,  -711,  2530,  -711,  -711,  3963,  3323,   487,
-     665,  4347,  -711,  2530,   489,  -711,   388,    23,  -711,  -711,
-    -711,  -711,   667,  2530,  2530,  -711,  -711,   498,  2530,   493,
-     672,  -711,  -711,  -711,  5621,  3835,    75,  -711,   119,  -711,
-    2530,  2530,  2530,  2530,  4731,   530,  5850,  2530,   304,  1840,
-    -711,   674,  2530,  -711,  5850,  -711,  5621,  5621,  5621,  5621,
-    5621,   654,  -711,   356,   356,  2666,  4731,  -711,    84,    85,
-    1879,  -711,  -711,  -711,  1900,  1921,  1942,  1963,  2006,  2027,
-    2145,  2209,  2230,  2251,  2272,  2293,  -711,    86,    88,    89,
-      90,    98,  2327,   678,   687,   693,  4859,  -711,  4859,  4859,
-      99,  -711,  4731,  4731,  2530,  -711,   710,   710,   569,   569,
-     670,   814,   814,   814,   814,   814,   814,   133,   133,   128,
-    4731,  4731,  2530,  -711,   128,  4731,   814,  4731,   814,   304,
-     695,  2811,   517,   520,  2530,  2530,  -711,   356,  -711,  -711,
-    -711,  -711,   532,   619,  4731,  2811,   -49,   526,  -711,  -711,
-    -711,   -49,   527,   356,  -711,  2588,  -711,  4731,  -711,  4731,
-    -711,  -711,    67,  -711,   681,  2530,  -711,  -711,   689,    50,
-     716,  -711,  2348,   691,   538,  -711,   705,   397,  4731,  -711,
-     105,  -711,  -711,  1384,   356,   707,   707,   407,  -711,  -711,
-     287,   733,   732,  -711,   568,   388,  -711,   558,  4219,   665,
-    -711,   570,  -711,   560,  -711,  -711,   738,   617,   741,  -711,
-    4731,   388,  -711,  -711,  4091,   536,  -711,  -711,  2811,   519,
-    5430,  -711,  -711,  2530,   727,   106,  -711,  2530,  2530,  5850,
-    2530,   674,   574,   654,   654,   654,   406,   647,   650,  -711,
-    2530,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  5243,  5243,  5243,  2530,  -711,  2530,  -711,  2530,
-    -711,  -711,   573,   814,   814,   128,   814,   814,  4731,  2939,
-    1406,   745,  -711,  -711,   334,  -711,   388,  -711,  -711,  2475,
-     107,   744,  -711,  -711,  -711,  -711,  -711,  -711,  2530,   109,
-    -711,  -711,  -711,   110,  -711,   577,  -711,   314,   314,   314,
-     314,   314,   354,  -711,   314,  -711,  -711,  2530,  2538,  -711,
-    4475,  -711,  5371,  -711,  -711,   571,  -711,  -711,  -711,   579,
-    -711,  -711,   388,   707,  -711,   665,  -711,  4219,  -711,   -50,
-     581,   582,  1196,   388,  -711,  -711,  1362,   580,   356,  -711,
-    -711,   588,  5891,  2530,  -711,  -711,   583,   584,   747,   585,
-     590,   591,  -711,   592,  4731,  1428,  4731,  2811,  -711,  -711,
-     754,  -711,   356,  -711,    26,  -711,    93,  -711,  -711,    29,
-      29,   586,   113,   737,  -711,  -711,  2530,  4603,  -711,  2530,
-    -711,   707,    64,  -711,  -711,   649,  -711,   770,  -711,  -711,
-    -711,  4731,  -711,  -711,   457,   596,  2530,  -711,  -711,  4731,
-    -711,  -711,  -711,  -711,  2530,  4731,  1471,  -711,  4731,  -711,
-    -711,  -711,   111,  -711,   597,    64,  -711,   162,   609,   611,
-    1282,  -711,  1305,  2530,  4731,  2530,  -711,  -711,  -711,  4731,
-    4731,  -711,  -711,  4731,  4731,  2530,  2530,  2530,  2530,  1328,
-    4731,  2530
-};
-
-/* YYPGOTO[NTERM-NUM].  */
-static const yytype_int16 yypgoto[] =
-{
-    -711,  -711,  -711,  -711,   523,  -711,    30,  -711,   774,  -711,
-     -66,   772,  -711,  -711,    65,     6,  -711,  -711,  -430,  -711,
-    -118,  -110,  -711,  -711,   123,  -711,  -711,  -711,   373,  -711,
-     120,     1,  -711,  -711,  -711,  -711,  -711,  -480,  -711,  -711,
-    -264,   312,  -439,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,   -68,  -711,  -711,  -276,   300,   -35,   -85,   548,
-     324,  -711,  -711,  -711,   274,  -711,  -711,  -711,  -711,  -711,
-     281,  -711,  -711,  -711,  -699,  -711,  -711,  -711,   515,  -290,
-    -666,  -711,  -711,   100,  -711,   749,  -104,  -711,   -25,   -17,
-     -26,  -136,    56,  -176,  -432,  -497,  -711,  -711,  -103,  -711,
-    -711,  -711,  -204,  -711,   404,   159,   -57,    95,    -5,   -70,
-    -711,  -711,  -197,  -398,   -30,  -108,  -711,  -166,  -711,  -711,
-    -711,  -711,   -23,  -711,  -105,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,   -28,  -711,  -711,  -711,   708,   302,
-    -208,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,   118,
-    -711,  -711,  -711,  -711,  -711,   277,  -711,  -711,   114,  -711,
-    -711,  -711,  -711,  -306,   720,  -263,  -226,  -711,  -673,  -554,
-     514,   482,  -326,  -710,   308,  -711,   273,  -202,  -711,   275,
-    -416,  -711,  -711,  -711
-};
-
-/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
-   positive, shift that token.  If negative, reduce the rule which
-   number is the opposite.  If zero, do what YYDEFACT says.
-   If YYTABLE_NINF, syntax error.  */
-#define YYTABLE_NINF -511
-static const yytype_int16 yytable[] =
-{
-     189,   384,   205,   421,   338,   218,   211,   533,   120,   205,
-     500,   385,   391,   512,   504,   226,   660,   854,   230,   706,
-     281,   568,   283,   440,   145,   758,   285,   438,   760,   318,
-     596,   575,   438,   682,   448,   217,   282,   339,   213,   596,
-     591,   383,   249,   250,   213,   494,   422,   423,   596,   830,
-     257,   667,   840,   837,   736,   625,   243,   311,   445,   694,
-     238,   239,   701,   866,   261,   683,   262,   701,   278,  -361,
-     340,   838,   839,   840,   687,   493,   821,   289,   750,    17,
-     756,   590,   756,   890,   891,   756,   885,   596,   596,   596,
-     830,   596,   596,   596,   290,   291,   312,   723,   313,   314,
-     274,   596,   596,   300,   317,   267,   220,   326,   848,   882,
-     897,   205,   687,   904,   904,   268,   830,  -164,   146,   925,
-      91,  -164,   353,   354,   221,   419,   292,   263,   437,   266,
-     227,   361,   148,   437,   838,   839,   840,   926,   351,   586,
-     329,   330,   587,   588,   589,   375,   414,   498,   303,   433,
-     319,   382,   279,   408,   297,   416,   406,   407,   408,   240,
-     246,   298,   390,   241,   922,  -315,   412,   969,   499,  -164,
-     452,   384,   935,  -164,   247,   240,   240,   425,   675,   241,
-     241,   385,   510,   223,   429,   240,   224,   497,  -314,   241,
-    -361,   338,   737,   434,   487,   831,   253,   254,   435,   923,
-     495,   338,   427,   213,   546,   623,   577,   597,   382,   885,
-     338,   383,   360,   320,   362,   385,   601,   841,   482,   248,
-     496,   214,   955,   424,   339,   603,   439,   216,   668,   446,
-     549,   447,   450,   203,   339,   229,   831,   480,   841,   578,
-     501,   726,   684,   339,   258,   383,   506,   832,   729,   207,
-     509,   688,   696,   120,   264,   751,   485,   340,   745,   301,
-     884,   884,   831,   884,   771,   772,   786,   340,   787,   788,
-     789,   534,   579,   951,   505,   534,   340,   543,   790,   801,
-     762,   763,   764,   765,   766,   849,   883,   901,   970,   903,
-     905,   966,   553,   554,   210,   490,   219,   558,   251,   752,
-     796,   841,   798,   800,   304,   590,   570,   571,   572,   573,
-     659,   550,   590,   409,   410,   555,   231,   548,   409,   410,
-     236,   382,   565,   669,    91,   276,   488,   489,   590,   936,
-     417,   680,   565,   600,   286,   150,   151,   604,   605,   606,
-     607,   608,   609,   610,   611,   612,   613,   614,   615,   237,
-     755,   886,   887,   232,   244,   622,   271,   908,   761,   527,
-     233,   721,   722,   234,   913,   391,   634,   636,   637,   638,
-     639,   640,   641,   642,   643,   644,   645,   646,   647,   648,
-     649,   652,   654,   656,   658,   440,   756,   282,   211,   438,
-     438,   536,   448,   284,   537,   306,   664,   665,   282,   909,
-     910,   911,   912,   715,   716,   701,   701,   701,   701,   701,
-     893,   719,   701,   598,   599,  -164,   707,   342,   347,  -164,
-     307,   714,   309,   315,   717,   856,   857,   858,   338,   587,
-     588,   589,   617,   618,   619,   620,   621,   322,   865,   884,
-     577,   855,   735,   846,   881,   630,   323,   325,   577,   327,
-     338,   338,   338,   338,   338,   357,   802,   691,   358,   359,
-     385,   339,   385,   385,   363,   695,   796,   798,   800,   702,
-     364,   365,   438,   578,   822,   366,   713,   438,   367,   824,
-     368,   578,   590,   339,   339,   339,   339,   339,   369,   370,
-     437,   437,   371,   413,   340,   372,   373,   374,   376,   590,
-     590,   590,   590,   590,   377,   534,   579,   378,   379,   380,
-     389,   534,   534,   414,   579,   390,   340,   340,   340,   340,
-     340,   416,   417,   418,   392,    91,   393,   394,   395,   396,
-     397,   428,   398,   399,   400,   401,   402,   403,   430,   749,
-     404,   405,   406,   407,   408,   431,   479,   483,   753,   484,
-     586,   329,   330,   587,   588,   589,   586,   329,   330,   587,
-     588,   589,   491,   267,   493,   769,   276,   502,   507,   205,
-     770,   508,   391,   437,   511,   528,   286,   924,   437,   526,
-     397,   535,   398,   399,   400,   401,   402,   403,   439,   447,
-     404,   405,   406,   407,   408,   329,   330,   587,   588,   589,
-     795,   545,   797,   799,   547,   556,   382,   803,   586,   329,
-     330,   587,   588,   589,   338,   574,   802,   898,   590,   584,
-     593,   863,   594,   577,   804,   805,   385,   385,   385,   806,
-     842,   807,   627,   628,   629,   810,   632,   873,  -490,  -490,
-    -490,  -490,  -490,  -490,   672,   879,   320,   339,   819,   810,
-     676,   678,   679,   681,   685,   689,   578,   690,   686,   692,
-     703,   828,   816,   482,   704,   720,   725,   730,   731,   734,
-     934,   447,   740,   743,   223,   744,   447,   759,   826,   589,
-     340,   792,   847,   398,   399,   400,   401,   402,   403,   579,
-     793,   404,   405,   406,   407,   408,   794,   814,   502,   808,
-     815,   817,   534,   818,   409,   410,   823,   825,   878,   851,
-     754,   835,   899,   836,   872,   844,   875,   495,   558,   395,
-     396,   397,   876,   398,   399,   400,   401,   402,   403,   845,
-     852,   404,   405,   406,   407,   408,   861,   862,   864,   867,
-     868,   391,   869,   870,   871,   565,   577,  -491,   897,   902,
-     929,   737,   939,   892,   409,   410,   906,   948,   921,   920,
-     933,   953,   513,   937,   938,   940,   795,   797,   799,   932,
-     941,   942,   943,   959,   841,   958,   961,   967,   971,   578,
-     925,   486,   211,   895,    16,   626,   144,  -247,   952,  -247,
-    -247,  -247,  -247,  -247,   950,  -247,  -247,  -247,  -247,  -247,
-    -247,   670,   724,  -247,  -247,  -247,  -247,  -247,   827,   829,
-     705,   718,   579,   253,   254,   514,   492,   697,   727,   544,
-     662,   860,   713,   914,   916,   256,   919,  -511,  -511,  -511,
-    -511,  -511,  -511,   915,   820,   404,   405,   406,   407,   408,
-     947,   534,   515,   877,   516,   517,   518,   968,   930,   519,
-     520,   352,   521,   522,   972,   409,   410,   741,   178,   179,
-     345,   592,   874,   624,   880,   742,   767,     0,   944,   768,
-     946,   810,     0,   351,   181,   182,     0,     0,   183,   184,
-     185,   186,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,   390,   187,     0,     0,   409,   410,   949,     0,     0,
-       0,     0,     0,     0,     0,   960,     0,     0,     0,     0,
-       0,     0,     0,   962,     0,     0,     0,     0,     0,   963,
-       0,     0,   965,     2,     3,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   975,     0,
-       0,     0,     0,   976,   977,     0,     0,   978,   979,     0,
-     -23,     0,   -23,     0,   981,   -23,   -23,   -23,   -23,     4,
-       5,   -23,     0,     0,   -23,   -23,   -23,  -247,  -247,     0,
-       0,   -23,   -23,     0,     0,     0,     6,     7,     0,     0,
-       0,     0,     0,     0,     0,     0,   -23,     0,     0,     0,
-     -23,   -23,     0,     0,     0,   -23,     0,     0,     0,   409,
-     410,   -23,     0,   -23,   -23,     0,   -23,     0,   -23,   -23,
-     -23,   -23,   -23,     0,   -23,   -23,   -23,   -23,   -23,   -23,
-     -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,
-       0,     0,   -23,   -23,   -23,     0,   -23,   -23,   -23,     0,
-     -23,   -23,   -23,     0,     0,   -23,     0,   -23,     0,     0,
-     -23,   -23,   -23,   -23,     0,     0,   -23,   -23,   -23,     0,
-       0,     0,     0,     0,   -23,     0,     0,     8,   -23,   -23,
-     -23,   -23,   -23,   -23,   -23,     0,   -23,   -23,   -23,   -23,
-     -23,     0,     0,   -23,     0,     0,     0,     0,     0,     0,
-     -23,   -23,   -23,     0,     0,     0,     0,     0,     0,   -23,
-       9,  -510,     0,  -510,     0,  -510,  -510,  -510,  -510,  -510,
-      10,  -510,  -510,  -510,  -510,  -510,  -510,     0,     0,  -510,
-    -510,  -510,  -510,  -510,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   152,   153,     0,
-       0,     0,   154,   155,   156,   157,     0,     0,     0,     0,
-       0,     0,     0,     0,   158,   159,   160,   161,   162,   163,
-     164,     0,   165,   166,   167,     0,     0,   168,   169,   170,
-       0,   171,   172,   173,   174,   175,   674,   176,   392,     0,
-     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
-     402,   403,     0,     0,   404,   405,   406,   407,   408,   931,
-       0,   392,     0,   393,   394,   395,   396,   397,     0,   398,
-     399,   400,   401,   402,   403,     0,     0,   404,   405,   406,
-     407,   408,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     178,   179,     0,     0,     0,     0,   180,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   181,   182,     0,     0,
-     183,   184,   185,   186,     0,     0,     0,    91,     0,     0,
-       0,     0,     0,     0,   187,     0,     0,   576,     0,     0,
-       0,     0,     0,  -510,  -510,   973,     0,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,     0,     0,   404,   405,   406,   407,   408,   974,     0,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,   980,     0,   392,     0,   393,   394,   395,   396,   397,
-       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
-     405,   406,   407,   408,     0,     0,     0,     0,   409,   410,
-       0,     0,     0,     0,     0,     0,   896,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,   409,   410,   404,   405,   406,   407,   408,   850,   392,
-       0,   393,   394,   395,   396,   397,     0,   398,   399,   400,
-     401,   402,   403,     0,     0,   404,   405,   406,   407,   408,
-     896,   392,     0,   393,   394,   395,   396,   397,     0,   398,
-     399,   400,   401,   402,   403,     0,     0,   404,   405,   406,
-     407,   408,   945,   392,     0,   393,   394,   395,   396,   397,
-       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
-     405,   406,   407,   408,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   409,   410,     0,
-       0,     0,     0,     0,     0,   964,   392,     0,   393,   394,
-     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
-     409,   410,   404,   405,   406,   407,   408,     0,     0,   392,
-       0,   393,   394,   395,   396,   397,     0,   398,   399,   400,
-     401,   402,   403,   409,   410,   404,   405,   406,   407,   408,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,   631,     0,     0,     0,     0,   409,   410,     0,
-       0,     0,     0,     0,     0,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,   409,
-     410,   404,   405,   406,   407,   408,     0,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,   409,   410,   404,   405,   406,   407,   408,     0,  -250,
-       0,  -250,  -250,  -250,  -250,  -250,     0,  -250,  -250,  -250,
-    -250,  -250,  -250,   409,   410,  -250,  -250,  -250,  -250,  -250,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,   409,   410,   404,   405,
-     406,   407,   408,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   436,     0,     0,     0,     0,   409,
-     410,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,   595,     0,     0,     0,     0,
-     409,   410,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
-     406,   407,   408,     0,     0,     0,     0,     0,     0,     0,
-     602,     0,     0,     0,     0,   409,   410,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   616,     0,     0,     0,     0,   409,   410,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,  -250,     0,     0,     0,     0,  -250,
-    -250,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,   631,     0,     0,     0,     0,
-     409,   410,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   666,     0,     0,
-       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
-     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
-     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
-       0,   404,   405,   406,   407,   408,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   671,     0,     0,
-       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
-     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
-     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
-       0,   404,   405,   406,   407,   408,   392,     0,   393,   394,
-     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
-       0,     0,   404,   405,   406,   407,   408,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,     0,     0,   404,   405,   406,   407,   408,   392,     0,
-     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
-     402,   403,     0,     0,   404,   405,   406,   407,   408,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   673,
-       0,     0,     0,     0,   409,   410,     0,     0,     0,   418,
-       0,   392,     0,   393,   394,   395,   396,   397,     0,   398,
-     399,   400,   401,   402,   403,   409,   410,   404,   405,   406,
-     407,   408,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
-     406,   407,   408,     0,     0,     0,     0,     0,     0,   773,
-       0,     0,     0,     0,   409,   410,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     774,     0,     0,     0,     0,   409,   410,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,   775,     0,     0,     0,     0,   409,   410,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   776,     0,     0,     0,     0,   409,   410,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,   777,     0,     0,     0,     0,   409,   410,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   778,     0,     0,     0,
-       0,   409,   410,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   779,     0,     0,
-       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
-     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
-     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
-       0,   404,   405,   406,   407,   408,   392,     0,   393,   394,
-     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
-       0,     0,   404,   405,   406,   407,   408,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,     0,     0,   404,   405,   406,   407,   408,   392,     0,
-     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
-     402,   403,     0,     0,   404,   405,   406,   407,   408,     0,
-       0,     0,     0,     0,     0,   780,     0,     0,     0,     0,
-     409,   410,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
-     406,   407,   408,   392,     0,   393,   394,   395,   396,   397,
-       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
-     405,   406,   407,   408,     0,     0,     0,     0,     0,    22,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   781,
-       0,     0,     0,     0,   409,   410,     0,     0,     0,     0,
-       0,     0,     0,     0,    28,     0,     0,     0,     0,     0,
-     782,     0,     0,     0,     0,   409,   410,     0,     0,    32,
-       0,     0,     0,     0,    35,   348,     0,     0,     0,    39,
-      40,   783,     0,     0,     0,     0,   409,   410,     0,   349,
-      49,    50,    51,    52,    53,    54,   350,     0,     0,     0,
-       0,     0,   784,     0,     0,     0,     0,   409,   410,    64,
-       0,     0,     0,     0,     0,    67,     0,     0,     0,     0,
-       0,     0,     0,   785,    72,     0,    74,     0,   409,   410,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,     0,     0,     0,     0,     0,   791,     0,     0,
-      91,     0,   409,   410,     0,     0,     0,    92,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   843,     0,
-       0,     0,     0,   409,   410,   392,     0,   393,   394,   395,
-     396,   397,   708,   398,   399,   400,   401,   402,   403,     0,
-     149,   404,   405,   406,   407,   408,     0,     0,     0,   150,
-     151,   709,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   152,   153,     0,
-       0,     0,   154,   155,   156,   157,     0,     0,     0,     0,
-       0,     0,     0,     0,   158,   159,   160,   161,   162,   163,
-     164,     0,   165,   166,   167,     0,     0,   168,   169,   170,
-       0,   171,   172,   173,   174,   175,     0,   176,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   453,     0,
-       0,     0,   454,   455,   456,   457,     0,     0,     0,     0,
-       0,     0,     0,     0,   458,   459,   460,   461,   462,   463,
-     464,     0,   465,   466,   467,   900,     0,   468,   469,   470,
-     409,   410,   471,   472,   473,   474,     0,   475,     0,   177,
-       0,     0,     0,     0,     0,     0,     0,     0,   149,     0,
-     178,   179,     0,     0,     0,     0,   180,   150,   151,     0,
-       0,     0,     0,     0,     0,     0,   181,   182,     0,     0,
-     183,   184,   185,   186,     0,   152,   153,    91,     0,     0,
-     154,   155,   156,   157,   187,   409,   410,   188,     0,     0,
-       0,     0,   158,   159,   160,   161,   162,   163,   164,     0,
-     165,   166,   167,     0,     0,   168,   169,   170,     0,   171,
-     172,   173,   174,   175,     0,   176,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   476,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   177,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   178,   179,
-       0,     0,     0,     0,   180,   809,     0,     0,     0,     0,
-       0,     0,     0,   149,   181,   182,     0,     0,   183,   184,
-     185,   186,   150,   151,     0,    91,     0,     0,     0,     0,
-       0,     0,   187,     0,     0,   188,     0,     0,     0,     0,
-     152,   153,     0,   204,     0,   154,   155,   156,   157,     0,
-       0,     0,     0,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,   894,     0,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,   531,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-     532,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-     650,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,     0,   651,
-       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,   728,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,   532,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   188,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,   633,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,    91,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,     0,   655,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,   657,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-       0,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,   746,     0,
-     747,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,   532,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   748,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,   557,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,   538,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,     0,     0,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,   532,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,     0,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-     733,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,   709,     0,
-       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,   954,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   188,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,    91,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,     0,     0,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,     0,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-       0,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   381,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,     0,     0,
-       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   444,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,     0,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   541,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,   888,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   381,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,   329,   330,   562,     0,   563,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   152,
-     153,     0,     0,     0,   154,   155,   156,   157,     0,     0,
-     332,   333,   334,     0,     0,   335,   158,   159,   160,   161,
-     162,   163,   164,     0,   165,   166,   167,     0,     0,   168,
-     169,   170,   177,   171,   172,   173,   174,   175,     0,   176,
-       0,     0,     0,   178,   179,     0,     0,     0,     0,   180,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,     0,     0,
-      91,     0,     0,     0,     0,     0,     0,   187,     0,     0,
-     917,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   178,   179,     0,     0,     0,     0,   180,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   181,   182,
-       0,     0,   183,   184,   185,   186,   329,   330,   331,   336,
-       0,     0,     0,     0,     0,     0,   187,     0,     0,   564,
-       0,     0,     0,     0,   152,   153,     0,     0,     0,   154,
-     155,   156,   157,     0,     0,   332,   333,   334,     0,     0,
-     335,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,   329,   330,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-     152,   153,     0,     0,     0,   154,   155,   156,   157,     0,
-       0,   332,   333,   334,     0,     0,   335,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   178,   179,     0,
-       0,     0,     0,   180,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,     0,     0,   336,     0,     0,     0,     0,     0,
-       0,   187,     0,    19,   337,     0,    20,   -28,    21,   -28,
-       0,     0,    22,   178,   179,    23,    24,    25,     0,   180,
-       0,     0,    26,    27,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,    28,     0,     0,
-     336,    29,    30,     0,     0,     0,    31,   187,     0,     0,
-     564,     0,    32,     0,    33,    34,     0,    35,     0,    36,
-      37,    38,    39,    40,     0,    41,    42,    43,    44,    45,
-      46,    47,    48,    49,    50,    51,    52,    53,    54,    55,
-      56,     0,     0,    57,    58,    59,     0,    60,    61,    62,
-       0,    63,    64,    65,     0,     0,    66,     0,    67,     0,
-       0,    68,    69,    70,    71,     0,     0,    72,    73,    74,
-       0,     0,     0,     0,     0,    75,     0,     0,     0,    76,
-      77,    78,    79,    80,    81,    82,     0,    83,    84,    85,
-      86,    87,     0,     0,    88,     0,     0,     0,     0,   152,
-     153,    89,    90,    91,   154,   155,   156,   157,     0,     0,
-      92,     0,     0,     0,     0,     0,   158,   159,   160,   161,
-     162,   163,   164,     0,   165,   166,   167,     0,     0,   168,
-     169,   170,     0,   171,   172,   173,   174,   175,     0,   176,
-     152,   153,     0,     0,     0,   154,   155,   156,   157,     0,
-       0,     0,     0,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   178,   179,     0,     0,     0,     0,   180,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   181,   182,
-       0,     0,   183,   184,   185,   186,     0,     0,     0,    91,
-       0,     0,     0,     0,     0,     0,   187,     0,     0,   576,
-       0,     0,     0,   178,   179,     0,     0,     0,     0,   180,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,     0,     0,
-     888,     0,     0,     0,     0,     0,     0,   187,     0,     0,
-     576
-};
-
-static const yytype_int16 yycheck[] =
-{
-      26,   177,    28,   200,   140,    35,    32,   297,    13,    35,
-     274,   177,   188,   289,   278,    41,   414,   716,    46,   499,
-     105,   327,   107,   231,    18,   579,   111,   231,   582,     5,
-       3,   337,   236,   449,   236,    34,     3,   140,     4,     3,
-     346,   177,    70,    71,     4,    24,     3,     4,     3,    23,
-      78,     3,    23,     3,    31,   381,    61,   123,   234,   489,
-      59,    60,   494,   729,    33,     3,    35,   499,   103,     5,
-     140,    21,    22,    23,     3,     3,   125,   112,     3,   177,
-     577,   344,   579,   793,   794,   582,   759,     3,     3,     3,
-      23,     3,     3,     3,     3,     4,   124,   527,   126,   127,
-       3,     3,     3,    23,   130,   169,   169,   137,     3,     3,
-       3,   137,     3,     3,     3,   179,    23,    20,   169,   169,
-     169,    24,   148,   149,   187,   158,    35,    97,   231,    99,
-     169,   157,   179,   236,    21,    22,    23,   187,   143,    20,
-      21,    22,    23,    24,    25,   171,   179,     3,    23,   217,
-     126,   177,     3,    25,   169,   179,    23,    24,    25,    20,
-     123,   176,   188,    24,   863,   189,   192,     5,    24,    20,
-     238,   347,   882,    24,   137,    20,    20,   203,   179,    24,
-      24,   347,   286,   176,   210,    20,   179,   272,   189,    24,
-     126,   327,   169,   219,   260,   169,    80,    81,   224,   865,
-     179,   337,   207,     4,   308,   381,   342,   180,   234,   882,
-     346,   347,   156,   189,   158,   381,   180,   188,   244,   127,
-     187,   187,   921,   180,   327,   180,   231,   187,   180,   234,
-     315,   236,   237,   179,   337,   169,   169,   242,   188,   342,
-     275,   531,   180,   346,    27,   381,   281,   180,   538,   179,
-     285,   180,   180,   258,   158,   180,   255,   327,   564,   179,
-     757,   758,   169,   760,   180,   180,   180,   337,   180,   180,
-     180,   297,   342,   180,   279,   301,   346,   303,   180,   180,
-     586,   587,   588,   589,   590,   180,   180,   180,   126,   180,
-     180,   180,   318,   319,   179,   265,   179,   323,   169,   180,
-     626,   188,   628,   629,   179,   568,   332,   333,   334,   335,
-     413,   316,   575,   185,   186,   320,   179,   311,   185,   186,
-     179,   347,   327,   427,   169,   169,   261,   262,   591,   883,
-     179,   180,   337,   359,   169,    21,    22,   363,   364,   365,
-     366,   367,   368,   369,   370,   371,   372,   373,   374,   179,
-     576,   767,   768,   169,   179,   381,   169,   837,   584,   294,
-     176,     3,     4,   179,   844,   541,   392,   393,   394,   395,
-     396,   397,   398,   399,   400,   401,   402,   403,   404,   405,
-     406,   407,   408,   409,   410,   593,   883,     3,   414,   593,
-     594,   176,   594,     3,   179,    23,   422,   423,     3,   838,
-     839,   840,   841,   507,   508,   837,   838,   839,   840,   841,
-     808,   515,   844,   357,   358,    20,   501,   140,   141,    24,
-       4,   506,   169,   176,   509,   138,   139,   140,   564,    23,
-      24,    25,   376,   377,   378,   379,   380,     3,   728,   936,
-     576,   717,   546,   707,   750,   389,   179,   169,   584,   179,
-     586,   587,   588,   589,   590,   179,   632,   485,   179,   179,
-     626,   564,   628,   629,   179,   491,   792,   793,   794,   495,
-     179,   179,   676,   576,   676,   179,   502,   681,   179,   681,
-     179,   584,   745,   586,   587,   588,   589,   590,   179,   179,
-     593,   594,   179,   189,   564,   179,   179,   179,   179,   762,
-     763,   764,   765,   766,   179,   531,   576,   179,   179,   179,
-     179,   537,   538,   179,   584,   541,   586,   587,   588,   589,
-     590,   179,   179,   169,     5,   169,     7,     8,     9,    10,
-      11,     3,    13,    14,    15,    16,    17,    18,     4,   565,
-      21,    22,    23,    24,    25,   169,   169,     3,   574,     3,
-      20,    21,    22,    23,    24,    25,    20,    21,    22,    23,
-      24,    25,     5,   169,     3,   595,   169,   179,   169,   595,
-     596,   169,   748,   676,     3,     3,   169,   867,   681,     4,
-      11,   180,    13,    14,    15,    16,    17,    18,   593,   594,
-      21,    22,    23,    24,    25,    21,    22,    23,    24,    25,
-     626,   176,   628,   629,     3,   176,   632,   633,    20,    21,
-      22,    23,    24,    25,   750,     5,   792,   814,   881,     3,
-     179,   725,   179,   759,   650,   651,   792,   793,   794,   655,
-     700,   657,   132,     3,     3,   661,     3,   741,    20,    21,
-      22,    23,    24,    25,     3,   749,   189,   750,   674,   675,
-       3,   180,   180,     3,     3,   179,   759,   169,    24,   179,
-     169,   687,   667,   689,   169,   179,   169,   180,     3,   180,
-     878,   676,     5,   180,   176,     3,   681,     3,   683,    25,
-     750,     3,   708,    13,    14,    15,    16,    17,    18,   759,
-       3,    21,    22,    23,    24,    25,     3,   180,   179,     4,
-     180,   169,   728,    84,   185,   186,   180,   180,   189,   714,
-     180,    30,   816,    24,   740,    24,   180,   179,   744,     9,
-      10,    11,   748,    13,    14,    15,    16,    17,    18,    24,
-      23,    21,    22,    23,    24,    25,     4,   169,   180,   169,
-     180,   917,     4,   126,     3,   750,   882,    20,     3,     5,
-     169,   169,     5,   180,   185,   186,   179,     3,   862,   180,
-     180,    24,    29,   180,   180,   180,   792,   793,   794,   873,
-     180,   180,   180,     3,   188,   126,   180,   180,   169,   882,
-     169,   258,   808,   809,    10,     3,    14,     5,   906,     7,
-       8,     9,    10,    11,   904,    13,    14,    15,    16,    17,
-      18,   428,   528,    21,    22,    23,    24,    25,   685,   689,
-     498,   511,   882,    80,    81,    82,   268,   493,   537,   304,
-     416,   721,   848,   848,   850,    76,   852,    13,    14,    15,
-      16,    17,    18,   850,   675,    21,    22,    23,    24,    25,
-     897,   867,   109,   748,   111,   112,   113,   955,   871,   116,
-     117,   143,   119,   120,   959,   185,   186,   555,   142,   143,
-     140,   347,   744,   381,   750,   557,   593,    -1,   894,   594,
-     896,   897,    -1,   878,   158,   159,    -1,    -1,   162,   163,
-     164,   165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   917,   176,    -1,    -1,   185,   186,   902,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   931,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   939,    -1,    -1,    -1,    -1,    -1,   945,
-      -1,    -1,   948,     0,     1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   964,    -1,
-      -1,    -1,    -1,   969,   970,    -1,    -1,   973,   974,    -1,
-      27,    -1,    29,    -1,   980,    32,    33,    34,    35,    36,
-      37,    38,    -1,    -1,    41,    42,    43,   185,   186,    -1,
-      -1,    48,    49,    -1,    -1,    -1,    53,    54,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    63,    -1,    -1,    -1,
-      67,    68,    -1,    -1,    -1,    72,    -1,    -1,    -1,   185,
-     186,    78,    -1,    80,    81,    -1,    83,    -1,    85,    86,
-      87,    88,    89,    -1,    91,    92,    93,    94,    95,    96,
-      97,    98,    99,   100,   101,   102,   103,   104,   105,   106,
-      -1,    -1,   109,   110,   111,    -1,   113,   114,   115,    -1,
-     117,   118,   119,    -1,    -1,   122,    -1,   124,    -1,    -1,
-     127,   128,   129,   130,    -1,    -1,   133,   134,   135,    -1,
-      -1,    -1,    -1,    -1,   141,    -1,    -1,   144,   145,   146,
-     147,   148,   149,   150,   151,    -1,   153,   154,   155,   156,
-     157,    -1,    -1,   160,    -1,    -1,    -1,    -1,    -1,    -1,
-     167,   168,   169,    -1,    -1,    -1,    -1,    -1,    -1,   176,
-     177,     3,    -1,     5,    -1,     7,     8,     9,    10,    11,
-     187,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,    40,    -1,
-      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
-      62,    -1,    64,    65,    66,    -1,    -1,    69,    70,    71,
-      -1,    73,    74,    75,    76,    77,     3,    79,     5,    -1,
-       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
-      17,    18,    -1,    -1,    21,    22,    23,    24,    25,     3,
-      -1,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
-      14,    15,    16,    17,    18,    -1,    -1,    21,    22,    23,
-      24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     142,   143,    -1,    -1,    -1,    -1,   148,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,
-     162,   163,   164,   165,    -1,    -1,    -1,   169,    -1,    -1,
-      -1,    -1,    -1,    -1,   176,    -1,    -1,   179,    -1,    -1,
-      -1,    -1,    -1,   185,   186,     3,    -1,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,    -1,    -1,    21,    22,    23,    24,    25,     3,    -1,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,     3,    -1,     5,    -1,     7,     8,     9,    10,    11,
-      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,   185,   186,
-      -1,    -1,    -1,    -1,    -1,    -1,     4,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,   185,   186,    21,    22,    23,    24,    25,     4,     5,
-      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
-      16,    17,    18,    -1,    -1,    21,    22,    23,    24,    25,
-       4,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
-      14,    15,    16,    17,    18,    -1,    -1,    21,    22,    23,
-      24,    25,     4,     5,    -1,     7,     8,     9,    10,    11,
-      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   185,   186,    -1,
-      -1,    -1,    -1,    -1,    -1,     4,     5,    -1,     7,     8,
-       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
-     185,   186,    21,    22,    23,    24,    25,    -1,    -1,     5,
-      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
-      16,    17,    18,   185,   186,    21,    22,    23,    24,    25,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
-      -1,    -1,    -1,    -1,    -1,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,   185,
-     186,    21,    22,    23,    24,    25,    -1,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,   185,   186,    21,    22,    23,    24,    25,    -1,     5,
-      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
-      16,    17,    18,   185,   186,    21,    22,    23,    24,    25,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,   185,   186,    21,    22,
-      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,
-     186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
-     185,   186,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
-      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,
-     186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
-     185,   186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
-      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
-      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
-      -1,    21,    22,    23,    24,    25,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
-      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
-      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
-      -1,    21,    22,    23,    24,    25,     5,    -1,     7,     8,
-       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
-      -1,    -1,    21,    22,    23,    24,    25,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,    -1,    -1,    21,    22,    23,    24,    25,     5,    -1,
-       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
-      17,    18,    -1,    -1,    21,    22,    23,    24,    25,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,
-      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,   169,
-      -1,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
-      14,    15,    16,    17,    18,   185,   186,    21,    22,    23,
-      24,    25,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
-      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,   180,
-      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,
-      -1,   185,   186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
-      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
-      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
-      -1,    21,    22,    23,    24,    25,     5,    -1,     7,     8,
-       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
-      -1,    -1,    21,    22,    23,    24,    25,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,    -1,    -1,    21,    22,    23,    24,    25,     5,    -1,
-       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
-      17,    18,    -1,    -1,    21,    22,    23,    24,    25,    -1,
-      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
-     185,   186,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
-      23,    24,    25,     5,    -1,     7,     8,     9,    10,    11,
-      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    38,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,
-      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    63,    -1,    -1,    -1,    -1,    -1,
-     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    78,
-      -1,    -1,    -1,    -1,    83,    84,    -1,    -1,    -1,    88,
-      89,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,    98,
-      99,   100,   101,   102,   103,   104,   105,    -1,    -1,    -1,
-      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,   118,
-      -1,    -1,    -1,    -1,    -1,   124,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   180,   133,    -1,   135,    -1,   185,   186,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-     169,    -1,   185,   186,    -1,    -1,    -1,   176,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,
-      -1,    -1,    -1,   185,   186,     5,    -1,     7,     8,     9,
-      10,    11,     4,    13,    14,    15,    16,    17,    18,    -1,
-      12,    21,    22,    23,    24,    25,    -1,    -1,    -1,    21,
-      22,    23,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,    40,    -1,
-      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
-      62,    -1,    64,    65,    66,    -1,    -1,    69,    70,    71,
-      -1,    73,    74,    75,    76,    77,    -1,    79,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    40,    -1,
-      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
-      62,    -1,    64,    65,    66,   180,    -1,    69,    70,    71,
-     185,   186,    74,    75,    76,    77,    -1,    79,    -1,   131,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,
-     142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,
-     162,   163,   164,   165,    -1,    39,    40,   169,    -1,    -1,
-      44,    45,    46,    47,   176,   185,   186,   179,    -1,    -1,
-      -1,    -1,    56,    57,    58,    59,    60,    61,    62,    -1,
-      64,    65,    66,    -1,    -1,    69,    70,    71,    -1,    73,
-      74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   169,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   142,   143,
-      -1,    -1,    -1,    -1,   148,     4,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,   158,   159,    -1,    -1,   162,   163,
-     164,   165,    21,    22,    -1,   169,    -1,    -1,    -1,    -1,
-      -1,    -1,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,
-      39,    40,    -1,   187,    -1,    44,    45,    46,    47,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,     4,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,     5,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      23,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-       5,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,    24,
-      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,     5,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,     5,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,    -1,     5,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,     5,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    23,    -1,
-      25,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    23,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    23,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      23,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    23,    -1,
-      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    21,    22,    23,    -1,    25,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,
-      40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,    -1,
-      50,    51,    52,    -1,    -1,    55,    56,    57,    58,    59,
-      60,    61,    62,    -1,    64,    65,    66,    -1,    -1,    69,
-      70,    71,   131,    73,    74,    75,    76,    77,    -1,    79,
-      -1,    -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,
-     169,    -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,
-      -1,    -1,   162,   163,   164,   165,    21,    22,    23,   169,
-      -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,   179,
-      -1,    -1,    -1,    -1,    39,    40,    -1,    -1,    -1,    44,
-      45,    46,    47,    -1,    -1,    50,    51,    52,    -1,    -1,
-      55,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    21,    22,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      39,    40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,
-      -1,    50,    51,    52,    -1,    -1,    55,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    -1,    -1,   169,    -1,    -1,    -1,    -1,    -1,
-      -1,   176,    -1,    29,   179,    -1,    32,    33,    34,    35,
-      -1,    -1,    38,   142,   143,    41,    42,    43,    -1,   148,
-      -1,    -1,    48,    49,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    63,    -1,    -1,
-     169,    67,    68,    -1,    -1,    -1,    72,   176,    -1,    -1,
-     179,    -1,    78,    -1,    80,    81,    -1,    83,    -1,    85,
-      86,    87,    88,    89,    -1,    91,    92,    93,    94,    95,
-      96,    97,    98,    99,   100,   101,   102,   103,   104,   105,
-     106,    -1,    -1,   109,   110,   111,    -1,   113,   114,   115,
-      -1,   117,   118,   119,    -1,    -1,   122,    -1,   124,    -1,
-      -1,   127,   128,   129,   130,    -1,    -1,   133,   134,   135,
-      -1,    -1,    -1,    -1,    -1,   141,    -1,    -1,    -1,   145,
-     146,   147,   148,   149,   150,   151,    -1,   153,   154,   155,
-     156,   157,    -1,    -1,   160,    -1,    -1,    -1,    -1,    39,
-      40,   167,   168,   169,    44,    45,    46,    47,    -1,    -1,
-     176,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,    59,
-      60,    61,    62,    -1,    64,    65,    66,    -1,    -1,    69,
-      70,    71,    -1,    73,    74,    75,    76,    77,    -1,    79,
-      39,    40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,
-      -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,   169,
-      -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,   179,
-      -1,    -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,
-     169,    -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,
-     179
-};
-
-/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
-   symbol of state STATE-NUM.  */
-static const yytype_uint16 yystos[] =
-{
-       0,   191,     0,     1,    36,    37,    53,    54,   144,   177,
-     187,   192,   197,   199,   205,   201,   198,   177,   200,    29,
-      32,    34,    38,    41,    42,    43,    48,    49,    63,    67,
-      68,    72,    78,    80,    81,    83,    85,    86,    87,    88,
-      89,    91,    92,    93,    94,    95,    96,    97,    98,    99,
-     100,   101,   102,   103,   104,   105,   106,   109,   110,   111,
-     113,   114,   115,   117,   118,   119,   122,   124,   127,   128,
-     129,   130,   133,   134,   135,   141,   145,   146,   147,   148,
-     149,   150,   151,   153,   154,   155,   156,   157,   160,   167,
-     168,   169,   176,   193,   194,   195,   202,   203,   206,   212,
-     224,   225,   228,   229,   234,   235,   237,   238,   239,   240,
-     241,   243,   244,   251,   253,   257,   258,   261,   262,   263,
-     298,   308,   309,   315,   316,   317,   318,   319,   321,   326,
-     327,   328,   330,   331,   333,   336,   337,   340,   341,   349,
-     351,   352,   365,   372,   201,   205,   169,   204,   179,    12,
-      21,    22,    39,    40,    44,    45,    46,    47,    56,    57,
-      58,    59,    60,    61,    62,    64,    65,    66,    69,    70,
-      71,    73,    74,    75,    76,    77,    79,   131,   142,   143,
-     148,   158,   159,   162,   163,   164,   165,   176,   179,   280,
-     281,   283,   284,   288,   290,   291,   292,   293,   298,   299,
-     300,   307,   320,   179,   187,   280,   304,   179,   217,   218,
-     179,   280,   303,     4,   187,   221,   187,   221,   304,   179,
-     169,   187,   324,   176,   179,   364,   280,   169,   325,   169,
-     324,   179,   169,   176,   179,   346,   179,   179,   221,   221,
-      20,    24,   247,   298,   179,   216,   123,   137,   127,   324,
-     324,   169,   252,    80,    81,   213,   275,   324,    27,   196,
-     198,    33,    35,   196,   158,   207,   196,   169,   179,   249,
-     250,   169,   226,   231,     3,   248,   169,   230,   247,     3,
-     236,   248,     3,   248,     3,   248,   169,   245,   246,   247,
-       3,     4,    35,   222,   223,   255,   271,   169,   176,   268,
-      23,   179,   259,    23,   179,   266,    23,     4,   329,   169,
-     310,   200,   324,   324,   324,   176,   323,   280,     5,   126,
-     189,   332,     3,   179,   334,   169,   304,   179,   345,    21,
-      22,    23,    50,    51,    52,    55,   169,   179,   281,   288,
-     299,   343,   345,   350,   353,   354,   355,   345,    84,    98,
-     105,   298,   328,   280,   280,   280,   282,   179,   179,   179,
-     282,   280,   282,   179,   179,   179,   179,   179,   179,   179,
-     179,   179,   179,   179,   179,   280,   179,   179,   179,   179,
-     179,   179,   280,   281,   283,   307,   360,   361,   362,   179,
-     280,   283,     5,     7,     8,     9,    10,    11,    13,    14,
-      15,    16,    17,    18,    21,    22,    23,    24,    25,   185,
-     186,   285,   280,   189,   179,   302,   179,   179,   169,   158,
-     301,   302,     3,     4,   180,   280,   219,   298,     3,   280,
-       4,   169,   242,   242,   280,   280,   180,   288,   292,   298,
-     330,   366,   367,   368,   176,   283,   298,   298,   367,   369,
-     298,   371,   242,    40,    44,    45,    46,    47,    56,    57,
-      58,    59,    60,    61,    62,    64,    65,    66,    69,    70,
-      71,    74,    75,    76,    77,    79,   169,   214,   215,   169,
-     298,   220,   280,     3,     3,   221,   194,   200,   204,   204,
-     196,     5,   249,     3,    24,   179,   187,   248,     3,    24,
-     230,   247,   179,   276,   230,   298,   247,   169,   169,   247,
-     276,     3,   245,    29,    82,   109,   111,   112,   113,   116,
-     117,   119,   120,   272,   273,   275,     4,   204,     3,   256,
-     254,     5,    23,   269,   280,   180,   176,   179,   169,   260,
-     269,   179,   267,   280,   268,   176,   276,     3,   205,   248,
-     298,   322,   373,   280,   280,   298,   176,    23,   280,   335,
-     338,   339,    23,    25,   179,   298,   347,   348,   353,   354,
-     280,   280,   280,   280,     5,   353,   179,   281,   288,   299,
-     342,   356,   357,   358,     3,   344,    20,    23,    24,    25,
-     355,   353,   360,   179,   179,   180,     3,   180,   282,   282,
-     280,   180,   180,   180,   280,   280,   280,   280,   280,   280,
-     280,   280,   280,   280,   280,   280,   180,   282,   282,   282,
-     282,   282,   280,   283,   361,   362,     3,   132,     3,     3,
-     282,   180,     3,     5,   280,   287,   280,   280,   280,   280,
-     280,   280,   280,   280,   280,   280,   280,   280,   280,   280,
-       5,    24,   280,   286,   280,     5,   280,     5,   280,   288,
-     303,   289,   294,   294,   280,   280,   180,     3,   180,   276,
-     218,   180,     3,   180,     3,   179,     3,   370,   180,   180,
-     180,     3,   370,     3,   180,     3,    24,     3,   180,   179,
-     169,   324,   179,   208,   208,   280,   180,   250,   227,   232,
-     233,   284,   280,   169,   169,   231,   227,   248,     4,    23,
-     277,   278,   279,   280,   248,   276,   276,   248,   246,   276,
-     179,     3,     4,   208,   254,   169,   269,   260,     5,   269,
-     180,     3,   270,    23,   180,   276,    31,   169,   311,   312,
-       5,   329,   364,   180,     3,   353,    23,    25,   179,   280,
-       3,   180,   180,   280,   180,   356,   285,   359,   359,     3,
-     359,   356,   353,   353,   353,   353,   353,   366,   369,   304,
-     280,   180,   180,   180,   180,   180,   180,   180,   180,   180,
-     180,   180,   180,   180,   180,   180,   180,   180,   180,   180,
-     180,   180,     3,     3,     3,   280,   362,   280,   362,   280,
-     362,   180,   283,   280,   280,   280,   280,   280,     4,     4,
-     280,   295,   296,   297,   180,   180,   298,   169,    84,   280,
-     295,   125,   367,   180,   367,   180,   298,   214,   280,   220,
-      23,   169,   180,   210,   211,    30,    24,     3,    21,    22,
-      23,   188,   299,   180,    24,    24,   230,   280,     3,   180,
-       4,   298,    23,   264,   264,   245,   138,   139,   140,   274,
-     273,     4,   169,   276,   180,   269,   270,   169,   180,     4,
-     126,     3,   280,   276,   339,   180,   280,   297,   189,   276,
-     348,   353,     3,   180,   285,   358,   370,   370,   169,   363,
-     363,   363,   180,   303,     4,   280,     4,     3,   302,   276,
-     180,   180,     5,   180,     3,   180,   179,   209,   227,   232,
-     232,   232,   232,   227,   278,   279,   280,   179,   265,   280,
-     180,   276,   264,   270,   269,   169,   187,   313,   314,   169,
-     312,     3,   276,   180,   330,   363,   359,   180,   180,     5,
-     180,   180,   180,   180,   280,     4,   280,   296,     3,   298,
-     211,   180,   210,    24,    23,   264,   305,   306,   126,     3,
-     280,   180,   280,   280,     4,   280,   180,   180,   305,     5,
-     126,   169,   314,     3,     3,   280,   280,   280,   280,   280,
-       3,   280
-};
-
-#define yyerrok		(yyerrstatus = 0)
-#define yyclearin	(yychar = YYEMPTY)
-#define YYEMPTY		(-2)
-#define YYEOF		0
-
-#define YYACCEPT	goto yyacceptlab
-#define YYABORT		goto yyabortlab
-#define YYERROR		goto yyerrorlab
-
-
-/* Like YYERROR except do call yyerror.  This remains here temporarily
-   to ease the transition to the new meaning of YYERROR, for GCC.
-   Once GCC version 2 has supplanted version 1, this can go.  */
-
-#define YYFAIL		goto yyerrlab
-
-#define YYRECOVERING()  (!!yyerrstatus)
-
-#define YYBACKUP(Token, Value)					\
-do								\
-  if (yychar == YYEMPTY && yylen == 1)				\
-    {								\
-      yychar = (Token);						\
-      yylval = (Value);						\
-      yytoken = YYTRANSLATE (yychar);				\
-      YYPOPSTACK (1);						\
-      goto yybackup;						\
-    }								\
-  else								\
-    {								\
-      yyerror (YY_("syntax error: cannot back up")); \
-      YYERROR;							\
-    }								\
-while (YYID (0))
-
-
-#define YYTERROR	1
-#define YYERRCODE	256
-
-
-/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
-   If N is 0, then set CURRENT to the empty location which ends
-   the previous symbol: RHS[0] (always defined).  */
-
-#define YYRHSLOC(Rhs, K) ((Rhs)[K])
-#ifndef YYLLOC_DEFAULT
-# define YYLLOC_DEFAULT(Current, Rhs, N)				\
-    do									\
-      if (YYID (N))                                                    \
-	{								\
-	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
-	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
-	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
-	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
-	}								\
-      else								\
-	{								\
-	  (Current).first_line   = (Current).last_line   =		\
-	    YYRHSLOC (Rhs, 0).last_line;				\
-	  (Current).first_column = (Current).last_column =		\
-	    YYRHSLOC (Rhs, 0).last_column;				\
-	}								\
-    while (YYID (0))
-#endif
-
-
-/* YY_LOCATION_PRINT -- Print the location on the stream.
-   This macro was not mandated originally: define only if we know
-   we won't break user code: when these are the locations we know.  */
-
-#ifndef YY_LOCATION_PRINT
-# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
-#  define YY_LOCATION_PRINT(File, Loc)			\
-     fprintf (File, "%d.%d-%d.%d",			\
-	      (Loc).first_line, (Loc).first_column,	\
-	      (Loc).last_line,  (Loc).last_column)
-# else
-#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
-# endif
-#endif
-
-
-/* YYLEX -- calling `yylex' with the right arguments.  */
-
-#ifdef YYLEX_PARAM
-# define YYLEX yylex (YYLEX_PARAM)
-#else
-# define YYLEX yylex ()
-#endif
-
-/* Enable debugging if requested.  */
-#if YYDEBUG
-
-# ifndef YYFPRINTF
-#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
-#  define YYFPRINTF fprintf
-# endif
-
-# define YYDPRINTF(Args)			\
-do {						\
-  if (yydebug)					\
-    YYFPRINTF Args;				\
-} while (YYID (0))
-
-# define YY_SYMBOL_PRINT(Title, Type, Value, Location)			  \
-do {									  \
-  if (yydebug)								  \
-    {									  \
-      YYFPRINTF (stderr, "%s ", Title);					  \
-      yy_symbol_print (stderr,						  \
-		  Type, Value); \
-      YYFPRINTF (stderr, "\n");						  \
-    }									  \
-} while (YYID (0))
-
-
-/*--------------------------------.
-| Print this symbol on YYOUTPUT.  |
-`--------------------------------*/
-
-/*ARGSUSED*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static void
-yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
-#else
-static void
-yy_symbol_value_print (yyoutput, yytype, yyvaluep)
-    FILE *yyoutput;
-    int yytype;
-    YYSTYPE const * const yyvaluep;
-#endif
-{
-  if (!yyvaluep)
-    return;
-# ifdef YYPRINT
-  if (yytype < YYNTOKENS)
-    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
-# else
-  YYUSE (yyoutput);
-# endif
-  switch (yytype)
-    {
-      default:
-	break;
-    }
-}
-
-
-/*--------------------------------.
-| Print this symbol on YYOUTPUT.  |
-`--------------------------------*/
-
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static void
-yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
-#else
-static void
-yy_symbol_print (yyoutput, yytype, yyvaluep)
-    FILE *yyoutput;
-    int yytype;
-    YYSTYPE const * const yyvaluep;
-#endif
-{
-  if (yytype < YYNTOKENS)
-    YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
-  else
-    YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
-
-  yy_symbol_value_print (yyoutput, yytype, yyvaluep);
-  YYFPRINTF (yyoutput, ")");
-}
-
-/*------------------------------------------------------------------.
-| yy_stack_print -- Print the state stack from its BOTTOM up to its |
-| TOP (included).                                                   |
-`------------------------------------------------------------------*/
-
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static void
-yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
-#else
-static void
-yy_stack_print (bottom, top)
-    yytype_int16 *bottom;
-    yytype_int16 *top;
-#endif
-{
-  YYFPRINTF (stderr, "Stack now");
-  for (; bottom <= top; ++bottom)
-    YYFPRINTF (stderr, " %d", *bottom);
-  YYFPRINTF (stderr, "\n");
-}
-
-# define YY_STACK_PRINT(Bottom, Top)				\
-do {								\
-  if (yydebug)							\
-    yy_stack_print ((Bottom), (Top));				\
-} while (YYID (0))
-
-
-/*------------------------------------------------.
-| Report that the YYRULE is going to be reduced.  |
-`------------------------------------------------*/
-
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static void
-yy_reduce_print (YYSTYPE *yyvsp, int yyrule)
-#else
-static void
-yy_reduce_print (yyvsp, yyrule)
-    YYSTYPE *yyvsp;
-    int yyrule;
-#endif
-{
-  int yynrhs = yyr2[yyrule];
-  int yyi;
-  unsigned long int yylno = yyrline[yyrule];
-  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
-	     yyrule - 1, yylno);
-  /* The symbols being reduced.  */
-  for (yyi = 0; yyi < yynrhs; yyi++)
-    {
-      fprintf (stderr, "   $%d = ", yyi + 1);
-      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
-		       &(yyvsp[(yyi + 1) - (yynrhs)])
-		       		       );
-      fprintf (stderr, "\n");
-    }
-}
-
-# define YY_REDUCE_PRINT(Rule)		\
-do {					\
-  if (yydebug)				\
-    yy_reduce_print (yyvsp, Rule); \
-} while (YYID (0))
-
-/* Nonzero means print parse trace.  It is left uninitialized so that
-   multiple parsers can coexist.  */
-int yydebug;
-#else /* !YYDEBUG */
-# define YYDPRINTF(Args)
-# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
-# define YY_STACK_PRINT(Bottom, Top)
-# define YY_REDUCE_PRINT(Rule)
-#endif /* !YYDEBUG */
-
-
-/* YYINITDEPTH -- initial size of the parser's stacks.  */
-#ifndef	YYINITDEPTH
-# define YYINITDEPTH 200
-#endif
-
-/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
-   if the built-in stack extension method is used).
-
-   Do not make this value too large; the results are undefined if
-   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
-   evaluated with infinite-precision integer arithmetic.  */
-
-#ifndef YYMAXDEPTH
-# define YYMAXDEPTH 10000
-#endif
-
-
-
-
-#if YYERROR_VERBOSE
-
-# ifndef yystrlen
-#  if defined __GLIBC__ && defined _STRING_H
-#   define yystrlen strlen
-#  else
-/* Return the length of YYSTR.  */
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static YYSIZE_T
-yystrlen (const char *yystr)
-#else
-static YYSIZE_T
-yystrlen (yystr)
-    const char *yystr;
-#endif
-{
-  YYSIZE_T yylen;
-  for (yylen = 0; yystr[yylen]; yylen++)
-    continue;
-  return yylen;
-}
-#  endif
-# endif
-
-# ifndef yystpcpy
-#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
-#   define yystpcpy stpcpy
-#  else
-/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
-   YYDEST.  */
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static char *
-yystpcpy (char *yydest, const char *yysrc)
-#else
-static char *
-yystpcpy (yydest, yysrc)
-    char *yydest;
-    const char *yysrc;
-#endif
-{
-  char *yyd = yydest;
-  const char *yys = yysrc;
-
-  while ((*yyd++ = *yys++) != '\0')
-    continue;
-
-  return yyd - 1;
-}
-#  endif
-# endif
-
-# ifndef yytnamerr
-/* Copy to YYRES the contents of YYSTR after stripping away unnecessary
-   quotes and backslashes, so that it's suitable for yyerror.  The
-   heuristic is that double-quoting is unnecessary unless the string
-   contains an apostrophe, a comma, or backslash (other than
-   backslash-backslash).  YYSTR is taken from yytname.  If YYRES is
-   null, do not copy; instead, return the length of what the result
-   would have been.  */
-static YYSIZE_T
-yytnamerr (char *yyres, const char *yystr)
-{
-  if (*yystr == '"')
-    {
-      YYSIZE_T yyn = 0;
-      char const *yyp = yystr;
-
-      for (;;)
-	switch (*++yyp)
-	  {
-	  case '\'':
-	  case ',':
-	    goto do_not_strip_quotes;
-
-	  case '\\':
-	    if (*++yyp != '\\')
-	      goto do_not_strip_quotes;
-	    /* Fall through.  */
-	  default:
-	    if (yyres)
-	      yyres[yyn] = *yyp;
-	    yyn++;
-	    break;
-
-	  case '"':
-	    if (yyres)
-	      yyres[yyn] = '\0';
-	    return yyn;
-	  }
-    do_not_strip_quotes: ;
-    }
-
-  if (! yyres)
-    return yystrlen (yystr);
-
-  return yystpcpy (yyres, yystr) - yyres;
-}
-# endif
-
-/* Copy into YYRESULT an error message about the unexpected token
-   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
-   including the terminating null byte.  If YYRESULT is null, do not
-   copy anything; just return the number of bytes that would be
-   copied.  As a special case, return 0 if an ordinary "syntax error"
-   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
-   size calculation.  */
-static YYSIZE_T
-yysyntax_error (char *yyresult, int yystate, int yychar)
-{
-  int yyn = yypact[yystate];
-
-  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
-    return 0;
-  else
-    {
-      int yytype = YYTRANSLATE (yychar);
-      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
-      YYSIZE_T yysize = yysize0;
-      YYSIZE_T yysize1;
-      int yysize_overflow = 0;
-      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
-      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
-      int yyx;
-
-# if 0
-      /* This is so xgettext sees the translatable formats that are
-	 constructed on the fly.  */
-      YY_("syntax error, unexpected %s");
-      YY_("syntax error, unexpected %s, expecting %s");
-      YY_("syntax error, unexpected %s, expecting %s or %s");
-      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
-      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
-# endif
-      char *yyfmt;
-      char const *yyf;
-      static char const yyunexpected[] = "syntax error, unexpected %s";
-      static char const yyexpecting[] = ", expecting %s";
-      static char const yyor[] = " or %s";
-      char yyformat[sizeof yyunexpected
-		    + sizeof yyexpecting - 1
-		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
-		       * (sizeof yyor - 1))];
-      char const *yyprefix = yyexpecting;
-
-      /* Start YYX at -YYN if negative to avoid negative indexes in
-	 YYCHECK.  */
-      int yyxbegin = yyn < 0 ? -yyn : 0;
-
-      /* Stay within bounds of both yycheck and yytname.  */
-      int yychecklim = YYLAST - yyn + 1;
-      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
-      int yycount = 1;
-
-      yyarg[0] = yytname[yytype];
-      yyfmt = yystpcpy (yyformat, yyunexpected);
-
-      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
-	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
-	  {
-	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
-	      {
-		yycount = 1;
-		yysize = yysize0;
-		yyformat[sizeof yyunexpected - 1] = '\0';
-		break;
-	      }
-	    yyarg[yycount++] = yytname[yyx];
-	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
-	    yysize_overflow |= (yysize1 < yysize);
-	    yysize = yysize1;
-	    yyfmt = yystpcpy (yyfmt, yyprefix);
-	    yyprefix = yyor;
-	  }
-
-      yyf = YY_(yyformat);
-      yysize1 = yysize + yystrlen (yyf);
-      yysize_overflow |= (yysize1 < yysize);
-      yysize = yysize1;
-
-      if (yysize_overflow)
-	return YYSIZE_MAXIMUM;
-
-      if (yyresult)
-	{
-	  /* Avoid sprintf, as that infringes on the user's name space.
-	     Don't have undefined behavior even if the translation
-	     produced a string with the wrong number of "%s"s.  */
-	  char *yyp = yyresult;
-	  int yyi = 0;
-	  while ((*yyp = *yyf) != '\0')
-	    {
-	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
-		{
-		  yyp += yytnamerr (yyp, yyarg[yyi++]);
-		  yyf += 2;
-		}
-	      else
-		{
-		  yyp++;
-		  yyf++;
-		}
-	    }
-	}
-      return yysize;
-    }
-}
-#endif /* YYERROR_VERBOSE */
-
-
-
-/*-----------------------------------------------.
-| Release the memory associated to this symbol.  |
-`-----------------------------------------------*/
-
-/*ARGSUSED*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static void
-yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep)
-#else
-static void
-yydestruct (yymsg, yytype, yyvaluep)
-    const char *yymsg;
-    int yytype;
-    YYSTYPE *yyvaluep;
-#endif
-{
-  YYUSE (yyvaluep);
-
-  if (!yymsg)
-    yymsg = "Deleting";
-  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
-
-  switch (yytype)
-    {
-
-      default:
-	break;
-    }
-}
-
-
-
-/* Prevent warnings from -Wmissing-prototypes.  */
-
-#ifdef YYPARSE_PARAM
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void *YYPARSE_PARAM);
-#else
-int yyparse ();
-#endif
-#else /* ! YYPARSE_PARAM */
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void);
-#else
-int yyparse ();
-#endif
-#endif /* ! YYPARSE_PARAM */
-
-
-
-/* The look-ahead symbol.  */
-int yychar;
-
-/* The semantic value of the look-ahead symbol.  */
-YYSTYPE yylval;
-
-/* Number of syntax errors so far.  */
-int yynerrs;
-
-
-
-/*----------.
-| yyparse.  |
-`----------*/
-
-#ifdef YYPARSE_PARAM
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-int
-yyparse (void *YYPARSE_PARAM)
-#else
-int
-yyparse (YYPARSE_PARAM)
-    void *YYPARSE_PARAM;
-#endif
-#else /* ! YYPARSE_PARAM */
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-int
-yyparse (void)
-#else
-int
-yyparse ()
-
-#endif
-#endif
-{
-  
-  int yystate;
-  int yyn;
-  int yyresult;
-  /* Number of tokens to shift before error messages enabled.  */
-  int yyerrstatus;
-  /* Look-ahead token as an internal (translated) token number.  */
-  int yytoken = 0;
-#if YYERROR_VERBOSE
-  /* Buffer for error messages, and its allocated size.  */
-  char yymsgbuf[128];
-  char *yymsg = yymsgbuf;
-  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
-#endif
-
-  /* Three stacks and their tools:
-     `yyss': related to states,
-     `yyvs': related to semantic values,
-     `yyls': related to locations.
-
-     Refer to the stacks thru separate pointers, to allow yyoverflow
-     to reallocate them elsewhere.  */
-
-  /* The state stack.  */
-  yytype_int16 yyssa[YYINITDEPTH];
-  yytype_int16 *yyss = yyssa;
-  yytype_int16 *yyssp;
-
-  /* The semantic value stack.  */
-  YYSTYPE yyvsa[YYINITDEPTH];
-  YYSTYPE *yyvs = yyvsa;
-  YYSTYPE *yyvsp;
-
-
-
-#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N))
-
-  YYSIZE_T yystacksize = YYINITDEPTH;
-
-  /* The variables used to return semantic value and location from the
-     action routines.  */
-  YYSTYPE yyval;
-
-
-  /* The number of symbols on the RHS of the reduced rule.
-     Keep to zero when no symbol should be popped.  */
-  int yylen = 0;
-
-  YYDPRINTF ((stderr, "Starting parse\n"));
-
-  yystate = 0;
-  yyerrstatus = 0;
-  yynerrs = 0;
-  yychar = YYEMPTY;		/* Cause a token to be read.  */
-
-  /* Initialize stack pointers.
-     Waste one element of value and location stack
-     so that they stay on the same level as the state stack.
-     The wasted elements are never initialized.  */
-
-  yyssp = yyss;
-  yyvsp = yyvs;
-
-  goto yysetstate;
-
-/*------------------------------------------------------------.
-| yynewstate -- Push a new state, which is found in yystate.  |
-`------------------------------------------------------------*/
- yynewstate:
-  /* In all cases, when you get here, the value and location stacks
-     have just been pushed.  So pushing a state here evens the stacks.  */
-  yyssp++;
-
- yysetstate:
-  *yyssp = yystate;
-
-  if (yyss + yystacksize - 1 <= yyssp)
-    {
-      /* Get the current used size of the three stacks, in elements.  */
-      YYSIZE_T yysize = yyssp - yyss + 1;
-
-#ifdef yyoverflow
-      {
-	/* Give user a chance to reallocate the stack.  Use copies of
-	   these so that the &'s don't force the real ones into
-	   memory.  */
-	YYSTYPE *yyvs1 = yyvs;
-	yytype_int16 *yyss1 = yyss;
-
-
-	/* Each stack pointer address is followed by the size of the
-	   data in use in that stack, in bytes.  This used to be a
-	   conditional around just the two extra args, but that might
-	   be undefined if yyoverflow is a macro.  */
-	yyoverflow (YY_("memory exhausted"),
-		    &yyss1, yysize * sizeof (*yyssp),
-		    &yyvs1, yysize * sizeof (*yyvsp),
-
-		    &yystacksize);
-
-	yyss = yyss1;
-	yyvs = yyvs1;
-      }
-#else /* no yyoverflow */
-# ifndef YYSTACK_RELOCATE
-      goto yyexhaustedlab;
-# else
-      /* Extend the stack our own way.  */
-      if (YYMAXDEPTH <= yystacksize)
-	goto yyexhaustedlab;
-      yystacksize *= 2;
-      if (YYMAXDEPTH < yystacksize)
-	yystacksize = YYMAXDEPTH;
-
-      {
-	yytype_int16 *yyss1 = yyss;
-	union yyalloc *yyptr =
-	  (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
-	if (! yyptr)
-	  goto yyexhaustedlab;
-	YYSTACK_RELOCATE (yyss);
-	YYSTACK_RELOCATE (yyvs);
-
-#  undef YYSTACK_RELOCATE
-	if (yyss1 != yyssa)
-	  YYSTACK_FREE (yyss1);
-      }
-# endif
-#endif /* no yyoverflow */
-
-      yyssp = yyss + yysize - 1;
-      yyvsp = yyvs + yysize - 1;
-
-
-      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
-		  (unsigned long int) yystacksize));
-
-      if (yyss + yystacksize - 1 <= yyssp)
-	YYABORT;
-    }
-
-  YYDPRINTF ((stderr, "Entering state %d\n", yystate));
-
-  goto yybackup;
-
-/*-----------.
-| yybackup.  |
-`-----------*/
-yybackup:
-
-  /* Do appropriate processing given the current state.  Read a
-     look-ahead token if we need one and don't already have one.  */
-
-  /* First try to decide what to do without reference to look-ahead token.  */
-  yyn = yypact[yystate];
-  if (yyn == YYPACT_NINF)
-    goto yydefault;
-
-  /* Not known => get a look-ahead token if don't already have one.  */
-
-  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
-  if (yychar == YYEMPTY)
-    {
-      YYDPRINTF ((stderr, "Reading a token: "));
-      yychar = YYLEX;
-    }
-
-  if (yychar <= YYEOF)
-    {
-      yychar = yytoken = YYEOF;
-      YYDPRINTF ((stderr, "Now at end of input.\n"));
-    }
-  else
-    {
-      yytoken = YYTRANSLATE (yychar);
-      YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);
-    }
-
-  /* If the proper action on seeing token YYTOKEN is to reduce or to
-     detect an error, take that action.  */
-  yyn += yytoken;
-  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
-    goto yydefault;
-  yyn = yytable[yyn];
-  if (yyn <= 0)
-    {
-      if (yyn == 0 || yyn == YYTABLE_NINF)
-	goto yyerrlab;
-      yyn = -yyn;
-      goto yyreduce;
-    }
-
-  if (yyn == YYFINAL)
-    YYACCEPT;
-
-  /* Count tokens shifted since error; after three, turn off error
-     status.  */
-  if (yyerrstatus)
-    yyerrstatus--;
-
-  /* Shift the look-ahead token.  */
-  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
-
-  /* Discard the shifted token unless it is eof.  */
-  if (yychar != YYEOF)
-    yychar = YYEMPTY;
-
-  yystate = yyn;
-  *++yyvsp = yylval;
-
-  goto yynewstate;
-
-
-/*-----------------------------------------------------------.
-| yydefault -- do the default action for the current state.  |
-`-----------------------------------------------------------*/
-yydefault:
-  yyn = yydefact[yystate];
-  if (yyn == 0)
-    goto yyerrlab;
-  goto yyreduce;
-
-
-/*-----------------------------.
-| yyreduce -- Do a reduction.  |
-`-----------------------------*/
-yyreduce:
-  /* yyn is the number of a rule to reduce with.  */
-  yylen = yyr2[yyn];
-
-  /* If YYLEN is nonzero, implement the default value of the action:
-     `$$ = $1'.
-
-     Otherwise, the following line sets YYVAL to garbage.
-     This behavior is undocumented and Bison
-     users should not rely upon it.  Assigning to YYVAL
-     unconditionally makes the parser a bit smaller, and it avoids a
-     GCC warning that YYVAL may be used uninitialized.  */
-  yyval = yyvsp[1-yylen];
-
-
-  YY_REDUCE_PRINT (yyn);
-  switch (yyn)
-    {
-        case 8:
-#line 344 "fortran.y"
-    {yyerrok;yyclearin;;}
-    break;
-
-  case 13:
-#line 352 "fortran.y"
-    {
-                     if (inmoduledeclare == 0 )
-                     {
-                        pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_curinclude,
-                                              pos_end-pos_curinclude);
-                     }
-                  ;}
-    break;
-
-  case 18:
-#line 368 "fortran.y"
-    {
-            /* we should ignore the declaration until the keyword             */
-            /*    TOK_ENDDONOTTREAT                                           */
-            couldaddvariable = 0 ;
-            RemoveWordCUR_0(fortranout,-20,20);
-         ;}
-    break;
-
-  case 19:
-#line 375 "fortran.y"
-    {
-             couldaddvariable = 1 ;
-             RemoveWordCUR_0(fortranout,-24,24);
-          ;}
-    break;
-
-  case 22:
-#line 382 "fortran.y"
-    {pos_cur = setposcur();;}
-    break;
-
-  case 27:
-#line 394 "fortran.y"
-    {if (incom !=1) {strcpy(curbuf,"");incom=0;};}
-    break;
-
-  case 28:
-#line 397 "fortran.y"
-    {isrecursive = 0;;}
-    break;
-
-  case 29:
-#line 399 "fortran.y"
-    {isrecursive = 1;;}
-    break;
-
-  case 31:
-#line 403 "fortran.y"
-    {
-                      if ( couldaddvariable == 1)
-                      {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (4)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-
-                      }
-                      Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(1);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            writeheadnewsub_0(1);
-                      }
-                      }
-                   ;}
-    break;
-
-  case 32:
-#line 431 "fortran.y"
-    {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(2) - (2)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-
-                      }
-                      strcpy(subroutinename,(yyvsp[(2) - (2)].nac));
-                      /* Common case                                          */
-                      insubroutinedeclare = 1;
-                      /* in the second step we should write the head of       */
-                      /*    the subroutine sub_loop_<subroutinename>          */
-                      writeheadnewsub_0(1);
-                   ;}
-    break;
-
-  case 33:
-#line 449 "fortran.y"
-    {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (6)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,(yyvsp[(3) - (6)].nac));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(4) - (6)].l));
-                         strcpy(DeclType,"");
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            /* we should to list of the subroutine argument   */
-                            /* name of the function which has to be defined   */
-                            Add_SubroutineArgument_Var_1((yyvsp[(4) - (6)].l));
-                            strcpy(DeclType,"");
-                            Add_FunctionType_Var_1((yyvsp[(3) - (6)].nac));
-                            writeheadnewsub_0(2);
-                      }
-                   ;}
-    break;
-
-  case 34:
-#line 482 "fortran.y"
-    {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (4)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,(yyvsp[(3) - (4)].nac));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
-                         strcpy(DeclType,"");
-                         Add_FunctionType_Var_1((yyvsp[(3) - (4)].nac));
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            /* we should to list of the subroutine argument   */
-                            /* name of the function which has to be defined   */
-                            Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
-                            strcpy(DeclType,"");
-                            Add_FunctionType_Var_1((yyvsp[(3) - (4)].nac));
-                            writeheadnewsub_0(2);
-                      }
-                   ;}
-    break;
-
-  case 35:
-#line 516 "fortran.y"
-    {
-                      GlobalDeclaration = 0;
-                      strcpy(curmodulename,(yyvsp[(2) - (2)].nac));
-                      strcpy(subroutinename,"");
-                      Add_NameOfModule_1((yyvsp[(2) - (2)].nac));
-                      if ( inmoduledeclare == 0 )
-                      {
-                         /* To know if there are in the module declaration    */
-                         inmoduledeclare = 1;
-                         /* to know if a module has been met                  */
-                         inmodulemeet = 1;
-                         /* to know if we are after the keyword contains      */
-                         aftercontainsdeclare = 0 ;
-                      }
-                   ;}
-    break;
-
-  case 36:
-#line 533 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));strcpy(subroutinename,(yyvsp[(1) - (1)].nac));
-                      }
-                   ;}
-    break;
-
-  case 38:
-#line 542 "fortran.y"
-    {
-                      pos_curinclude = setposcur()-9;
-                   ;}
-    break;
-
-  case 39:
-#line 546 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) Add_Include_1((yyvsp[(1) - (1)].nac));
-                   ;}
-    break;
-
-  case 40:
-#line 550 "fortran.y"
-    {
-                      if ( firstpass == 1 && couldaddvariable == 1) (yyval.l)=NULL;
-                   ;}
-    break;
-
-  case 41:
-#line 553 "fortran.y"
-    {
-                      if ( firstpass == 1 && couldaddvariable == 1 ) (yyval.l)=NULL;
-                   ;}
-    break;
-
-  case 42:
-#line 557 "fortran.y"
-    {
-                       if ( firstpass == 1 && couldaddvariable == 1 ) (yyval.l)=(yyvsp[(2) - (3)].l);
-                   ;}
-    break;
-
-  case 45:
-#line 564 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         Add_SubroutineArgument_Var_1((yyvsp[(2) - (3)].l));
-                      }
-                   ;}
-    break;
-
-  case 46:
-#line 571 "fortran.y"
-    {
-                      if ( firstpass == 1  && couldaddvariable == 1)
-                      {
-                         strcpy(nameinttypenameback,nameinttypename);
-                         strcpy(nameinttypename,"");
-                         curvar=createvar((yyvsp[(1) - (1)].na),NULL);
-                        strcpy(nameinttypename,nameinttypenameback);
-                         curlistvar=insertvar(NULL,curvar);
-                         (yyval.l)=settype("",curlistvar);
-                      }
-                   ;}
-    break;
-
-  case 47:
-#line 583 "fortran.y"
-    {
-                      if ( firstpass == 1  && couldaddvariable == 1)
-                      {
-                         strcpy(nameinttypenameback,nameinttypename);
-                         strcpy(nameinttypename,"");                      
-                         curvar=createvar((yyvsp[(3) - (3)].na),NULL);
-                         strcpy(nameinttypename,nameinttypenameback);                         
-                         (yyval.l)=insertvar((yyvsp[(1) - (3)].l),curvar);
-                      }
-                   ;}
-    break;
-
-  case 48:
-#line 594 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 49:
-#line 595 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),"*");;}
-    break;
-
-  case 50:
-#line 598 "fortran.y"
-    {
-                      if ( VarTypepar == 1 )
-                      {
-                         couldaddvariable = 1 ;
-                         VarTypepar = 0;
-                      }
-                   ;}
-    break;
-
-  case 51:
-#line 606 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         VarType = 1;
-                         couldaddvariable = 0 ;
-                      }
-                   ;}
-    break;
-
-  case 52:
-#line 614 "fortran.y"
-    {
-                      if ( VarType == 1 ) couldaddvariable = 1 ;
-                      VarType = 0;
-                      VarTypepar = 0;
-                   ;}
-    break;
-
-  case 54:
-#line 621 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         if ( insubroutinedeclare == 0 )
-                         {
-                                                  Add_GlobalParameter_Var_1((yyvsp[(3) - (4)].l));
-                                                  }
-                         else Add_Parameter_Var_1((yyvsp[(3) - (4)].l));
-                         pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                    pos_end-pos_cur_decl);
-                      }
-                      VariableIsParameter =  0 ;
-                   ;}
-    break;
-
-  case 55:
-#line 636 "fortran.y"
-    {
-                     if ( couldaddvariable == 1 )
-                     {
-                        if ( insubroutinedeclare == 0 )
-                                                  Add_GlobalParameter_Var_1((yyvsp[(2) - (2)].l));
-                         else Add_Parameter_Var_1((yyvsp[(2) - (2)].l));
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                    pos_end-pos_cur_decl);
-                      }
-                      VariableIsParameter =  0 ;
-                   ;}
-    break;
-
-  case 57:
-#line 650 "fortran.y"
-    {
-                     pos_end = setposcur();
-                     RemoveWordSET_0(fortranout,pos_cursave,
-                                                pos_end-pos_cursave);
-                  ;}
-    break;
-
-  case 59:
-#line 657 "fortran.y"
-    {
-                   /* if the variable is a parameter we can suppose that is   */
-                   /*    value is the same on each grid. It is not useless to */
-                   /*    create a copy of it on each grid                     */
-                      if ( couldaddvariable == 1 )
-                      {
-                         Add_Globliste_1((yyvsp[(1) - (1)].l));
-                         /* if variableparamlists has been declared in a      */
-                         /*    subroutine                                     */
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            Add_Dimension_Var_1((yyvsp[(1) - (1)].l));
-                         }
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curdimension,
-                                                pos_end-pos_curdimension);
-                      }
-                      /*                                                      */
-                      PublicDeclare = 0;
-                      PrivateDeclare = 0;
-                      ExternalDeclare = 0;
-                      strcpy(NamePrecision,"");
-                      c_star = 0;
-                      strcpy(InitialValueGiven," ");
-                      strcpy(IntentSpec,"");
-                      VariableIsParameter =  0 ;
-                      Allocatabledeclare = 0 ;
-                      Targetdeclare = 0 ;
-                      SaveDeclare = 0;
-                      pointerdeclare = 0;
-                      optionaldeclare = 0 ;
-                      dimsgiven=0;
-                      c_selectorgiven=0;
-                      strcpy(nameinttypename,"");
-                      strcpy(c_selectorname,"");
-                   ;}
-    break;
-
-  case 60:
-#line 694 "fortran.y"
-    {
-      if (firstpass == 0)
-      {
-      if ((yyvsp[(1) - (1)].lnn))
-      {
-      removeglobfromlist(&((yyvsp[(1) - (1)].lnn)));
-      pos_end = setposcur();
-           RemoveWordSET_0(fortranout,pos_cur,pos_end-pos_cur);
-      writelistpublic((yyvsp[(1) - (1)].lnn));
-      }
-      }
-      ;}
-    break;
-
-  case 70:
-#line 716 "fortran.y"
-    {
-                      /* we should remove the data declaration                */
-                      if ( couldaddvariable == 1 && aftercontainsdeclare != 2 )
-                      {
-                        pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_curdata,
-                                              pos_end-pos_curdata);
-                      }
-                      if ( couldaddvariable == 1 && aftercontainsdeclare == 1 )
-                      {
-                      if (firstpass == 0)
-                      {
-                        ReWriteDataStatement_0(fortranout);
-                        pos_end = setposcur();
-                  }
-                      }
-                  ;}
-    break;
-
-  case 72:
-#line 736 "fortran.y"
-    {
-         PublicDeclare = 0 ;
-         PrivateDeclare = 0 ;
-      ;}
-    break;
-
-  case 110:
-#line 787 "fortran.y"
-    {
-                      /* if the variable is a parameter we can suppose that is*/
-                      /*    value is the same on each grid. It is not useless */
-                      /*    to create a copy of it on each grid               */
-                      if ( couldaddvariable == 1 )
-                      {
-                      pos_end = setposcur();
-                      /*if (insubroutinedeclare == 0)
-                        {   */
-                         RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                 pos_end-pos_cur_decl);
-                                         
-                       /* }
-                      else
-                       {*/
-                        ReWriteDeclarationAndAddTosubroutine_01((yyvsp[(1) - (2)].l));
-                        pos_cur_decl = setposcur();
-                        
-                       /*}*/
-                      if ( firstpass == 0 &&
-                           GlobalDeclaration == 0 &&
-                           insubroutinedeclare == 0 )
-                      {
-
-                         sprintf(ligne,"\n#include \"Module_Declar_%s.h\"\n"
-                                                                ,curmodulename);
-                         tofich(fortranout,ligne,1);
-                         sprintf (ligne, "Module_Declar_%s.h",curmodulename);
-                         module_declar = associate(ligne);
-                         sprintf (ligne, " ");
-                         tofich (module_declar, ligne,1);
-                         GlobalDeclaration = 1 ;
-                         pos_cur_decl = setposcur();
-
-                      }
-                         (yyval.l) = (yyvsp[(1) - (2)].l);
-                         Add_Globliste_1((yyvsp[(1) - (2)].l));
-                                                  
-                         if ( insubroutinedeclare == 0 )
-                                                  Add_GlobalParameter_Var_1((yyvsp[(1) - (2)].l));
-                         else
-                         {
-                            if ( pointerdeclare == 1 )
-                                                Add_Pointer_Var_From_List_1((yyvsp[(1) - (2)].l));
-                            Add_Parameter_Var_1((yyvsp[(1) - (2)].l));
-                         }
-
-                         /* if variables has been declared in a subroutine    */
-                         if ( insubroutinedeclare == 1 )
-                         { 
-                       /*    Add_SubroutineDeclaration_Var_1($1);*/
-                         }
-                         /* If there are a SAVE declarations in module's      */
-                         /*    subroutines we should remove it from the       */
-                         /*    subroutines declaration and add it in the      */
-                         /*    global declarations                            */
-                         if ( aftercontainsdeclare == 1 &&
-                              SaveDeclare == 1 && firstpass == 1 )
-                         {
-                              if ( inmodulemeet == 0 ) Add_Save_Var_dcl_1((yyvsp[(1) - (2)].l));
-                              else  Add_SubroutineDeclarationSave_Var_1((yyvsp[(1) - (2)].l));
-                         }
-                      }
-                      /*                                                      */
-                      PublicDeclare = 0;
-                      PrivateDeclare = 0;
-                      ExternalDeclare = 0;
-                      strcpy(NamePrecision,"");
-                      c_star = 0;
-                      strcpy(InitialValueGiven," ");
-                      strcpy(IntentSpec,"");
-                      VariableIsParameter =  0 ;
-                      Allocatabledeclare = 0 ;
-                      Targetdeclare = 0 ;
-                      SaveDeclare = 0;
-                      pointerdeclare = 0;
-                      optionaldeclare = 0 ;
-                      dimsgiven=0;
-                      c_selectorgiven=0;
-                      strcpy(nameinttypename,"");
-                      strcpy(c_selectorname,"");
-                      GlobalDeclarationType = 0; 
-                   ;}
-    break;
-
-  case 111:
-#line 871 "fortran.y"
-    {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(2) - (3)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,(yyvsp[(2) - (3)].nac));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
-                         Add_FunctionType_Var_1((yyvsp[(2) - (3)].nac));
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
-                         Add_FunctionType_Var_1((yyvsp[(2) - (3)].nac));
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      strcpy(nameinttypename,"");
-
-                   ;}
-    break;
-
-  case 112:
-#line 908 "fortran.y"
-    {
-                       functiondeclarationisdone = 1;
-                   ;}
-    break;
-
-  case 113:
-#line 914 "fortran.y"
-    {
-                      VariableIsParameter = 1;
-                      pos_curparameter = setposcur()-9;
-                   ;}
-    break;
-
-  case 114:
-#line 919 "fortran.y"
-    {
-                      pos_curdata = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                      Init_List_Data_Var();
-                   ;}
-    break;
-
-  case 115:
-#line 924 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-/*                      if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
-                      else */
-/*                      sprintf(ligne,"%s",$3);*/
-                      createstringfromlistname(ligne,(yyvsp[(3) - (4)].lnn));
-                      if (firstpass == 1)
-                      Add_Data_Var_1(&List_Data_Var,(yyvsp[(1) - (4)].nac),ligne);
-                      else
-                      Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(1) - (4)].nac),ligne);
-                      }
-                   ;}
-    break;
-
-  case 116:
-#line 938 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                      /*if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
-                      else */
-                      /*sprintf(ligne,"%s",$5);   */
-                      createstringfromlistname(ligne,(yyvsp[(5) - (6)].lnn));                      
-                      if (firstpass == 1)                      
-                      Add_Data_Var_1(&List_Data_Var,(yyvsp[(3) - (6)].nac),ligne);
-                      else
-                      Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(3) - (6)].nac),ligne);                      
-                      }
-                   ;}
-    break;
-
-  case 117:
-#line 952 "fortran.y"
-    {
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       if (firstpass == 1)
-                       Add_Data_Var_Names_01(&List_Data_Var,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
-                       else
-                       Add_Data_Var_Names_01(&List_Data_Var_Cur,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
-                   ;}
-    break;
-
-  case 118:
-#line 967 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0);
-                      }
-                   ;}
-    break;
-
-  case 119:
-#line 974 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         (yyval.lnn) = Insertname((yyvsp[(3) - (3)].lnn),(yyvsp[(1) - (3)].na),1);
-                      }
-                   ;}
-    break;
-
-  case 124:
-#line 988 "fortran.y"
-    {
-                     pos_cursave = setposcur()-4;
-                  ;}
-    break;
-
-  case 126:
-#line 994 "fortran.y"
-    {
-                     if ( couldaddvariable == 1 ) Add_Save_Var_1((yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].d));
-                  ;}
-    break;
-
-  case 127:
-#line 999 "fortran.y"
-    {
-		(yyval.lnn)=Insertname(NULL,(yyvsp[(1) - (1)].nac),0);
-		;}
-    break;
-
-  case 128:
-#line 1003 "fortran.y"
-    {
-      printf("INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n");
-      exit(0);
-      ;}
-    break;
-
-  case 129:
-#line 1008 "fortran.y"
-    {
-      (yyval.lnn) = concat_listname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].lnn));
-      ;}
-    break;
-
-  case 130:
-#line 1013 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].nac));;}
-    break;
-
-  case 131:
-#line 1015 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s+%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 132:
-#line 1017 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s-%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 133:
-#line 1019 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s*%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 134:
-#line 1021 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s/%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 135:
-#line 1024 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"");;}
-    break;
-
-  case 136:
-#line 1026 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 143:
-#line 1038 "fortran.y"
-    {
-	ininterfacedeclare = 1 ;
-	printf("INTEFACE entree\n");
-	;}
-    break;
-
-  case 144:
-#line 1043 "fortran.y"
-    {
-      ininterfacedeclare = 0;
-      ;}
-    break;
-
-  case 145:
-#line 1048 "fortran.y"
-    {
-                      positioninblock=0;
-                      pos_curdimension = setposcur()-9;
-                   ;}
-    break;
-
-  case 146:
-#line 1054 "fortran.y"
-    {
-         if ( couldaddvariable == 1 )
-         {
-            /*                                                                */
-            curvar=createvar((yyvsp[(3) - (5)].nac),(yyvsp[(4) - (5)].d));
-            /*                                                                */
-            CreateAndFillin_Curvar("",curvar);
-            /*                                                                */
-            curlistvar=insertvar(NULL,curvar);
-            /*                                                                */
-            (yyval.l)=settype("",curlistvar);
-            /*                                                                */
-            strcpy(vallengspec,"");
-         }
-      ;}
-    break;
-
-  case 147:
-#line 1070 "fortran.y"
-    {
-         if ( couldaddvariable == 1 )
-         {
-            /*                                                                */
-            curvar=createvar((yyvsp[(3) - (5)].nac),(yyvsp[(4) - (5)].d));
-            /*                                                                */
-            CreateAndFillin_Curvar("",curvar);
-            /*                                                                */
-            curlistvar=insertvar((yyvsp[(1) - (5)].l),curvar);
-            /*                                                                */
-            (yyval.l)=curlistvar;
-            /*                                                                */
-            strcpy(vallengspec,"");
-         }
-      ;}
-    break;
-
-  case 150:
-#line 1090 "fortran.y"
-    {
-        (yyval.lnn)=(listname *)NULL;
-        ;}
-    break;
-
-  case 151:
-#line 1094 "fortran.y"
-    {
-          (yyval.lnn)=(yyvsp[(3) - (3)].lnn);
-         ;}
-    break;
-
-  case 152:
-#line 1099 "fortran.y"
-    {
-           (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].nac),0);
-           ;}
-    break;
-
-  case 153:
-#line 1103 "fortran.y"
-    {
-          (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].nac),0);
-          ;}
-    break;
-
-  case 154:
-#line 1108 "fortran.y"
-    {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcommon,
-                                                  pos_end-pos_curcommon);
-                   ;}
-    break;
-
-  case 155:
-#line 1114 "fortran.y"
-    {
-                         if ( couldaddvariable == 1 )
-                         {
-                            sprintf(charusemodule,"%s",(yyvsp[(2) - (3)].nac));
-                            Add_NameOfCommon_1((yyvsp[(2) - (3)].nac),subroutinename);
-                            pos_end = setposcur();
-                            RemoveWordSET_0(fortranout,pos_curcommon,
-                                                       pos_end-pos_curcommon);
-                         }
-                   ;}
-    break;
-
-  case 156:
-#line 1125 "fortran.y"
-    {
-                         if ( couldaddvariable == 1 )
-                         {
-                            sprintf(charusemodule,"%s",(yyvsp[(3) - (5)].nac));
-                            Add_NameOfCommon_1((yyvsp[(3) - (5)].nac),subroutinename);
-                            pos_end = setposcur();
-                            RemoveWordSET_0(fortranout,pos_curcommon,
-                                                       pos_end-pos_curcommon);
-                         }
-                   ;}
-    break;
-
-  case 157:
-#line 1137 "fortran.y"
-    {
-                      positioninblock=0;
-                      pos_curcommon = setposcur()-6;
-                   ;}
-    break;
-
-  case 158:
-#line 1142 "fortran.y"
-    {
-                      positioninblock=0;
-                      pos_curcommon = setposcur()-6-7;
-                   ;}
-    break;
-
-  case 159:
-#line 1148 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) Add_Common_var_1();
-                   ;}
-    break;
-
-  case 160:
-#line 1153 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) Add_Common_var_1();
-                   ;}
-    break;
-
-  case 161:
-#line 1157 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         positioninblock = positioninblock + 1 ;
-                         strcpy(commonvar,(yyvsp[(1) - (2)].nac));
-                         commondim = (yyvsp[(2) - (2)].d);
-                      }
-                   ;}
-    break;
-
-  case 162:
-#line 1167 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy((yyval.nac),"");
-                         positioninblock=0;
-                         strcpy(commonblockname,"");
-                      }
-                   ;}
-    break;
-
-  case 163:
-#line 1176 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy((yyval.nac),(yyvsp[(2) - (3)].nac));
-                         positioninblock=0;
-                         strcpy(commonblockname,(yyvsp[(2) - (3)].nac));
-                      }
-                   ;}
-    break;
-
-  case 166:
-#line 1189 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) (yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v));
-                   ;}
-    break;
-
-  case 167:
-#line 1193 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) (yyval.l)=insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v));
-                   ;}
-    break;
-
-  case 168:
-#line 1198 "fortran.y"
-    {
-                     if ( couldaddvariable == 1 )
-                     {
-                         curvar=(variable *) malloc(sizeof(variable));
-                         /*                                                   */
-                         Init_Variable(curvar);
-                         /*                                                   */
-                         curvar->v_VariableIsParameter=1;
-                         strcpy(curvar->v_nomvar,(yyvsp[(1) - (3)].nac));
-                         Save_Length((yyvsp[(1) - (3)].nac),4);
-                         strcpy(curvar->v_subroutinename,subroutinename);
-                         Save_Length(subroutinename,11);
-                         strcpy(curvar->v_modulename,curmodulename);
-                         Save_Length(curmodulename,6);
-                         strcpy(curvar->v_initialvalue,(yyvsp[(3) - (3)].na));
-                         Save_Length((yyvsp[(3) - (3)].na),14);
-                         strcpy(curvar->v_commoninfile,mainfile);
-                         Save_Length(mainfile,10);
-                         (yyval.v)=curvar;
-                      }
-                   ;}
-    break;
-
-  case 172:
-#line 1226 "fortran.y"
-    {
-                       if ( insubroutinedeclare == 1 )
-                       {
-                          Add_ImplicitNoneSubroutine_1();
-                          pos_end = setposcur();
-                          RemoveWordSET_0(fortranout,pos_end-13,
-                                                             13);
-                       }
-                    ;}
-    break;
-
-  case 175:
-#line 1240 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         /*                                                   */
-                         if (dimsgiven == 1)
-                         {
-                            curvar=createvar((yyvsp[(3) - (6)].nac),curdim);
-                            GlobalDeclarationType == 0;
-                         }
-                         else
-                         {
-                            curvar=createvar((yyvsp[(3) - (6)].nac),(yyvsp[(4) - (6)].d));
-                         }
-                         /*                                                   */
-                         CreateAndFillin_Curvar(DeclType,curvar);
-                         /*                                                   */
-                         curlistvar=insertvar(NULL,curvar);
-                         if (!strcasecmp(DeclType,"character"))
-                         {
-                            if (c_selectorgiven == 1)
-                            {
-                               strcpy(c_selectordim.first,"1");
-                               strcpy(c_selectordim.last,c_selectorname);
-                               Save_Length(c_selectorname,1);
-                               change_dim_char
-                                     (insertdim(NULL,c_selectordim),curlistvar);
-                            }
-                         }
-                         (yyval.l)=settype(DeclType,curlistvar);
-                      }
-                      strcpy(vallengspec,"");
-                   ;}
-    break;
-
-  case 176:
-#line 1273 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         if (dimsgiven == 1)
-                         {
-                            curvar=createvar((yyvsp[(4) - (7)].nac),curdim);
-                         }
-                         else
-                         {
-                            curvar=createvar((yyvsp[(4) - (7)].nac),(yyvsp[(5) - (7)].d));
-                         }
-                         /*                                                   */
-                         CreateAndFillin_Curvar((yyvsp[(1) - (7)].l)->var->v_typevar,curvar);
-                         /*                                                   */
-                         strcpy(curvar->v_typevar,((yyvsp[(1) - (7)].l)->var->v_typevar));
-                         Save_Length((yyvsp[(1) - (7)].l)->var->v_typevar,3);
-                         /*                                                   */
-                         curlistvar=insertvar((yyvsp[(1) - (7)].l),curvar);
-                         if (!strcasecmp(DeclType,"character"))
-                         {
-                            if (c_selectorgiven == 1)
-                            {
-                               strcpy(c_selectordim.first,"1");
-                               strcpy(c_selectordim.last,c_selectorname);
-                               Save_Length(c_selectorname,1);
-                               change_dim_char
-                                     (insertdim(NULL,c_selectordim),curlistvar);
-                            }
-                         }
-                         (yyval.l)=curlistvar;
-                      }
-                      strcpy(vallengspec,"");
-                   ;}
-    break;
-
-  case 177:
-#line 1307 "fortran.y"
-    {dimsgiven=0;;}
-    break;
-
-  case 178:
-#line 1310 "fortran.y"
-    {strcpy(DeclType,(yyvsp[(1) - (2)].nac));;}
-    break;
-
-  case 179:
-#line 1312 "fortran.y"
-    {
-                      strcpy(DeclType,"CHARACTER");
-                   ;}
-    break;
-
-  case 180:
-#line 1316 "fortran.y"
-    {
-                      strcpy(DeclType,(yyvsp[(1) - (3)].nac));
-                      strcpy(nameinttypename,(yyvsp[(3) - (3)].nac));
-                   ;}
-    break;
-
-  case 181:
-#line 1321 "fortran.y"
-    {
-                      strcpy(DeclType,"TYPE");
-                      GlobalDeclarationType = 1
-                   ;}
-    break;
-
-  case 182:
-#line 1327 "fortran.y"
-    {
-                 /*     if ( couldaddvariable == 1 ) VarTypepar = 1 ;
-                      couldaddvariable = 0 ;
-                      pos_cur_decl = setposcur()-5;*/
-                   pos_cur_decl = setposcur()-5;
-                   ;}
-    break;
-
-  case 184:
-#line 1336 "fortran.y"
-    {c_selectorgiven=1;strcpy(c_selectorname,(yyvsp[(2) - (2)].nac));;}
-    break;
-
-  case 185:
-#line 1337 "fortran.y"
-    {c_star = 1;;}
-    break;
-
-  case 190:
-#line 1345 "fortran.y"
-    {
-                      pos_cur_decl = setposcur()-9;
-                   ;}
-    break;
-
-  case 191:
-#line 1349 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 192:
-#line 1352 "fortran.y"
-    {
-                      strcpy((yyval.nac),"INTEGER");
-                      pos_cur_decl = setposcur()-7;
-                   ;}
-    break;
-
-  case 193:
-#line 1356 "fortran.y"
-    {
-                      strcpy((yyval.nac),"REAL");
-                      pos_cur_decl = setposcur()-4;
-                   ;}
-    break;
-
-  case 194:
-#line 1361 "fortran.y"
-    {strcpy((yyval.nac),"COMPLEX");
-                   pos_cur_decl = setposcur()-7;;}
-    break;
-
-  case 195:
-#line 1364 "fortran.y"
-    {
-                      pos_cur_decl = setposcur()-16;
-                      strcpy((yyval.nac),"REAL");
-                      strcpy(nameinttypename,"8");
-                   ;}
-    break;
-
-  case 196:
-#line 1370 "fortran.y"
-    {strcpy((yyval.nac),"DOUBLE COMPLEX");;}
-    break;
-
-  case 197:
-#line 1372 "fortran.y"
-    {
-                      strcpy((yyval.nac),"LOGICAL");
-                      pos_cur_decl = setposcur()-7;
-                   ;}
-    break;
-
-  case 199:
-#line 1378 "fortran.y"
-    {strcpy(vallengspec,(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 200:
-#line 1380 "fortran.y"
-    {sprintf((yyval.na),"*%s",(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 201:
-#line 1381 "fortran.y"
-    {strcpy((yyval.na),"*(*)");;}
-    break;
-
-  case 208:
-#line 1392 "fortran.y"
-    {
-                      if ( strstr((yyvsp[(3) - (3)].na),"0.d0") )
-                      {
-                         strcpy(nameinttypename,"8");
-                         sprintf(NamePrecision,"");
-                      }
-                      else sprintf(NamePrecision,"%s = %s",(yyvsp[(1) - (3)].nac),(yyvsp[(3) - (3)].na));
-                   ;}
-    break;
-
-  case 209:
-#line 1401 "fortran.y"
-    {
-                      strcpy(NamePrecision,(yyvsp[(1) - (1)].nac));
-                   ;}
-    break;
-
-  case 210:
-#line 1405 "fortran.y"
-    {
-                      strcpy(NamePrecision,(yyvsp[(1) - (1)].nac));
-                   ;}
-    break;
-
-  case 211:
-#line 1409 "fortran.y"
-    {strcpy(CharacterSize,(yyvsp[(1) - (1)].na));
-                    strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 212:
-#line 1411 "fortran.y"
-    {strcpy(CharacterSize,"*");
-                    strcpy((yyval.na),"*");;}
-    break;
-
-  case 220:
-#line 1425 "fortran.y"
-    {
-                      VariableIsParameter = 1;
-                   ;}
-    break;
-
-  case 222:
-#line 1430 "fortran.y"
-    {Allocatabledeclare = 1;;}
-    break;
-
-  case 223:
-#line 1432 "fortran.y"
-    {
-                      dimsgiven=1;
-                      curdim=(yyvsp[(2) - (2)].d);
-                   ;}
-    break;
-
-  case 224:
-#line 1437 "fortran.y"
-    {ExternalDeclare = 1;;}
-    break;
-
-  case 225:
-#line 1439 "fortran.y"
-    {strcpy(IntentSpec,(yyvsp[(3) - (4)].nac));;}
-    break;
-
-  case 227:
-#line 1441 "fortran.y"
-    {optionaldeclare = 1 ;;}
-    break;
-
-  case 228:
-#line 1442 "fortran.y"
-    {pointerdeclare = 1 ;;}
-    break;
-
-  case 229:
-#line 1443 "fortran.y"
-    {
-/*                       if ( inmodulemeet == 1 )
-                       {*/
-                          SaveDeclare = 1 ;
-                     /*  }*/
-                    ;}
-    break;
-
-  case 230:
-#line 1450 "fortran.y"
-    {Targetdeclare = 1;;}
-    break;
-
-  case 231:
-#line 1452 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 232:
-#line 1453 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 233:
-#line 1454 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac)); ;}
-    break;
-
-  case 234:
-#line 1457 "fortran.y"
-    {PublicDeclare = 1;;}
-    break;
-
-  case 235:
-#line 1459 "fortran.y"
-    {PrivateDeclare = 1;;}
-    break;
-
-  case 236:
-#line 1461 "fortran.y"
-    {if ( created_dimensionlist == 1 )
-                       {
-                           (yyval.d)=(listdim *)NULL;
-                       }
-                   ;}
-    break;
-
-  case 237:
-#line 1467 "fortran.y"
-    {if ( created_dimensionlist == 1 ||
-                         agrif_parentcall      == 1 ) (yyval.d)=(yyvsp[(2) - (3)].d);;}
-    break;
-
-  case 238:
-#line 1470 "fortran.y"
-    {if ( created_dimensionlist == 1 ||
-                         agrif_parentcall      == 1 ) (yyval.d)=insertdim(NULL,(yyvsp[(1) - (1)].dim1));;}
-    break;
-
-  case 239:
-#line 1473 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                         if ( created_dimensionlist == 1 ) (yyval.d)=insertdim((yyvsp[(1) - (3)].d),(yyvsp[(3) - (3)].dim1));;}
-    break;
-
-  case 240:
-#line 1476 "fortran.y"
-    {
-                      strcpy((yyval.dim1).first,"1");
-                      strcpy((yyval.dim1).last,(yyvsp[(1) - (1)].na));
-                      Save_Length((yyvsp[(1) - (1)].na),1);
-                   ;}
-    break;
-
-  case 241:
-#line 1481 "fortran.y"
-    {
-                      strcpy((yyval.dim1).first,"");
-                      strcpy((yyval.dim1).last,"");
-                   ;}
-    break;
-
-  case 242:
-#line 1485 "fortran.y"
-    {
-                      strcpy((yyval.dim1).first,(yyvsp[(1) - (2)].na));
-                      Save_Length((yyvsp[(1) - (2)].na),2);
-                      strcpy((yyval.dim1).last,"");
-                   ;}
-    break;
-
-  case 243:
-#line 1490 "fortran.y"
-    {
-                      strcpy((yyval.dim1).first,"");
-                      strcpy((yyval.dim1).last,(yyvsp[(2) - (2)].na));
-                      Save_Length((yyvsp[(2) - (2)].na),1);
-                   ;}
-    break;
-
-  case 244:
-#line 1496 "fortran.y"
-    {
-                      strcpy((yyval.dim1).first,(yyvsp[(1) - (3)].na));
-                      Save_Length((yyvsp[(1) - (3)].na),2);
-                      strcpy((yyval.dim1).last,(yyvsp[(3) - (3)].na));
-                      Save_Length((yyvsp[(3) - (3)].na),1);
-                   ;}
-    break;
-
-  case 245:
-#line 1503 "fortran.y"
-    {strcpy((yyval.na),"*");;}
-    break;
-
-  case 246:
-#line 1504 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 247:
-#line 1506 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 248:
-#line 1508 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 249:
-#line 1510 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 250:
-#line 1512 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 251:
-#line 1516 "fortran.y"
-    {sprintf((yyval.na),"SUM(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 252:
-#line 1518 "fortran.y"
-    {sprintf((yyval.na),"MAX(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 253:
-#line 1520 "fortran.y"
-    {sprintf((yyval.na),"TANH(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 254:
-#line 1522 "fortran.y"
-    {sprintf((yyval.na),"MAXVAL(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 255:
-#line 1524 "fortran.y"
-    {sprintf((yyval.na),"MIN(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 256:
-#line 1526 "fortran.y"
-    {sprintf((yyval.na),"MINVAL(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 257:
-#line 1528 "fortran.y"
-    {sprintf((yyval.na),"TRIM(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 258:
-#line 1530 "fortran.y"
-    {sprintf((yyval.na),"SQRT(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 259:
-#line 1532 "fortran.y"
-    {sprintf((yyval.na),"REAL(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 260:
-#line 1534 "fortran.y"
-    {sprintf((yyval.na),"NINT(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 261:
-#line 1536 "fortran.y"
-    {sprintf((yyval.na),"FLOAT(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 262:
-#line 1538 "fortran.y"
-    {sprintf((yyval.na),"EXP(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 263:
-#line 1540 "fortran.y"
-    {sprintf((yyval.na),"COS(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 264:
-#line 1542 "fortran.y"
-    {sprintf((yyval.na),"COSH(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 265:
-#line 1544 "fortran.y"
-    {sprintf((yyval.na),"ACOS(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 266:
-#line 1546 "fortran.y"
-    {sprintf((yyval.na),"SIN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 267:
-#line 1548 "fortran.y"
-    {sprintf((yyval.na),"SINH(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 268:
-#line 1550 "fortran.y"
-    {sprintf((yyval.na),"ASIN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 269:
-#line 1552 "fortran.y"
-    {sprintf((yyval.na),"LOG(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 270:
-#line 1554 "fortran.y"
-    {sprintf((yyval.na),"TAN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 271:
-#line 1556 "fortran.y"
-    {sprintf((yyval.na),"ATAN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 272:
-#line 1558 "fortran.y"
-    {sprintf((yyval.na),"ABS(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 273:
-#line 1560 "fortran.y"
-    {sprintf((yyval.na),"MOD(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 274:
-#line 1562 "fortran.y"
-    {sprintf((yyval.na),"SIGN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 275:
-#line 1564 "fortran.y"
-    {sprintf((yyval.na),"MINLOC(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 276:
-#line 1566 "fortran.y"
-    {sprintf((yyval.na),"MAXLOC(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 277:
-#line 1568 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 278:
-#line 1570 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                   { strcpy((yyval.na),(yyvsp[(1) - (3)].na));strcat((yyval.na),",");strcat((yyval.na),(yyvsp[(3) - (3)].na));};}
-    break;
-
-  case 279:
-#line 1573 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 280:
-#line 1575 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 281:
-#line 1577 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 282:
-#line 1579 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 283:
-#line 1581 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 284:
-#line 1583 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 285:
-#line 1585 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"+");;}
-    break;
-
-  case 286:
-#line 1586 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"-");;}
-    break;
-
-  case 287:
-#line 1589 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"+%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 288:
-#line 1591 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"-%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 289:
-#line 1593 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 290:
-#line 1595 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 291:
-#line 1597 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 292:
-#line 1599 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 293:
-#line 1601 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 294:
-#line 1603 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," > %s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 295:
-#line 1605 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 296:
-#line 1607 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," < %s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 297:
-#line 1609 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 298:
-#line 1611 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," >= %s",(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 299:
-#line 1613 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 300:
-#line 1615 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," <= %s",(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 301:
-#line 1617 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 302:
-#line 1619 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 303:
-#line 1621 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 304:
-#line 1623 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 305:
-#line 1625 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 306:
-#line 1627 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 307:
-#line 1629 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 308:
-#line 1631 "fortran.y"
-    {strcpy((yyval.na),"");;}
-    break;
-
-  case 309:
-#line 1633 "fortran.y"
-    {sprintf((yyval.na),"/%s",(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 310:
-#line 1635 "fortran.y"
-    {sprintf((yyval.na),"/= %s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 311:
-#line 1637 "fortran.y"
-    {sprintf((yyval.na),"//%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 312:
-#line 1640 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"==%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 313:
-#line 1642 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"= %s",(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 314:
-#line 1645 "fortran.y"
-    {if ( couldaddvariable == 1 )
-						{
-						printf("ident = %s\n",(yyvsp[(1) - (1)].nac));
-						strcpy((yyval.na),(yyvsp[(1) - (1)].nac));}
-						;}
-    break;
-
-  case 315:
-#line 1651 "fortran.y"
-    {if ( couldaddvariable == 1 ) {
-                   printf("struct = %s\n",(yyvsp[(1) - (1)].na));
-                   strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
-                   ;}
-    break;
-
-  case 316:
-#line 1656 "fortran.y"
-    {if ( couldaddvariable == 1 ) {
-                   printf("arrayref = %s\n",(yyvsp[(1) - (1)].na));
-                   strcpy((yyval.na),(yyvsp[(1) - (1)].na));
-                   };}
-    break;
-
-  case 317:
-#line 1661 "fortran.y"
-    {
-                      agrif_parentcall =0;
-                      if (!strcasecmp(identcopy,"Agrif_Parent") )
-                                                            agrif_parentcall =1;
-                      if ( Agrif_in_Tok_NAME(identcopy) == 1 )
-                      {
-                         inagrifcallargument = 1;
-                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                      }
-                   ;}
-    break;
-
-  case 318:
-#line 1674 "fortran.y"
-    {
-                     strcpy((yyval.na),(yyvsp[(1) - (1)].na));
-                     if ( incalldeclare == 0 ) inagrifcallargument = 0;
-                   ;}
-    break;
-
-  case 319:
-#line 1679 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," %s %s ",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 320:
-#line 1681 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                                sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 321:
-#line 1684 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                         sprintf((yyval.na)," %s ( %s ) %s ",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
-    break;
-
-  case 322:
-#line 1688 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].nac),(yyvsp[(3) - (4)].na));
-                         ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].na));
-                         agrif_parentcall =0;
-                      }
-                   ;}
-    break;
-
-  case 323:
-#line 1698 "fortran.y"
-    {
-                      sprintf((yyval.na)," %s %% %s ",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));
-                      if ( incalldeclare == 0 ) inagrifcallargument = 0;
-                   ;}
-    break;
-
-  case 324:
-#line 1704 "fortran.y"
-    {sprintf((yyval.na),"(/%s/)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 325:
-#line 1706 "fortran.y"
-    {strcpy((yyval.na)," ");;}
-    break;
-
-  case 326:
-#line 1708 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 327:
-#line 1710 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 328:
-#line 1712 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 329:
-#line 1714 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 330:
-#line 1715 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 331:
-#line 1718 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s :%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 332:
-#line 1720 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                               sprintf((yyval.na),"%s :%s :%s",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
-    break;
-
-  case 333:
-#line 1723 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":%s :%s",(yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].na));;}
-    break;
-
-  case 334:
-#line 1724 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),": : %s",(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 335:
-#line 1725 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 336:
-#line 1726 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s :",(yyvsp[(1) - (2)].na));;}
-    break;
-
-  case 337:
-#line 1727 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":");;}
-    break;
-
-  case 338:
-#line 1729 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 && afterpercent == 0)
-                       {
-                       if ( Vartonumber((yyvsp[(1) - (1)].nac)) == 1 )
-                       {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                       if (!strcasecmp((yyvsp[(1) - (1)].nac),"Agrif_Parent") )
-                                                            agrif_parentcall =1;
-                       if ( VariableIsNotFunction((yyvsp[(1) - (1)].nac)) == 0 )
-                       {
-                       printf("var = %s\n",(yyvsp[(1) - (1)].nac));
-                          if ( inagrifcallargument == 1 )
-                          {
-                             if ( !strcasecmp((yyvsp[(1) - (1)].nac),identcopy) )
-                             {
-                                strcpy(sameagrifname,identcopy);
-                                sameagrifargument = 1;
-                             }
-                          }
-                          strcpy(identcopy,(yyvsp[(1) - (1)].nac));
-                          pointedvar=0;
-                          strcpy(truename,(yyvsp[(1) - (1)].nac));
-                          if (variscoupled_0((yyvsp[(1) - (1)].nac))) strcpy(truename,getcoupledname_0((yyvsp[(1) - (1)].nac)));
-
-                          if ( VarIsNonGridDepend(truename) == 0 &&
-                               Variableshouldberemove(truename) == 0 )
-                          {                      
-                             if ( inagrifcallargument == 1 ||
-                                  varispointer_0(truename) == 1 )
-                             {
-                             printf("var2 = %s\n",(yyvsp[(1) - (1)].nac));
-                            if ((IsinListe(List_UsedInSubroutine_Var,(yyvsp[(1) - (1)].nac)) == 1) || (inagrifcallargument == 1))
-                             {
-                              if (varistyped_0(truename) == 0)
-                                 {
-                                 ModifyTheVariableName_0(truename,strlen((yyvsp[(1) - (1)].nac)));
-                                 }
-                                 }
-                             }
-                             printf("ici3\n");
-                             if ( inagrifcallargument != 1 ||
-                                  sameagrifargument ==1 )
-                                  {
-                                  printf("ici5 %s\n",truename);
-                                  Add_UsedInSubroutine_Var_1(truename);
-                          }
-                          }
-                          NotifyAgrifFunction_0(truename);
-                       }
-                       }
-                       else
-                       {
-                       afterpercent = 0;
-                    }
-                    ;}
-    break;
-
-  case 339:
-#line 1788 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),".TRUE.");;}
-    break;
-
-  case 340:
-#line 1789 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),".FALSE.");;}
-    break;
-
-  case 341:
-#line 1790 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 342:
-#line 1791 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 343:
-#line 1792 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 344:
-#line 1793 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 345:
-#line 1795 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.nac),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].nac));;}
-    break;
-
-  case 347:
-#line 1799 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 349:
-#line 1802 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 350:
-#line 1804 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 351:
-#line 1806 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
-    break;
-
-  case 352:
-#line 1807 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 353:
-#line 1810 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s :%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 354:
-#line 1812 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
-    break;
-
-  case 355:
-#line 1813 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 356:
-#line 1815 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
-    break;
-
-  case 357:
-#line 1816 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 358:
-#line 1818 "fortran.y"
-    {   strcpy(InitialValueGiven," ");;}
-    break;
-
-  case 359:
-#line 1820 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                          strcpy(InitValue,(yyvsp[(3) - (3)].na));
-                          strcpy(InitialValueGiven,"=");
-                       }
-                    ;}
-    break;
-
-  case 360:
-#line 1828 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                          strcpy(InitValue,(yyvsp[(3) - (3)].na));
-                          strcpy(InitialValueGiven,"=>");
-                       }
-                    ;}
-    break;
-
-  case 361:
-#line 1836 "fortran.y"
-    {pos_curinit = setposcur();;}
-    break;
-
-  case 362:
-#line 1839 "fortran.y"
-    {sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 363:
-#line 1842 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                      /* if variables has been declared in a subroutine       */
-                      if (insubroutinedeclare == 1)
-                      {
-                         copyuse_0((yyvsp[(2) - (2)].nac));
-                      }
-                      sprintf(charusemodule,"%s",(yyvsp[(2) - (2)].nac));
-                      Add_NameOfModuleUsed_1((yyvsp[(2) - (2)].nac));
-
-                      if ( inmoduledeclare == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curuse,
-                                               pos_end-pos_curuse);
-                      }
-                      }
-                    ;}
-    break;
-
-  case 364:
-#line 1862 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                      if (insubroutinedeclare == 1)
-                      {
-                         Add_CouplePointed_Var_1((yyvsp[(2) - (4)].nac),(yyvsp[(4) - (4)].lc));
-                      }
-                      if ( firstpass == 1 )
-                      {
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            coupletmp = (yyvsp[(4) - (4)].lc);
-                            strcpy(ligne,"");
-                            while ( coupletmp )
-                            {
-                               strcat(ligne,coupletmp->c_namevar);
-                               strcat(ligne," => ");
-                               strcat(ligne,coupletmp->c_namepointedvar);
-                               coupletmp = coupletmp->suiv;
-                               if ( coupletmp ) strcat(ligne,",");
-                            }
-                            sprintf(charusemodule,"%s",(yyvsp[(2) - (4)].nac));
-                         }
-                         Add_NameOfModuleUsed_1((yyvsp[(2) - (4)].nac));
-                      }
-                      if ( inmoduledeclare == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curuse,
-                                               pos_end-pos_curuse);
-                      }
-                      }
-                    ;}
-    break;
-
-  case 365:
-#line 1896 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                      /* if variables has been declared in a subroutine       */
-                      if (insubroutinedeclare == 1)
-                      {
-                         copyuseonly_0((yyvsp[(2) - (6)].nac));
-                      }
-                      sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].nac));
-                      Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].nac));
-
-                       if ( inmoduledeclare == 0 )
-                       {
-                          pos_end = setposcur();
-                          RemoveWordSET_0(fortranout,pos_curuse,
-                                                pos_end-pos_curuse);
-                       }
-                       }
-                    ;}
-    break;
-
-  case 366:
-#line 1916 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       /* if variables has been declared in a subroutine      */
-                       if (insubroutinedeclare == 1)
-                       {
-                          Add_CouplePointed_Var_1((yyvsp[(2) - (6)].nac),(yyvsp[(6) - (6)].lc));
-                       }
-                       if ( firstpass == 1 )
-                       {
-                         if ( insubroutinedeclare == 1 )
-                         {
-                             coupletmp = (yyvsp[(6) - (6)].lc);
-                             strcpy(ligne,"");
-                             while ( coupletmp )
-                             {
-                                strcat(ligne,coupletmp->c_namevar);
-                               if ( strcasecmp(coupletmp->c_namepointedvar,"") )
-                                                           strcat(ligne," => ");
-                                strcat(ligne,coupletmp->c_namepointedvar);
-                                coupletmp = coupletmp->suiv;
-                                if ( coupletmp ) strcat(ligne,",");
-                             }
-                             sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].nac));
-                          }
-                          Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].nac));
-                       }
-                       if ( firstpass == 0 )
-                       {
-                          if ( inmoduledeclare == 0 )
-                          {
-
-                            pos_end = setposcur();
-                             RemoveWordSET_0(fortranout,pos_curuse,
-                                                   pos_end-pos_curuse);
-                       if (oldfortranout) 
-                         variableisglobalinmodule((yyvsp[(6) - (6)].lc),(yyvsp[(2) - (6)].nac),oldfortranout,pos_curuseold);
-                        
-                          }
-                          else
-                          {
-
-                             /* if we are in the module declare and if the    */
-                             /* onlylist is a list of global variable         */
-                             variableisglobalinmodule((yyvsp[(6) - (6)].lc), (yyvsp[(2) - (6)].nac), fortranout,pos_curuse);
-                          }
-                       }
-                       }
-                    ;}
-    break;
-
-  case 367:
-#line 1967 "fortran.y"
-    {
-                      pos_curuse = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                     if (firstpass == 0 && oldfortranout) {
-                     pos_curuseold = setposcurname(oldfortranout);
-                     }
-                   ;}
-    break;
-
-  case 368:
-#line 1975 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 369:
-#line 1978 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 ) (yyval.lc) = (yyvsp[(1) - (1)].lc);
-                    ;}
-    break;
-
-  case 370:
-#line 1982 "fortran.y"
-    {
-                        if ( couldaddvariable == 1 )
-                        {
-                        /* insert the variable in the list $1                 */
-                        (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
-                        (yyval.lc) = (yyvsp[(3) - (3)].lc);
-                        }
-                    ;}
-    break;
-
-  case 371:
-#line 1992 "fortran.y"
-    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].nac));
-                       Save_Length((yyvsp[(1) - (3)].nac),21);
-                       strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].nac));
-                       Save_Length((yyvsp[(3) - (3)].nac),22);
-                       coupletmp->suiv = NULL;
-                       (yyval.lc) = coupletmp;
-                     ;}
-    break;
-
-  case 372:
-#line 2003 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 ) (yyval.lc) = (yyvsp[(1) - (1)].lc);
-                    ;}
-    break;
-
-  case 373:
-#line 2007 "fortran.y"
-    {
-                        if ( couldaddvariable == 1 )
-                        {
-                        /* insert the variable in the list $1                 */
-                        (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
-                        (yyval.lc) = (yyvsp[(3) - (3)].lc);
-                        }
-                    ;}
-    break;
-
-  case 374:
-#line 2017 "fortran.y"
-    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].nac));
-                       Save_Length((yyvsp[(1) - (3)].nac),21);
-                       strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].nac));
-                       Save_Length((yyvsp[(3) - (3)].nac),22);
-                       coupletmp->suiv = NULL;
-                       (yyval.lc) = coupletmp;
-                       pointedvar=1;
-                       Add_UsedInSubroutine_Var_1((yyvsp[(1) - (3)].nac));
-                    ;}
-    break;
-
-  case 375:
-#line 2028 "fortran.y"
-    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (1)].nac));
-                       Save_Length((yyvsp[(1) - (1)].nac),21);
-                       strcpy(coupletmp->c_namepointedvar,"");
-                       coupletmp->suiv = NULL;
-                       (yyval.lc) = coupletmp;
-                     ;}
-    break;
-
-  case 377:
-#line 2039 "fortran.y"
-    {
-                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     ;}
-    break;
-
-  case 378:
-#line 2045 "fortran.y"
-    {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                         curmodulename);
-                                                         inallocate = 0;
-                     ;}
-    break;
-
-  case 380:
-#line 2052 "fortran.y"
-    {
-                       GlobalDeclaration = 0 ;
-                       if ( firstpass == 0 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                          if ( module_declar && insubroutinedeclare == 0 )
-                          {
-                              fclose(module_declar);
-                          }
-                       }
-                       if ( couldaddvariable == 1 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                       if ( inmodulemeet == 1 )
-                       {
-                         /* we are in a module                                */
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            /* it is like an end subroutine <name>            */
-                            insubroutinedeclare = 0 ;
-                            /*                                                */
-                            pos_cur = setposcur();
-                            closeandcallsubloopandincludeit_0(1);
-                            functiondeclarationisdone = 0;
-                         }
-                         else
-                         {
-                            /* it is like an end module <name>                */
-                            inmoduledeclare = 0 ;
-                            inmodulemeet = 0 ;
-                         }
-                       }
-                       else
-                       {
-                          insubroutinedeclare = 0;
-                          /*                                                  */
-                          pos_cur = setposcur();                        
-                          closeandcallsubloopandincludeit_0(2);
-                            functiondeclarationisdone = 0;
-                          if ( firstpass == 0 )
-                          {
-                             if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                             else fprintf(paramout,"C\n");
-                             fclose(paramout);
-                           }
-                        }
-                      }
-                      strcpy(subroutinename,"");
-                    ;}
-    break;
-
-  case 381:
-#line 2102 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();                      
-                       closeandcallsubloopandincludeit_0(3);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    ;}
-    break;
-
-  case 382:
-#line 2120 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();
-                                             
-                       closeandcallsubloopandincludeit_0(1);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    ;}
-    break;
-
-  case 383:
-#line 2140 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();
-
-                       closeandcallsubloopandincludeit_0(0);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    ;}
-    break;
-
-  case 384:
-#line 2159 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       /* if we never meet the contains keyword               */
-                      Remove_Word_end_module_0(strlen((yyvsp[(2) - (2)].nac)));
-                       if ( inmoduledeclare == 1 )
-                       {
-                          if ( aftercontainsdeclare == 0 )
-                          {
-                             Write_GlobalParameter_Declaration_0();
-                             Write_NotGridDepend_Declaration_0();
-                             Write_GlobalType_Declaration_0();
-                             if ( module_declar_type )
-                             {
-                             strcpy (ligne, "\n#include \"Module_DeclarType_");
-                             strcat (ligne, curmodulename);
-                             strcat (ligne, ".h\"\n");
-                             tofich(fortranout,ligne,1); 
-                             }
-                             Write_Alloc_Subroutine_For_End_0();
-                          }
-                       }
-                                           
-                       inmoduledeclare = 0 ;
-                       inmodulemeet = 0 ;
-
-                      Write_Word_end_module_0();
-                      strcpy(curmodulename,"");
-                      aftercontainsdeclare = 1;
-                      if ( firstpass == 0 )
-                      {
-                         if ( module_declar && insubroutinedeclare == 0)
-                         {
-                           fclose(module_declar);
-                         }
-                         if ( module_declar_type && insubroutinedeclare == 0)
-                         {
-                          fclose(module_declar_type);
-                          module_declar_type = 0;
-                         }
-                      }
-                      GlobalDeclaration = 0 ;
-                      }
-                  ;}
-    break;
-
-  case 398:
-#line 2217 "fortran.y"
-    {
-                      if (inmoduledeclare == 1 )
-                      {
-                         Remove_Word_Contains_0();
-                         Write_GlobalParameter_Declaration_0();
-                         Write_GlobalType_Declaration_0();
-                             if ( module_declar_type)
-                             {                         
-                             strcpy (ligne, "\n#include \"Module_DeclarType_");
-                             strcat (ligne, curmodulename);
-                             strcat (ligne, ".h\"\n");
-                             tofich(fortranout,ligne,1); 
-                             }
-                         Write_NotGridDepend_Declaration_0();
-                         Write_Alloc_Subroutine_0();
-                         inmoduledeclare = 0 ;
-                         aftercontainsdeclare = 1;
-                      }
-                      else
-                      {
-                      incontainssubroutine = 1;
-                      strcpy(previoussubroutinename,subroutinename);
-                       if ( couldaddvariable == 1 )
-                       {
-                          if ( firstpass == 1 ) List_ContainsSubroutine =
-                                                Addtolistnom(subroutinename,
-                                                     List_ContainsSubroutine,0);
-                          insubroutinedeclare = 0;
-                          /*                                                  */
-
-                          closeandcallsubloop_contains_0();
-                            functiondeclarationisdone = 0;
-                         if ( firstpass == 0 )
-                         {
-                            if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                            else fprintf(paramout,"C\n");
-                            fclose(paramout);
-                         }
-                         }
-                         strcpy(subroutinename,"");
-                      }
-                   ;}
-    break;
-
-  case 399:
-#line 2261 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       functiondeclarationisdone = 0;
-                       }
-                    ;}
-    break;
-
-  case 400:
-#line 2271 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       }
-                    ;}
-    break;
-
-  case 401:
-#line 2280 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       }
-                    ;}
-    break;
-
-  case 402:
-#line 2289 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       }
-                    ;}
-    break;
-
-  case 414:
-#line 2311 "fortran.y"
-    {strcpy((yyval.nac),"");;}
-    break;
-
-  case 415:
-#line 2312 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 425:
-#line 2332 "fortran.y"
-    {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     ;}
-    break;
-
-  case 426:
-#line 2338 "fortran.y"
-    {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     ;}
-    break;
-
-  case 432:
-#line 2349 "fortran.y"
-    {if ( couldaddvariable == 1 ) created_dimensionlist = 0;;}
-    break;
-
-  case 433:
-#line 2351 "fortran.y"
-    {
-                  created_dimensionlist = 1;
-                  if  ( agrif_parentcall == 1 )
-                  {
-                      ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].d)->dim.last);
-                      agrif_parentcall =0;
-                      fprintf(fortranout," = ");
-                  }
-              ;}
-    break;
-
-  case 434:
-#line 2361 "fortran.y"
-    {created_dimensionlist = 1;;}
-    break;
-
-  case 439:
-#line 2369 "fortran.y"
-    {
-                      inagrifcallargument = 0 ;
-                      incalldeclare=0;
-                      if ( oldfortranout &&
-                           !strcasecmp(meetagrifinitgrids,subroutinename) &&
-                           firstpass == 0 &&
-                           callmpiinit == 1)
-                      {
-                      /*   pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcall,
-                                               pos_end-pos_curcall);
-                         fprintf(oldfortranout,"      Call MPI_Init (%s) \n"
-                                                                   ,mpiinitvar);*/
-                      }
-                      if ( oldfortranout           &&
-                           callagrifinitgrids == 1 &&
-                           firstpass == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcall,
-                                               pos_end-pos_curcall);
-
-                         strcpy(subofagrifinitgrids,subroutinename);
-                      }
-                      Instanciation_0(sameagrifname);
-                   ;}
-    break;
-
-  case 444:
-#line 2403 "fortran.y"
-    {
-                       if (!strcasecmp((yyvsp[(2) - (2)].nac),"MPI_Init") )
-                       {
-                          callmpiinit = 1;
-                       }
-                       else
-                       {
-                          callmpiinit = 0;
-                       }
-                       if (!strcasecmp((yyvsp[(2) - (2)].nac),"Agrif_Init_Grids") )
-                       {
-                          callagrifinitgrids = 1;
-                          strcpy(meetagrifinitgrids,subroutinename);
-                       }
-                       else callagrifinitgrids = 0;
-                       if ( !strcasecmp((yyvsp[(2) - (2)].nac),"Agrif_Open_File") )
-                       {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                       if ( Vartonumber((yyvsp[(2) - (2)].nac)) == 1 )
-                       {
-                          incalldeclare=1;
-                          inagrifcallargument = 1 ;
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                    ;}
-    break;
-
-  case 445:
-#line 2433 "fortran.y"
-    {pos_curcall=setposcur()-4;;}
-    break;
-
-  case 448:
-#line 2438 "fortran.y"
-    {
-                  if ( callmpiinit == 1 )
-                  {
-                     strcpy(mpiinitvar,(yyvsp[(1) - (1)].na));
-                     if ( firstpass == 1 )
-                     {
-                        Add_UsedInSubroutine_Var_1 (mpiinitvar);
-/*                        curvar=createvar($1,NULL);
-                        curlistvar=insertvar(NULL,curvar);
-                        List_Subr outineArgument_Var = AddListvarToListvar
-                         (curlistvar,List_SubroutineAr gument_Var,1);*/
-                     }
-                  }
-               ;}
-    break;
-
-  case 520:
-#line 2562 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 521:
-#line 2563 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 522:
-#line 2564 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 523:
-#line 2567 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 524:
-#line 2569 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 525:
-#line 2571 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 526:
-#line 2573 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 527:
-#line 2575 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 528:
-#line 2577 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 529:
-#line 2578 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 530:
-#line 2579 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 531:
-#line 2582 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 532:
-#line 2584 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," (%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 533:
-#line 2586 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 534:
-#line 2588 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 535:
-#line 2590 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 536:
-#line 2594 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                              sprintf((yyval.na),"%s=%s,%s)",(yyvsp[(1) - (5)].nac),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
-    break;
-
-  case 537:
-#line 2597 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                        sprintf((yyval.na),"%s=%s,%s,%s)",(yyvsp[(1) - (7)].nac),(yyvsp[(3) - (7)].na),(yyvsp[(5) - (7)].na),(yyvsp[(7) - (7)].na));;}
-    break;
-
-  case 544:
-#line 2613 "fortran.y"
-    {Add_Allocate_Var_1((yyvsp[(1) - (1)].nac),curmodulename);;}
-    break;
-
-  case 547:
-#line 2618 "fortran.y"
-    {Add_Allocate_Var_1((yyvsp[(1) - (4)].nac),curmodulename);;}
-    break;
-
-  case 555:
-#line 2641 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-
-/* Line 1267 of yacc.c.  */
-#line 6522 "fortran.tab.c"
-      default: break;
-    }
-  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
-
-  YYPOPSTACK (yylen);
-  yylen = 0;
-  YY_STACK_PRINT (yyss, yyssp);
-
-  *++yyvsp = yyval;
-
-
-  /* Now `shift' the result of the reduction.  Determine what state
-     that goes to, based on the state we popped back to and the rule
-     number reduced by.  */
-
-  yyn = yyr1[yyn];
-
-  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
-  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
-    yystate = yytable[yystate];
-  else
-    yystate = yydefgoto[yyn - YYNTOKENS];
-
-  goto yynewstate;
-
-
-/*------------------------------------.
-| yyerrlab -- here on detecting error |
-`------------------------------------*/
-yyerrlab:
-  /* If not already recovering from an error, report this error.  */
-  if (!yyerrstatus)
-    {
-      ++yynerrs;
-#if ! YYERROR_VERBOSE
-      yyerror (YY_("syntax error"));
-#else
-      {
-	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
-	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
-	  {
-	    YYSIZE_T yyalloc = 2 * yysize;
-	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
-	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
-	    if (yymsg != yymsgbuf)
-	      YYSTACK_FREE (yymsg);
-	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
-	    if (yymsg)
-	      yymsg_alloc = yyalloc;
-	    else
-	      {
-		yymsg = yymsgbuf;
-		yymsg_alloc = sizeof yymsgbuf;
-	      }
-	  }
-
-	if (0 < yysize && yysize <= yymsg_alloc)
-	  {
-	    (void) yysyntax_error (yymsg, yystate, yychar);
-	    yyerror (yymsg);
-	  }
-	else
-	  {
-	    yyerror (YY_("syntax error"));
-	    if (yysize != 0)
-	      goto yyexhaustedlab;
-	  }
-      }
-#endif
-    }
-
-
-
-  if (yyerrstatus == 3)
-    {
-      /* If just tried and failed to reuse look-ahead token after an
-	 error, discard it.  */
-
-      if (yychar <= YYEOF)
-	{
-	  /* Return failure if at end of input.  */
-	  if (yychar == YYEOF)
-	    YYABORT;
-	}
-      else
-	{
-	  yydestruct ("Error: discarding",
-		      yytoken, &yylval);
-	  yychar = YYEMPTY;
-	}
-    }
-
-  /* Else will try to reuse look-ahead token after shifting the error
-     token.  */
-  goto yyerrlab1;
-
-
-/*---------------------------------------------------.
-| yyerrorlab -- error raised explicitly by YYERROR.  |
-`---------------------------------------------------*/
-yyerrorlab:
-
-  /* Pacify compilers like GCC when the user code never invokes
-     YYERROR and the label yyerrorlab therefore never appears in user
-     code.  */
-  if (/*CONSTCOND*/ 0)
-     goto yyerrorlab;
-
-  /* Do not reclaim the symbols of the rule which action triggered
-     this YYERROR.  */
-  YYPOPSTACK (yylen);
-  yylen = 0;
-  YY_STACK_PRINT (yyss, yyssp);
-  yystate = *yyssp;
-  goto yyerrlab1;
-
-
-/*-------------------------------------------------------------.
-| yyerrlab1 -- common code for both syntax error and YYERROR.  |
-`-------------------------------------------------------------*/
-yyerrlab1:
-  yyerrstatus = 3;	/* Each real token shifted decrements this.  */
-
-  for (;;)
-    {
-      yyn = yypact[yystate];
-      if (yyn != YYPACT_NINF)
-	{
-	  yyn += YYTERROR;
-	  if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
-	    {
-	      yyn = yytable[yyn];
-	      if (0 < yyn)
-		break;
-	    }
-	}
-
-      /* Pop the current state because it cannot handle the error token.  */
-      if (yyssp == yyss)
-	YYABORT;
-
-
-      yydestruct ("Error: popping",
-		  yystos[yystate], yyvsp);
-      YYPOPSTACK (1);
-      yystate = *yyssp;
-      YY_STACK_PRINT (yyss, yyssp);
-    }
-
-  if (yyn == YYFINAL)
-    YYACCEPT;
-
-  *++yyvsp = yylval;
-
-
-  /* Shift the error token.  */
-  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);
-
-  yystate = yyn;
-  goto yynewstate;
-
-
-/*-------------------------------------.
-| yyacceptlab -- YYACCEPT comes here.  |
-`-------------------------------------*/
-yyacceptlab:
-  yyresult = 0;
-  goto yyreturn;
-
-/*-----------------------------------.
-| yyabortlab -- YYABORT comes here.  |
-`-----------------------------------*/
-yyabortlab:
-  yyresult = 1;
-  goto yyreturn;
-
-#ifndef yyoverflow
-/*-------------------------------------------------.
-| yyexhaustedlab -- memory exhaustion comes here.  |
-`-------------------------------------------------*/
-yyexhaustedlab:
-  yyerror (YY_("memory exhausted"));
-  yyresult = 2;
-  /* Fall through.  */
-#endif
-
-yyreturn:
-  if (yychar != YYEOF && yychar != YYEMPTY)
-     yydestruct ("Cleanup: discarding lookahead",
-		 yytoken, &yylval);
-  /* Do not reclaim the symbols of the rule which action triggered
-     this YYABORT or YYACCEPT.  */
-  YYPOPSTACK (yylen);
-  YY_STACK_PRINT (yyss, yyssp);
-  while (yyssp != yyss)
-    {
-      yydestruct ("Cleanup: popping",
-		  yystos[*yyssp], yyvsp);
-      YYPOPSTACK (1);
-    }
-#ifndef yyoverflow
-  if (yyss != yyssa)
-    YYSTACK_FREE (yyss);
-#endif
-#if YYERROR_VERBOSE
-  if (yymsg != yymsgbuf)
-    YYSTACK_FREE (yymsg);
-#endif
-  /* Make sure YYID is used.  */
-  return YYID (yyresult);
-}
-
-
-#line 2643 "fortran.y"
-
-
-void processfortran(char *fichier_entree)
-{
-   extern FILE *fortranin;
-   extern FILE *fortranout;
-   char nomfile[LONG_C];
-   int c;
-   int confirmyes;
-
-/*   fortrandebug = 1;*/
-   if ( mark == 1 ) printf("Firstpass == %d \n",firstpass);
-/******************************************************************************/
-/*  1-  Open input and output files                                           */
-/******************************************************************************/
-   strcpy(nomfile,commondirin);
-   strcat(nomfile,"/");
-   strcat(nomfile,fichier_entree);
-   fortranin=fopen( nomfile,"r");
-   if (! fortranin)
-   {
-      printf("Error : File %s does not exist\n",nomfile);
-      exit(1);
-   }
-
-   strcpy(curfile,nomfile);
-   strcpy(nomfile,commondirout);
-   strcat(nomfile,"/");
-   strcat(nomfile,fichier_entree);
-   strcpy(nomfileoutput,nomfile);
-   Save_Length(nomfileoutput,31);
-   if (firstpass == 1)
-   {
-      if (checkexistcommon == 1)
-      {
-         if (fopen(nomfile,"r"))
-         {
-            printf("Warning : file %s already exist\n",nomfile);
-            confirmyes = 0;
-            while (confirmyes==0)
-            {
-               printf("Override file %s ? [Y/N]\n",nomfile);
-               c=getchar();
-               getchar();
-               if (c==79 || c==110)
-               {
-                  printf("We stop\n");
-                  exit(1);
-               }
-               if (c==89 || c==121)
-               {
-                  confirmyes=1;
-               }
-            }
-         }
-      }
-   }
-
-/******************************************************************************/
-/*  2-  Variables initialization                                              */
-/******************************************************************************/
-
-   line_num_fortran_common=1;
-   line_num_fortran=1;
-   PublicDeclare = 0;
-   PrivateDeclare = 0;
-   ExternalDeclare = 0;
-   SaveDeclare = 0;
-   pointerdeclare = 0;
-   optionaldeclare = 0;
-   incalldeclare = 0;
-   VarType = 0;
-   VarTypepar = 0;
-   Allocatabledeclare = 0 ;
-   Targetdeclare = 0 ;
-   strcpy(NamePrecision," ");
-   VariableIsParameter =  0 ;
-   strcpy(NamePrecision,"");
-   c_star = 0 ;
-   functiondeclarationisdone = 0;
-   insubroutinedeclare = 0 ;
-   ininterfacedeclare = 0 ;   
-   strcpy(subroutinename," ");
-   isrecursive = 0;
-   strcpy(InitialValueGiven," ");
-   strcpy(EmptyChar," ");
-   inmoduledeclare = 0;
-   incontainssubroutine = 0;
-   module_declar_type = 0;
-   GlobalDeclarationType = 0;
-   colnum=0;
-   incom=0;
-   couldaddvariable=1;
-   afterpercent = 0;
-   aftercontainsdeclare = 1;
-   strcpy(nameinttypename,"");
-   /* Name of the file without format                                         */
-   tmp = strchr(fichier_entree, '.');
-   strncpy(curfilename,fichier_entree,strlen(fichier_entree)-strlen(tmp));
-   Save_Length(curfilename,30);
-/******************************************************************************/
-/*  3-  Parsing of the input file (1 time)                                    */
-/******************************************************************************/
-   if (firstpass == 0 )
-   {
-      fortranout=fopen(nomfileoutput,"w");
-
-/*      NewModule_Creation_0();*/
-   }
-
-   fortranparse();
-
-   if (firstpass == 0 )
-   {
-   NewModule_Creation_0();
-   }
-   
-   strcpy(curfile,mainfile);
-
-   if (firstpass == 0 )
-   {
-   fclose(fortranout);
-   }
-}
-
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y	(revision 6807)
+++ 	(revision )
@@ -1,2766 +1,0 @@
-/******************************************************************************/
-/*                                                                            */
-/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
-/*                                                                            */
-/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
-/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
-/* This software is governed by the CeCILL-C license under French law and     */
-/* abiding by the rules of distribution of free software.  You can  use,      */
-/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
-/* license as circulated by CEA, CNRS and INRIA at the following URL          */
-/* "http ://www.cecill.info".                                                  */
-/*                                                                            */
-/* As a counterpart to the access to the source code and  rights to copy,     */
-/* modify and redistribute granted by the license, users are provided only    */
-/* with a limited warranty  and the software's author,  the holder of the     */
-/* economic rights,  and the successive licensors  have only  limited         */
-/* liability.                                                                 */
-/*                                                                            */
-/* In this respect, the user's attention is drawn to the risks associated     */
-/* with loading,  using,  modifying and/or developing or reproducing the      */
-/* software by the user in light of its specific status of free software,     */
-/* that may mean  that it is complicated to manipulate,  and  that  also      */
-/* therefore means  that it is reserved for developers  and  experienced      */
-/* professionals having in-depth computer knowledge. Users are therefore      */
-/* encouraged to load and test the software's suitability as regards their    */
-/* requirements in conditions enabling the security of their systems and/or   */
-/* data to be ensured and,  more generally, to use and operate it in the      */
-/* same conditions as regards security.                                       */
-/*                                                                            */
-/* The fact that you are presently reading this means that you have had       */
-/* knowledge of the CeCILL-C license and that you accept its terms.           */
-/******************************************************************************/
-/* version 1.7                                                                */
-/******************************************************************************/
-
-%{
-#define YYMAXDEPTH 1000
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include "decl.h"
-extern int line_num_fortran;
-extern int line_num_fortran_common;
-char *tmp;
-char c_selectorname[LONG_C];
-char ligne[LONG_C];
-char truename[LONGNOM];
-char identcopy[LONG_C];
-int c_selectorgiven=0;
-int incom;
-listvar *curlistvar;
-typedim c_selectordim;
-listcouple *coupletmp;
-listdim *parcoursdim;
-int removeline=0;
-listvar *test;
-%}
-
-%union {
-       char      nac[LONG_C];
-       char      na[LONGNOM];
-       listdim  *d;
-       listvar  *l;
-       listnom  *ln;
-       listcouple  *lc;
-       listname *lnn;
-       typedim   dim1;
-       variable *v;
-       }
-
-%left ','
-%nonassoc ':'
-%right '='
-%left TOK_BINARY_OP
-%left TOK_EQV TOK_NEQV
-%left TOK_OR TOK_XOR
-%left TOK_AND
-%left TOK_NOT
-%nonassoc TOK_LT TOK_GT TOK_LE TOK_GE TOK_EQ TOK_NE
-%nonassoc TOK_UNARY_OP
-%left TOK_DSLASH
-%left '+' '-'
-%left '*' TOK_SLASH
-%right TOK_DASTER
-
-%token TOK_SEP
-%token TOK_SEMICOLON
-%token TOK_NEXTLINE
-%token TOK_PARAMETER
-%token TOK_RESULT
-%token TOK_ONLY
-%token TOK_INCLUDE
-%token TOK_SUBROUTINE
-%token TOK_PROGRAM
-%token TOK_FUNCTION
-%token TOK_OMP
-%token TOK_DOLLAR
-%token TOK_FORMAT
-%token TOK_MAX
-%token TOK_TANH
-%token TOK_WHERE
-%token TOK_ELSEWHERE
-%token TOK_ENDWHERE
-%token TOK_MAXVAL
-%token TOK_TRIM
-%token TOK_SUM
-%token TOK_SQRT
-%token TOK_CASE
-%token TOK_SELECTCASE
-%token TOK_FILE
-%token TOK_END
-%token TOK_ERR
-%token TOK_DONOTTREAT
-%token TOK_ENDDONOTTREAT
-%token TOK_EXIST
-%token TOK_MIN
-%token TOK_FLOAT
-%token TOK_EXP
-%token TOK_COS
-%token TOK_COSH
-%token TOK_ACOS
-%token TOK_NINT
-%token TOK_CYCLE
-%token TOK_SIN
-%token TOK_SINH
-%token TOK_ASIN
-%token TOK_EQUIVALENCE
-%token TOK_BACKSPACE
-%token TOK_LOG
-%token TOK_TAN
-%token TOK_ATAN
-%token TOK_RECURSIVE
-%token TOK_ABS
-%token TOK_MOD
-%token TOK_SIGN
-%token TOK_MINLOC
-%token TOK_MAXLOC
-%token TOK_EXIT
-%token TOK_MINVAL
-%token TOK_PUBLIC
-%token TOK_PRIVATE
-%token TOK_ALLOCATABLE
-%token TOK_RETURN
-%token TOK_THEN
-%token TOK_ELSEIF
-%token TOK_ELSE
-%token TOK_ENDIF
-%token TOK_PRINT
-%token TOK_PLAINGOTO
-%token TOK_CONSTRUCTID
-%token TOK_LOGICALIF
-%token TOK_PLAINDO
-%token TOK_CONTAINS
-%token TOK_ENDDO
-%token TOK_MODULE
-%token TOK_ENDMODULE
-%token TOK_DOWHILE
-%token TOK_ALLOCATE
-%token TOK_OPEN
-%token TOK_CLOSE
-%token TOK_INQUIRE
-%token TOK_WRITE
-%token TOK_READ
-%token TOK_REWIND
-%token TOK_DEALLOCATE
-%token TOK_NULLIFY
-%token TOK_FIN
-%token TOK_DEBUT
-%token TOK_DIMENSION
-%token TOK_ENDSELECT
-%token TOK_EXTERNAL
-%token TOK_INTENT
-%token TOK_INTRINSIC
-%token TOK_NAMELIST
-%token TOK_CASEDEFAULT
-%token TOK_OPTIONAL
-%token TOK_POINTER
-%token TOK_CONTINUE
-%token TOK_SAVE
-%token TOK_TARGET
-%token TOK_QUOTE
-%token TOK_IMPLICIT
-%token TOK_NONE
-%token TOK_CALL
-%token TOK_STAT
-%token TOK_POINT_TO
-%token TOK_COMMON
-%token TOK_GLOBAL
-%token TOK_INTERFACE
-%token TOK_ENDINTERFACE
-%token TOK_LEFTAB
-%token TOK_RIGHTAB
-%token TOK_PAUSE
-%token TOK_PROCEDURE
-%token TOK_STOP
-%token TOK_NAMEEQ
-%token TOK_REAL8
-%token <nac> TOK_OUT
-%token <nac> TOK_INOUT
-%token <nac> TOK_IN
-%token <nac> TOK_USE
-%token <nac> TOK_DSLASH
-%token <nac> TOK_DASTER
-%token <nac> TOK_EQ
-%token <nac> TOK_EQV
-%token <nac> TOK_GT
-%token <nac> TOK_LT
-%token <nac> TOK_GE
-%token <nac> TOK_NE
-%token <nac> TOK_NEQV
-%token <nac> TOK_LE
-%token <nac> TOK_OR
-%token <nac> TOK_XOR
-%token <nac> TOK_NOT
-%token <nac> TOK_AND
-%token <nac> TOK_TRUE
-%token <nac> TOK_FALSE
-%token <nac> TOK_LABEL
-%token <nac> TOK_TYPE
-%token <nac> TOK_TYPEPAR
-%token <nac> TOK_ENDTYPE
-%token <nac> TOK_REAL
-%token <nac> TOK_INTEGER
-%token <nac> TOK_LOGICAL
-%token <nac> TOK_DOUBLEPRECISION
-%token <nac> TOK_DOUBLEREAL
-%token <nac> TOK_ENDSUBROUTINE
-%token <nac> TOK_ENDFUNCTION
-%token <nac> TOK_ENDPROGRAM
-%token <nac> TOK_ENDUNIT
-%token <nac> TOK_CHARACTER
-%token <nac> TOK_CHAR_CONSTANT
-%token <nac> TOK_CHAR_CUT
-%token <nac> TOK_DATA
-%token <nac> TOK_CHAR_INT
-%token <nac> TOK_CHAR_MESSAGE
-%token <nac> TOK_CSTREAL
-%token <nac> TOK_CSTREALDP
-%token <nac> TOK_CSTREALQP
-%token <nac> TOK_SFREAL
-%token <nac> TOK_COMPLEX
-%token <nac> TOK_DOUBLECOMPLEX
-%token <nac> TOK_NAME
-%token <nac> TOK_NAME_CHAR
-%token <nac> TOK_PROBTYPE  /* dimension of the problem                        */
-%token <nac> TOK_INTERPTYPE/* kind of interpolation                           */
-%token <nac> TOK_VARTYPE   /* posit ion of the grid variable on the cells of  */
-                          /*     the mesh                                     */
-%token <nac> TOK_SLASH
-%token <nac> TOK_BC        /* calculation of the boundary conditions           */
-%token <nac> TOK_OP
-%token <nac> TOK_CSTINT
-%token <nac> TOK_COMMENT
-%token <nac> TOK_FILENAME
-%token ','
-%token ':'
-%token '('
-%token ')'
-%token '['
-%token ']'
-%token '!'
-%token '_'
-%token '<'
-%token '>'
-%type <l> dcl
-%type <l> after_type
-%type <l> dimension
-%type <l> paramlist
-%type <l> args
-%type <l> arglist
-%type <lc> only_list
-%type <lc> only_name
-%type <lc> rename_list
-%type <lc> rename_name
-%type <d> dims
-%type <d> dimlist
-%type <dim1> dim
-%type <v> paramitem
-%type <nac> comblock
-%type <nac> name_routine
-%type <nac> module_name
-%type <nac> opt_name
-%type <nac> type
-%type <nac> word_endsubroutine
-%type <nac> word_endfunction
-%type <nac> word_endprogram
-%type <nac> word_endunit
-%type <nac> typename
-%type <nac> typespec
-%type <nac> string_constant
-%type <nac> simple_const
-%type <nac> ident
-%type <nac> do_var
-%type <nac> intent_spec
-%type <nac> signe
-%type <nac> opt_signe
-%type <nac> filename
-%type <nac> attribute
-%type <na> complex_const
-%type <na> begin_array
-%type <na> clause
-%type <na> arg
-%type <na> uexpr
-%type <na> minmaxlist
-%type <na> lhs
-%type <na> vec
-%type <na> outlist
-%type <na> out2
-%type <na> other
-%type <na> dospec
-%type <na> expr_data
-%type <na> structure_component
-%type <na> array_ele_substring_func_ref
-%type <na> funarglist
-%type <na> funarg
-%type <na> funargs
-%type <na> triplet
-%type <na> substring
-%type <na> opt_substring
-%type <na> opt_expr
-%type <na> optexpr
-%type <lnn> datavallist
-%type <lnn> datanamelist
-%type <na> after_slash
-%type <na> after_equal
-%type <na> predefinedfunction
-%type <na> expr
-%type <na> ubound
-%type <na> operation
-%type <na> proper_lengspec
-%type <lnn> use_name_list
-%type <lnn> public
-
-%left TOK_OP
-%%
-input :
-      | input line
-      ;
-line :  '\n' position
-      | thislabel suite_line_list
-      | TOK_COMMENT
-      | keyword cmnt writedeclar
-      | error writedeclar nulcurbuf
-                   {yyerrok;yyclearin;}
-      ;
-suite_line_list : suite_line
-      |   suite_line_list TOK_SEMICOLON suite_line
-      ;
-suite_line : entry fin_line  /* subroutine, function, module                    */
-      | spec fin_line      /* declaration                                     */
-      | before_include filename fin_line
-                  {
-                     if (inmoduledeclare == 0 )
-                     {
-                        pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_curinclude,
-                                              pos_end-pos_curinclude);
-                     }
-                  }
-      | exec cmnt writedeclar /* if, do etc ...                               */
-      | instr fin_line    /* instruction ident  : do i = 1 ...                */
-      ;
-instr : ident ':'
-      ;
-fin_line : position cmnt
-      ;
-keyword : TOK_DONOTTREAT
-         {
-            /* we should ignore the declaration until the keyword             */
-            /*    TOK_ENDDONOTTREAT                                           */
-            couldaddvariable = 0 ;
-            RemoveWordCUR_0(fortranout,-20,20);
-         }
-      | TOK_ENDDONOTTREAT
-         {
-             couldaddvariable = 1 ;
-             RemoveWordCUR_0(fortranout,-24,24);
-          }
-      | TOK_OMP
-      | TOK_DOLLAR
-      ;
-position : {pos_cur = setposcur();}
-      ;
-thislabel :
-      | TOK_LABEL nulcurbuf
-      ;
-cmnt :
-      | TOK_COMMENT
-      ;
-incomment :
-                   {incom = 1;}
-      ;
-nulcurbuf :
-                   {if (incom !=1) {strcpy(curbuf,"");incom=0;}}
-      ;
-opt_recursive :
-		{isrecursive = 0;}
-      | TOK_RECURSIVE
-		{isrecursive = 1;}
-      ;
-entry :
-      | opt_recursive TOK_SUBROUTINE name_routine arglist
-                   {
-                      if ( couldaddvariable == 1)
-                      {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$3);
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-
-                      }
-                      Add_SubroutineArgument_Var_1($4);
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(1);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            writeheadnewsub_0(1);
-                      }
-                      }
-                   }
-      | TOK_PROGRAM name_routine
-                   {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$2);
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-
-                      }
-                      strcpy(subroutinename,$2);
-                      /* Common case                                          */
-                      insubroutinedeclare = 1;
-                      /* in the second step we should write the head of       */
-                      /*    the subroutine sub_loop_<subroutinename>          */
-                      writeheadnewsub_0(1);
-                   }
-      | opt_recursive TOK_FUNCTION name_routine arglist TOK_RESULT arglist1
-                   {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$3);
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,$3);
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1($4);
-                         strcpy(DeclType,"");
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            /* we should to list of the subroutine argument   */
-                            /* name of the function which has to be defined   */
-                            Add_SubroutineArgument_Var_1($4);
-                            strcpy(DeclType,"");
-                            Add_FunctionType_Var_1($3);
-                            writeheadnewsub_0(2);
-                      }
-                   }
-      | opt_recursive TOK_FUNCTION name_routine arglist
-                   {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$3);
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,$3);
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1($4);
-                         strcpy(DeclType,"");
-                         Add_FunctionType_Var_1($3);
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            /* we should to list of the subroutine argument   */
-                            /* name of the function which has to be defined   */
-                            Add_SubroutineArgument_Var_1($4);
-                            strcpy(DeclType,"");
-                            Add_FunctionType_Var_1($3);
-                            writeheadnewsub_0(2);
-                      }
-                   }
-      | TOK_MODULE TOK_NAME
-                   {
-                      GlobalDeclaration = 0;
-                      strcpy(curmodulename,$2);
-                      strcpy(subroutinename,"");
-                      Add_NameOfModule_1($2);
-                      if ( inmoduledeclare == 0 )
-                      {
-                         /* To know if there are in the module declaration    */
-                         inmoduledeclare = 1;
-                         /* to know if a module has been met                  */
-                         inmodulemeet = 1;
-                         /* to know if we are after the keyword contains      */
-                         aftercontainsdeclare = 0 ;
-                      }
-                   }
-      ;
-name_routine : TOK_NAME
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy($$,$1);strcpy(subroutinename,$1);
-                      }
-                   }
-writedeclar :
-      ;
-before_include : TOK_INCLUDE
-                   {
-                      pos_curinclude = setposcur()-9;
-                   }
-filename : TOK_CHAR_CONSTANT
-                   {
-                      if ( couldaddvariable == 1 ) Add_Include_1($1);
-                   }
-      ;
-arglist :           {
-                      if ( firstpass == 1 && couldaddvariable == 1) $$=NULL;
-                   }
-      | '(' ')'    {
-                      if ( firstpass == 1 && couldaddvariable == 1 ) $$=NULL;
-                   }
-      | '(' args ')'
-                   {
-                       if ( firstpass == 1 && couldaddvariable == 1 ) $$=$2;
-                   }
-      ;
-arglist1:
-      | '(' ')'
-      | '(' args ')'
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         Add_SubroutineArgument_Var_1($2);
-                      }
-                   }
-      ;
-args :arg           {
-                      if ( firstpass == 1  && couldaddvariable == 1)
-                      {
-                         strcpy(nameinttypenameback,nameinttypename);
-                         strcpy(nameinttypename,"");
-                         curvar=createvar($1,NULL);
-                        strcpy(nameinttypename,nameinttypenameback);
-                         curlistvar=insertvar(NULL,curvar);
-                         $$=settype("",curlistvar);
-                      }
-                   }
-      | args ',' arg
-                   {
-                      if ( firstpass == 1  && couldaddvariable == 1)
-                      {
-                         strcpy(nameinttypenameback,nameinttypename);
-                         strcpy(nameinttypename,"");                      
-                         curvar=createvar($3,NULL);
-                         strcpy(nameinttypename,nameinttypenameback);                         
-                         $$=insertvar($1,curvar);
-                      }
-                   }
-      ;
-arg : TOK_NAME      {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | '*'        {if ( couldaddvariable == 1 ) strcpy($$,"*");}
-      ;
-spec : type after_type
-                   {
-                      if ( VarTypepar == 1 )
-                      {
-                         couldaddvariable = 1 ;
-                         VarTypepar = 0;
-                      }
-                   }
-      | TOK_TYPE opt_spec opt_sep opt_name
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         VarType = 1;
-                         couldaddvariable = 0 ;
-                      }
-                   }
-      | TOK_ENDTYPE opt_name
-                   {
-                      if ( VarType == 1 ) couldaddvariable = 1 ;
-                      VarType = 0;
-                      VarTypepar = 0;
-                   }
-      | TOK_POINTER list_couple
-      | before_parameter  '(' paramlist ')'
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         if ( insubroutinedeclare == 0 )
-                         {
-                                                  Add_GlobalParameter_Var_1($3);
-                                                  }
-                         else Add_Parameter_Var_1($3);
-                         pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                    pos_end-pos_cur_decl);
-                      }
-                      VariableIsParameter =  0 ;
-                   }
-      | before_parameter  paramlist
-                   {
-                     if ( couldaddvariable == 1 )
-                     {
-                        if ( insubroutinedeclare == 0 )
-                                                  Add_GlobalParameter_Var_1($2);
-                         else Add_Parameter_Var_1($2);
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                    pos_end-pos_cur_decl);
-                      }
-                      VariableIsParameter =  0 ;
-                   }
-      | common
-      | save
-                  {
-                     pos_end = setposcur();
-                     RemoveWordSET_0(fortranout,pos_cursave,
-                                                pos_end-pos_cursave);
-                  }
-      | implicit
-      | dimension
-                  {
-                   /* if the variable is a parameter we can suppose that is   */
-                   /*    value is the same on each grid. It is not useless to */
-                   /*    create a copy of it on each grid                     */
-                      if ( couldaddvariable == 1 )
-                      {
-                         Add_Globliste_1($1);
-                         /* if variableparamlists has been declared in a      */
-                         /*    subroutine                                     */
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            Add_Dimension_Var_1($1);
-                         }
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curdimension,
-                                                pos_end-pos_curdimension);
-                      }
-                      /*                                                      */
-                      PublicDeclare = 0;
-                      PrivateDeclare = 0;
-                      ExternalDeclare = 0;
-                      strcpy(NamePrecision,"");
-                      c_star = 0;
-                      strcpy(InitialValueGiven," ");
-                      strcpy(IntentSpec,"");
-                      VariableIsParameter =  0 ;
-                      Allocatabledeclare = 0 ;
-                      Targetdeclare = 0 ;
-                      SaveDeclare = 0;
-                      pointerdeclare = 0;
-                      optionaldeclare = 0 ;
-                      dimsgiven=0;
-                      c_selectorgiven=0;
-                      strcpy(nameinttypename,"");
-                      strcpy(c_selectorname,"");
-                   }
-      | public
-      {
-      if (firstpass == 0)
-      {
-      if ($1)
-      {
-      removeglobfromlist(&($1));
-      pos_end = setposcur();
-           RemoveWordSET_0(fortranout,pos_cur,pos_end-pos_cur);
-      writelistpublic($1);
-      }
-      }
-      }
-      | private
-      | use_stat
-      | module_proc_stmt
-      | interface
-      | namelist
-      | TOK_BACKSPACE '(' expr ')'
-      | TOK_EXTERNAL opt_sep use_name_list
-      | TOK_INTRINSIC opt_sep use_intrinsic_list
-      | TOK_EQUIVALENCE list_expr_equi
-      | before_data data '\n'
-                   {
-                      /* we should remove the data declaration                */
-                      if ( couldaddvariable == 1 && aftercontainsdeclare != 2 )
-                      {
-                        pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_curdata,
-                                              pos_end-pos_curdata);
-                      }
-                      if ( couldaddvariable == 1 && aftercontainsdeclare == 1 )
-                      {
-                      if (firstpass == 0)
-                      {
-                        ReWriteDataStatement_0(fortranout);
-                        pos_end = setposcur();
-                  }
-                      }
-                  }
-      ;
-opt_spec :
-      | access_spec
-      {
-         PublicDeclare = 0 ;
-         PrivateDeclare = 0 ;
-      }
-      ;
-name_intrinsic : TOK_SUM
-      | TOK_TANH
-      | TOK_MAXVAL
-      | TOK_MIN
-      | TOK_MINVAL
-      | TOK_TRIM
-      | TOK_SQRT
-      | TOK_NINT
-      | TOK_FLOAT
-      | TOK_EXP
-      | TOK_COS
-      | TOK_COSH
-      | TOK_ACOS
-      | TOK_SIN
-      | TOK_SINH
-      | TOK_ASIN
-      | TOK_LOG
-      | TOK_TAN
-      | TOK_ATAN
-      | TOK_MOD
-      | TOK_SIGN
-      | TOK_MINLOC
-      | TOK_MAXLOC
-      | TOK_NAME
-      ;
-use_intrinsic_list : name_intrinsic
-      | use_intrinsic_list ',' name_intrinsic
-      ;
-list_couple : '(' list_expr ')'
-      | list_couple ',' '(' list_expr ')'
-      ;
-list_expr_equi : expr_equi
-      | list_expr_equi ',' expr_equi
-      ;
-expr_equi : '(' list_expr_equi1 ')'
-      ;
-list_expr_equi1 : ident dims
-      | list_expr_equi1 ',' ident dims
-      ;
-list_expr : expr
-      | list_expr ',' expr
-      ;
-opt_sep :
-      | ':' ':'
-      ;
-after_type : dcl nodimsgiven
-                   {
-                      /* if the variable is a parameter we can suppose that is*/
-                      /*    value is the same on each grid. It is not useless */
-                      /*    to create a copy of it on each grid               */
-                      if ( couldaddvariable == 1 )
-                      {
-                      pos_end = setposcur();
-                      /*if (insubroutinedeclare == 0)
-                        {   */
-                         RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                 pos_end-pos_cur_decl);
-                                         
-                       /* }
-                      else
-                       {*/
-                        ReWriteDeclarationAndAddTosubroutine_01($1);
-                        pos_cur_decl = setposcur();
-                        
-                       /*}*/
-                      if ( firstpass == 0 &&
-                           GlobalDeclaration == 0 &&
-                           insubroutinedeclare == 0 )
-                      {
-
-                         sprintf(ligne,"\n#include \"Module_Declar_%s.h\"\n"
-                                                                ,curmodulename);
-                         tofich(fortranout,ligne,1);
-                         sprintf (ligne, "Module_Declar_%s.h",curmodulename);
-                         module_declar = associate(ligne);
-                         sprintf (ligne, " ");
-                         tofich (module_declar, ligne,1);
-                         GlobalDeclaration = 1 ;
-                         pos_cur_decl = setposcur();
-
-                      }
-                         $$ = $1;
-                         Add_Globliste_1($1);
-                                                  
-                         if ( insubroutinedeclare == 0 )
-                                                  Add_GlobalParameter_Var_1($1);
-                         else
-                         {
-                            if ( pointerdeclare == 1 )
-                                                Add_Pointer_Var_From_List_1($1);
-                            Add_Parameter_Var_1($1);
-                         }
-
-                         /* if variables has been declared in a subroutine    */
-                         if ( insubroutinedeclare == 1 )
-                         { 
-                       /*    Add_SubroutineDeclaration_Var_1($1);*/
-                         }
-                         /* If there are a SAVE declarations in module's      */
-                         /*    subroutines we should remove it from the       */
-                         /*    subroutines declaration and add it in the      */
-                         /*    global declarations                            */
-                         if ( aftercontainsdeclare == 1 &&
-                              SaveDeclare == 1 && firstpass == 1 )
-                         {
-                              if ( inmodulemeet == 0 ) Add_Save_Var_dcl_1($1);
-                              else  Add_SubroutineDeclarationSave_Var_1($1);
-                         }
-                      }
-                      /*                                                      */
-                      PublicDeclare = 0;
-                      PrivateDeclare = 0;
-                      ExternalDeclare = 0;
-                      strcpy(NamePrecision,"");
-                      c_star = 0;
-                      strcpy(InitialValueGiven," ");
-                      strcpy(IntentSpec,"");
-                      VariableIsParameter =  0 ;
-                      Allocatabledeclare = 0 ;
-                      Targetdeclare = 0 ;
-                      SaveDeclare = 0;
-                      pointerdeclare = 0;
-                      optionaldeclare = 0 ;
-                      dimsgiven=0;
-                      c_selectorgiven=0;
-                      strcpy(nameinttypename,"");
-                      strcpy(c_selectorname,"");
-                      GlobalDeclarationType = 0; 
-                   }
-      | before_function name_routine arglist
-                   {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$2);
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,$2);
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1($3);
-                         Add_FunctionType_Var_1($2);
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1($3);
-                         Add_FunctionType_Var_1($2);
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      strcpy(nameinttypename,"");
-
-                   }
-      ;
-before_function : TOK_FUNCTION
-                   {
-                       functiondeclarationisdone = 1;
-                   }
-                   ;
-
-before_parameter : TOK_PARAMETER
-                   {
-                      VariableIsParameter = 1;
-                      pos_curparameter = setposcur()-9;
-                   }
-before_data : TOK_DATA
-                   {
-                      pos_curdata = setposcur()-strlen($1);
-                      Init_List_Data_Var();
-                   }
-data : TOK_NAME TOK_SLASH datavallist TOK_SLASH
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-/*                      if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
-                      else */
-/*                      sprintf(ligne,"%s",$3);*/
-                      createstringfromlistname(ligne,$3);
-                      if (firstpass == 1)
-                      Add_Data_Var_1(&List_Data_Var,$1,ligne);
-                      else
-                      Add_Data_Var_1(&List_Data_Var_Cur,$1,ligne);
-                      }
-                   }
-      | data opt_comma TOK_NAME TOK_SLASH datavallist TOK_SLASH
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                      /*if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
-                      else */
-                      /*sprintf(ligne,"%s",$5);   */
-                      createstringfromlistname(ligne,$5);                      
-                      if (firstpass == 1)                      
-                      Add_Data_Var_1(&List_Data_Var,$3,ligne);
-                      else
-                      Add_Data_Var_1(&List_Data_Var_Cur,$3,ligne);                      
-                      }
-                   }
-      | datanamelist TOK_SLASH datavallist TOK_SLASH
-                   {
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       if (firstpass == 1)
-                       Add_Data_Var_Names_01(&List_Data_Var,$1,$3);
-                       else
-                       Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3);
-                   }
-      ;
-datavallist : expr_data
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         $$ = Insertname(NULL,$1,0);
-                      }
-                   }
-      | expr_data ',' datavallist
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         $$ = Insertname($3,$1,1);
-                      }
-                   }
-      ;
-
-save :  before_save varsave
-      | before_save  comblock varsave
-      | save opt_comma comblock opt_comma varsave
-      | save ',' varsave
-      ;
-before_save : TOK_SAVE
-                  {
-                     pos_cursave = setposcur()-4;
-                  }
-      ;
-varsave :
-      | TOK_NAME dims
-                  {
-                     if ( couldaddvariable == 1 ) Add_Save_Var_1($1,$2);
-                  }
-      ;
-datanamelist : TOK_NAME
-		{
-		$$=Insertname(NULL,$1,0);
-		}
-      | TOK_NAME '(' expr ')'
-      {
-      printf("INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n");
-      exit(0);
-      }
-      | datanamelist ',' datanamelist
-      {
-      $$ = concat_listname($1,$3);
-      }
-      ;
-expr_data : opt_signe simple_const
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      | expr_data '+' expr_data
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s+%s",$1,$3);}
-      | expr_data '-' expr_data
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s-%s",$1,$3);}
-      | expr_data '*' expr_data
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s*%s",$1,$3);}
-      | expr_data '/' expr_data
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s/%s",$1,$3);}
-      ;
-opt_signe :
-                   {if ( couldaddvariable == 1 ) strcpy($$,"");}
-      | signe
-                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-namelist :  namelist_action after_namelist
-      ;
-namelist_action : TOK_NAMELIST  ident
-      | TOK_NAMELIST  comblock ident
-      | namelist_action opt_comma comblock opt_comma ident
-      | namelist_action ',' ident
-      ;
-after_namelist :
-      ;
-interface : TOK_INTERFACE opt_name
-	{
-	ininterfacedeclare = 1 ;
-	printf("INTEFACE entree\n");
-	}
-      | TOK_ENDINTERFACE opt_name
-      {
-      ininterfacedeclare = 0;
-      }
-      ;
-before_dimension : TOK_DIMENSION
-                   {
-                      positioninblock=0;
-                      pos_curdimension = setposcur()-9;
-                   }
-
-dimension :  before_dimension opt_comma TOK_NAME dims lengspec
-      {
-         if ( couldaddvariable == 1 )
-         {
-            /*                                                                */
-            curvar=createvar($3,$4);
-            /*                                                                */
-            CreateAndFillin_Curvar("",curvar);
-            /*                                                                */
-            curlistvar=insertvar(NULL,curvar);
-            /*                                                                */
-            $$=settype("",curlistvar);
-            /*                                                                */
-            strcpy(vallengspec,"");
-         }
-      }
-      | dimension ',' TOK_NAME dims lengspec
-      {
-         if ( couldaddvariable == 1 )
-         {
-            /*                                                                */
-            curvar=createvar($3,$4);
-            /*                                                                */
-            CreateAndFillin_Curvar("",curvar);
-            /*                                                                */
-            curlistvar=insertvar($1,curvar);
-            /*                                                                */
-            $$=curlistvar;
-            /*                                                                */
-            strcpy(vallengspec,"");
-         }
-      }
-      ;
-private : TOK_PRIVATE '\n'
-      | TOK_PRIVATE opt_sep use_name_list
-      ;
-public : TOK_PUBLIC '\n'
-        {
-        $$=(listname *)NULL;
-        }
-      | TOK_PUBLIC opt_sep use_name_list
-         {
-          $$=$3;
-         }
-      ;
-use_name_list : TOK_NAME
-           {
-           $$ = Insertname(NULL,$1,0);
-           }
-      | use_name_list ',' TOK_NAME
-          {
-          $$ = Insertname($1,$3,0);
-          }
-      ;
-common : before_common var_common_list
-                   {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcommon,
-                                                  pos_end-pos_curcommon);
-                   }
-      | before_common comblock var_common_list
-                   {
-                         if ( couldaddvariable == 1 )
-                         {
-                            sprintf(charusemodule,"%s",$2);
-                            Add_NameOfCommon_1($2,subroutinename);
-                            pos_end = setposcur();
-                            RemoveWordSET_0(fortranout,pos_curcommon,
-                                                       pos_end-pos_curcommon);
-                         }
-                   }
-      | common opt_comma comblock opt_comma var_common_list
-                   {
-                         if ( couldaddvariable == 1 )
-                         {
-                            sprintf(charusemodule,"%s",$3);
-                            Add_NameOfCommon_1($3,subroutinename);
-                            pos_end = setposcur();
-                            RemoveWordSET_0(fortranout,pos_curcommon,
-                                                       pos_end-pos_curcommon);
-                         }
-                   }
-      ;
-before_common : TOK_COMMON
-                   {
-                      positioninblock=0;
-                      pos_curcommon = setposcur()-6;
-                   }
-      | TOK_GLOBAL TOK_COMMON
-                   {
-                      positioninblock=0;
-                      pos_curcommon = setposcur()-6-7;
-                   }
-      ;
-var_common_list : var_common
-                   {
-                      if ( couldaddvariable == 1 ) Add_Common_var_1();
-                   }
-
-     | var_common_list ',' var_common
-                   {
-                      if ( couldaddvariable == 1 ) Add_Common_var_1();
-                   }
-var_common : TOK_NAME dims
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         positioninblock = positioninblock + 1 ;
-                         strcpy(commonvar,$1);
-                         commondim = $2;
-                      }
-                   }
-      ;
-comblock : TOK_DSLASH
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy($$,"");
-                         positioninblock=0;
-                         strcpy(commonblockname,"");
-                      }
-                   }
-      | TOK_SLASH TOK_NAME TOK_SLASH
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy($$,$2);
-                         positioninblock=0;
-                         strcpy(commonblockname,$2);
-                      }
-                   }
-      ;
-opt_comma :
-      | ','
-      ;
-paramlist : paramitem
-                   {
-                      if ( couldaddvariable == 1 ) $$=insertvar(NULL,$1);
-                   }
-      | paramlist ',' paramitem
-                   {
-                      if ( couldaddvariable == 1 ) $$=insertvar($1,$3);
-                   }
-      ;
-paramitem : TOK_NAME '=' expr
-                   {
-                     if ( couldaddvariable == 1 )
-                     {
-                         curvar=(variable *) malloc(sizeof(variable));
-                         /*                                                   */
-                         Init_Variable(curvar);
-                         /*                                                   */
-                         curvar->v_VariableIsParameter=1;
-                         strcpy(curvar->v_nomvar,$1);
-                         Save_Length($1,4);
-                         strcpy(curvar->v_subroutinename,subroutinename);
-                         Save_Length(subroutinename,11);
-                         strcpy(curvar->v_modulename,curmodulename);
-                         Save_Length(curmodulename,6);
-                         strcpy(curvar->v_initialvalue,$3);
-                         Save_Length($3,14);
-                         strcpy(curvar->v_commoninfile,mainfile);
-                         Save_Length(mainfile,10);
-                         $$=curvar;
-                      }
-                   }
-      ;
-module_proc_stmt : TOK_PROCEDURE proc_name_list
-      ;
-proc_name_list : TOK_NAME
-      | proc_name_list ',' TOK_NAME
-      ;
-implicit : TOK_IMPLICIT TOK_NONE
-                    {
-                       if ( insubroutinedeclare == 1 )
-                       {
-                          Add_ImplicitNoneSubroutine_1();
-                          pos_end = setposcur();
-                          RemoveWordSET_0(fortranout,pos_end-13,
-                                                             13);
-                       }
-                    }
-      | TOK_IMPLICIT TOK_REAL8
-      ;
-opt_retour :
-      ;
-dcl : options opt_retour TOK_NAME dims lengspec initial_value
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         /*                                                   */
-                         if (dimsgiven == 1)
-                         {
-                            curvar=createvar($3,curdim);
-                            GlobalDeclarationType == 0;
-                         }
-                         else
-                         {
-                            curvar=createvar($3,$4);
-                         }
-                         /*                                                   */
-                         CreateAndFillin_Curvar(DeclType,curvar);
-                         /*                                                   */
-                         curlistvar=insertvar(NULL,curvar);
-                         if (!strcasecmp(DeclType,"character"))
-                         {
-                            if (c_selectorgiven == 1)
-                            {
-                               strcpy(c_selectordim.first,"1");
-                               strcpy(c_selectordim.last,c_selectorname);
-                               Save_Length(c_selectorname,1);
-                               change_dim_char
-                                     (insertdim(NULL,c_selectordim),curlistvar);
-                            }
-                         }
-                         $$=settype(DeclType,curlistvar);
-                      }
-                      strcpy(vallengspec,"");
-                   }
-      | dcl ',' opt_retour TOK_NAME dims lengspec initial_value
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         if (dimsgiven == 1)
-                         {
-                            curvar=createvar($4,curdim);
-                         }
-                         else
-                         {
-                            curvar=createvar($4,$5);
-                         }
-                         /*                                                   */
-                         CreateAndFillin_Curvar($1->var->v_typevar,curvar);
-                         /*                                                   */
-                         strcpy(curvar->v_typevar,($1->var->v_typevar));
-                         Save_Length($1->var->v_typevar,3);
-                         /*                                                   */
-                         curlistvar=insertvar($1,curvar);
-                         if (!strcasecmp(DeclType,"character"))
-                         {
-                            if (c_selectorgiven == 1)
-                            {
-                               strcpy(c_selectordim.first,"1");
-                               strcpy(c_selectordim.last,c_selectorname);
-                               Save_Length(c_selectorname,1);
-                               change_dim_char
-                                     (insertdim(NULL,c_selectordim),curlistvar);
-                            }
-                         }
-                         $$=curlistvar;
-                      }
-                      strcpy(vallengspec,"");
-                   }
-      ;
-nodimsgiven :       {dimsgiven=0;}
-      ;
-type : typespec selector
-                   {strcpy(DeclType,$1);}
-      | before_character c_selector
-                   {
-                      strcpy(DeclType,"CHARACTER");
-                   }
-      | typename '*' TOK_CSTINT
-                   {
-                      strcpy(DeclType,$1);
-                      strcpy(nameinttypename,$3);
-                   }
-      | before_typepar attribute ')'
-                   {
-                      strcpy(DeclType,"TYPE");
-                      GlobalDeclarationType = 1
-                   }
-      ;
-before_typepar : TOK_TYPEPAR
-                   {
-                 /*     if ( couldaddvariable == 1 ) VarTypepar = 1 ;
-                      couldaddvariable = 0 ;
-                      pos_cur_decl = setposcur()-5;*/
-                   pos_cur_decl = setposcur()-5;
-                   }
-      ;
-c_selector :
-      | '*' TOK_CSTINT
-                   {c_selectorgiven=1;strcpy(c_selectorname,$2);}
-      | '*' '(' c_attribute ')' {c_star = 1;}
-      | '(' c_attribute ')'
-      ;
-c_attribute : TOK_NAME clause opt_clause
-      | TOK_NAME '=' clause opt_clause
-      | clause opt_clause
-      ;
-before_character : TOK_CHARACTER
-                   {
-                      pos_cur_decl = setposcur()-9;
-                   }
-      ;
-typespec : typename {strcpy($$,$1);}
-      ;
-typename : TOK_INTEGER
-                   {
-                      strcpy($$,"INTEGER");
-                      pos_cur_decl = setposcur()-7;
-                   }
-      | TOK_REAL   {
-                      strcpy($$,"REAL");
-                      pos_cur_decl = setposcur()-4;
-                   }
-      | TOK_COMPLEX
-                   {strcpy($$,"COMPLEX");
-                   pos_cur_decl = setposcur()-7;}
-      | TOK_DOUBLEPRECISION
-                   {
-                      pos_cur_decl = setposcur()-16;
-                      strcpy($$,"REAL");
-                      strcpy(nameinttypename,"8");
-                   }
-      | TOK_DOUBLECOMPLEX
-                   {strcpy($$,"DOUBLE COMPLEX");}
-      | TOK_LOGICAL
-                   {
-                      strcpy($$,"LOGICAL");
-                      pos_cur_decl = setposcur()-7;
-                   }
-      ;
-lengspec :
-      | '*' proper_lengspec {strcpy(vallengspec,$2);}
-      ;
-proper_lengspec : expr {sprintf($$,"*%s",$1);}
-      | '(' '*' ')'{strcpy($$,"*(*)");}
-      ;
-selector :
-      | '*' proper_selector
-      | '(' attribute ')'
-      ;
-proper_selector : expr
-      | '(' '*' ')'
-      ;
-attribute : TOK_NAME clause
-      | TOK_NAME '=' clause
-                   {
-                      if ( strstr($3,"0.d0") )
-                      {
-                         strcpy(nameinttypename,"8");
-                         sprintf(NamePrecision,"");
-                      }
-                      else sprintf(NamePrecision,"%s = %s",$1,$3);
-                   }
-      | TOK_NAME
-                   {
-                      strcpy(NamePrecision,$1);
-                   }
-      | TOK_CSTINT
-                   {
-                      strcpy(NamePrecision,$1);
-                   }
-      ;
-clause : expr       {strcpy(CharacterSize,$1);
-                    strcpy($$,$1);}
-      | '*'        {strcpy(CharacterSize,"*");
-                    strcpy($$,"*");}
-      ;
-opt_clause :
-      | ',' TOK_NAME clause
-      ;
-options :
-      | ':' ':'
-      | ',' attr_spec_list ':' ':'
-      ;
-attr_spec_list : attr_spec
-      | attr_spec_list ',' attr_spec
-      ;
-attr_spec : TOK_PARAMETER
-                   {
-                      VariableIsParameter = 1;
-                   }
-      | access_spec
-      | TOK_ALLOCATABLE
-                   {Allocatabledeclare = 1;}
-      | TOK_DIMENSION dims
-                   {
-                      dimsgiven=1;
-                      curdim=$2;
-                   }
-      | TOK_EXTERNAL
-                   {ExternalDeclare = 1;}
-      | TOK_INTENT '(' intent_spec ')'
-                   {strcpy(IntentSpec,$3);}
-      | TOK_INTRINSIC
-      | TOK_OPTIONAL{optionaldeclare = 1 ;}
-      | TOK_POINTER {pointerdeclare = 1 ;}
-      | TOK_SAVE    {
-/*                       if ( inmodulemeet == 1 )
-                       {*/
-                          SaveDeclare = 1 ;
-                     /*  }*/
-                    }
-      | TOK_TARGET
-      				{Targetdeclare = 1;}
-      ;
-intent_spec : TOK_IN {strcpy($$,$1);}
-      | TOK_OUT     {strcpy($$,$1);}
-      | TOK_INOUT   {strcpy($$,$1); }
-      ;
-access_spec : TOK_PUBLIC
-                   {PublicDeclare = 1;}
-      | TOK_PRIVATE
-                   {PrivateDeclare = 1;}
-      ;
-dims :              {if ( created_dimensionlist == 1 )
-                       {
-                           $$=(listdim *)NULL;
-                       }
-                   }
-      | '(' dimlist ')'
-                   {if ( created_dimensionlist == 1 ||
-                         agrif_parentcall      == 1 ) $$=$2;}
-      ;
-dimlist :   dim     {if ( created_dimensionlist == 1 ||
-                         agrif_parentcall      == 1 ) $$=insertdim(NULL,$1);}
-      | dimlist ',' dim
-                   {if ( couldaddvariable == 1 )
-                         if ( created_dimensionlist == 1 ) $$=insertdim($1,$3);}
-      ;
-dim : ubound         {
-                      strcpy($$.first,"1");
-                      strcpy($$.last,$1);
-                      Save_Length($1,1);
-                   }
-      | ':'        {
-                      strcpy($$.first,"");
-                      strcpy($$.last,"");
-                   }
-      | expr ':'   {
-                      strcpy($$.first,$1);
-                      Save_Length($1,2);
-                      strcpy($$.last,"");
-                   }
-      | ':' expr   {
-                      strcpy($$.first,"");
-                      strcpy($$.last,$2);
-                      Save_Length($2,1);
-                   }
-      | expr ':' ubound
-                   {
-                      strcpy($$.first,$1);
-                      Save_Length($1,2);
-                      strcpy($$.last,$3);
-                      Save_Length($3,1);
-                   }
-      ;
-ubound :  '*'       {strcpy($$,"*");}
-      | expr       {strcpy($$,$1);}
-      ;
-expr :  uexpr       {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | '(' expr ')'
-                   {if ( couldaddvariable == 1 ) sprintf($$,"(%s)",$2);}
-      | complex_const
-                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | predefinedfunction
-                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-
-predefinedfunction : TOK_SUM minmaxlist ')'
-                   {sprintf($$,"SUM(%s)",$2);}
-      | TOK_MAX minmaxlist ')'
-                   {sprintf($$,"MAX(%s)",$2);}
-      | TOK_TANH '(' minmaxlist ')'
-                   {sprintf($$,"TANH(%s)",$3);}
-      | TOK_MAXVAL '(' minmaxlist ')'
-                   {sprintf($$,"MAXVAL(%s)",$3);}
-      | TOK_MIN minmaxlist ')'
-                   {sprintf($$,"MIN(%s)",$2);}
-      | TOK_MINVAL '(' minmaxlist ')'
-                   {sprintf($$,"MINVAL(%s)",$3);}
-      | TOK_TRIM '(' expr ')'
-                   {sprintf($$,"TRIM(%s)",$3);}
-      | TOK_SQRT expr ')'
-                   {sprintf($$,"SQRT(%s)",$2);}
-      | TOK_REAL '(' minmaxlist ')'
-                   {sprintf($$,"REAL(%s)",$3);}
-      | TOK_NINT '(' expr ')'
-                   {sprintf($$,"NINT(%s)",$3);}
-      | TOK_FLOAT '(' expr ')'
-                   {sprintf($$,"FLOAT(%s)",$3);}
-      | TOK_EXP '(' expr ')'
-                   {sprintf($$,"EXP(%s)",$3);}
-      | TOK_COS '(' expr ')'
-                   {sprintf($$,"COS(%s)",$3);}
-      | TOK_COSH '(' expr ')'
-                   {sprintf($$,"COSH(%s)",$3);}
-      | TOK_ACOS '(' expr ')'
-                   {sprintf($$,"ACOS(%s)",$3);}
-      | TOK_SIN '(' expr ')'
-                   {sprintf($$,"SIN(%s)",$3);}
-      | TOK_SINH '(' expr ')'
-                   {sprintf($$,"SINH(%s)",$3);}
-      | TOK_ASIN '(' expr ')'
-                   {sprintf($$,"ASIN(%s)",$3);}
-      | TOK_LOG '(' expr ')'
-                   {sprintf($$,"LOG(%s)",$3);}
-      | TOK_TAN '(' expr ')'
-                   {sprintf($$,"TAN(%s)",$3);}
-      | TOK_ATAN '(' expr ')'
-                   {sprintf($$,"ATAN(%s)",$3);}
-      | TOK_ABS expr ')'
-                   {sprintf($$,"ABS(%s)",$2);}
-      | TOK_MOD '(' minmaxlist ')'
-                   {sprintf($$,"MOD(%s)",$3);}
-      | TOK_SIGN '(' minmaxlist ')'
-                   {sprintf($$,"SIGN(%s)",$3);}
-      | TOK_MINLOC '(' minmaxlist ')'
-                   {sprintf($$,"MINLOC(%s)",$3);}
-      | TOK_MAXLOC '(' minmaxlist ')'
-                   {sprintf($$,"MAXLOC(%s)",$3);}
-      ;
-minmaxlist : expr {strcpy($$,$1);}
-      | minmaxlist ',' expr
-                   {if ( couldaddvariable == 1 )
-                   { strcpy($$,$1);strcat($$,",");strcat($$,$3);}}
-      ;
-uexpr :  lhs        {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | simple_const
-                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | vec
-                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | expr operation
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      | signe expr %prec '*' 
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      | TOK_NOT expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      ;
-signe : '+'        {if ( couldaddvariable == 1 ) strcpy($$,"+");}
-      | '-'        {if ( couldaddvariable == 1 ) strcpy($$,"-");}
-      ;
-operation : '+' expr %prec '+'
-                   {if ( couldaddvariable == 1 ) sprintf($$,"+%s",$2);}
-      |  '-' expr %prec '+'
-                   {if ( couldaddvariable == 1 ) sprintf($$,"-%s",$2);}
-      |  '*' expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"*%s",$2);}
-      |  TOK_DASTER expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  TOK_EQ expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  TOK_EQV expr %prec TOK_EQV
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}                   
-      |  TOK_GT expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  '>' expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$," > %s",$2);}
-      |  TOK_LT expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  '<' expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$," < %s",$2);}
-      |  TOK_GE expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  '>''=' expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$," >= %s",$3);}
-      |  TOK_LE expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  '<''=' expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$," <= %s",$3);}
-      |  TOK_NE expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  TOK_NEQV expr %prec TOK_EQV
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}                   
-      |  TOK_XOR expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  TOK_OR expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  TOK_AND expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  TOK_SLASH after_slash
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s",$2);}
-      |  '=' after_equal
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s",$2);}
-
-after_slash : {strcpy($$,"");}
-      | expr
-                   {sprintf($$,"/%s",$1);}
-      | '=' expr %prec TOK_EQ
-                   {sprintf($$,"/= %s",$2);}
-      | TOK_SLASH expr
-                   {sprintf($$,"//%s",$2);}
-      ;
-after_equal : '=' expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"==%s",$2);}
-      | expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"= %s",$1);}
-      ;
-
-lhs : ident         {if ( couldaddvariable == 1 )
-						{
-						printf("ident = %s\n",$1);
-						strcpy($$,$1);}
-						}
-      | structure_component
-                   {if ( couldaddvariable == 1 ) {
-                   printf("struct = %s\n",$1);
-                   strcpy($$,$1);}
-                   }
-      | array_ele_substring_func_ref
-                   {if ( couldaddvariable == 1 ) {
-                   printf("arrayref = %s\n",$1);
-                   strcpy($$,$1);
-                   }}
-      ;
-beforefunctionuse : {
-                      agrif_parentcall =0;
-                      if (!strcasecmp(identcopy,"Agrif_Parent") )
-                                                            agrif_parentcall =1;
-                      if ( Agrif_in_Tok_NAME(identcopy) == 1 )
-                      {
-                         inagrifcallargument = 1;
-                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                      }
-                   }
-      ;
-array_ele_substring_func_ref : begin_array
-                   {
-                     strcpy($$,$1);
-                     if ( incalldeclare == 0 ) inagrifcallargument = 0;
-                   }
-      | begin_array substring
-                   {if ( couldaddvariable == 1 ) sprintf($$," %s %s ",$1,$2);}
-      | structure_component '(' funarglist ')'
-                   {if ( couldaddvariable == 1 )
-                                                sprintf($$," %s ( %s )",$1,$3);}
-      | structure_component '(' funarglist ')' substring
-                   {if ( couldaddvariable == 1 )
-                                         sprintf($$," %s ( %s ) %s ",$1,$3,$5);}
-      ;
-begin_array : ident '(' funarglist ')'
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         sprintf($$," %s ( %s )",$1,$3);
-                         ModifyTheAgrifFunction_0($3);
-                         agrif_parentcall =0;
-                      }
-                   }
-      ;
-structure_component : lhs '%' lhs
-                   {
-                      sprintf($$," %s %% %s ",$1,$3);
-                      if ( incalldeclare == 0 ) inagrifcallargument = 0;
-                   }
-      ;
-vec :  TOK_LEFTAB outlist TOK_RIGHTAB
-                   {sprintf($$,"(/%s/)",$2);}
-      ;
-funarglist : beforefunctionuse    {strcpy($$," ");}
-      | beforefunctionuse funargs
-                   {strcpy($$,$2);}
-      ;
-funargs : funarg     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | funargs ',' funarg
-                    {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      ;
-funarg : expr       {strcpy($$,$1);}
-      | triplet    {strcpy($$,$1);}
-      ;
-triplet : expr ':' expr
-                    {if ( couldaddvariable == 1 ) sprintf($$,"%s :%s",$1,$3);}
-      | expr ':' expr ':' expr
-                    {if ( couldaddvariable == 1 )
-                                               sprintf($$,"%s :%s :%s",$1,$3,$5);}
-      | ':' expr ':' expr
-                    {if ( couldaddvariable == 1 ) sprintf($$,":%s :%s",$2,$4);}
-      | ':' ':' expr{if ( couldaddvariable == 1 ) sprintf($$,": : %s",$3);}
-      | ':' expr    {if ( couldaddvariable == 1 ) sprintf($$,":%s",$2);}
-      | expr ':'    {if ( couldaddvariable == 1 ) sprintf($$,"%s :",$1);}
-      | ':'         {if ( couldaddvariable == 1 ) sprintf($$,":");}
-      ;
-ident : TOK_NAME    {
-                       if ( couldaddvariable == 1 && afterpercent == 0)
-                       {
-                       if ( Vartonumber($1) == 1 )
-                       {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                       if (!strcasecmp($1,"Agrif_Parent") )
-                                                            agrif_parentcall =1;
-                       if ( VariableIsNotFunction($1) == 0 )
-                       {
-                       printf("var = %s\n",$1);
-                          if ( inagrifcallargument == 1 )
-                          {
-                             if ( !strcasecmp($1,identcopy) )
-                             {
-                                strcpy(sameagrifname,identcopy);
-                                sameagrifargument = 1;
-                             }
-                          }
-                          strcpy(identcopy,$1);
-                          pointedvar=0;
-                          strcpy(truename,$1);
-                          if (variscoupled_0($1)) strcpy(truename,getcoupledname_0($1));
-
-                          if ( VarIsNonGridDepend(truename) == 0 &&
-                               Variableshouldberemove(truename) == 0 )
-                          {                      
-                             if ( inagrifcallargument == 1 ||
-                                  varispointer_0(truename) == 1 )
-                             {
-                             printf("var2 = %s\n",$1);
-                            if ((IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1))
-                             {
-                              if (varistyped_0(truename) == 0)
-                                 {
-                                 ModifyTheVariableName_0(truename,strlen($1));
-                                 }
-                                 }
-                             }
-                             printf("ici3\n");
-                             if ( inagrifcallargument != 1 ||
-                                  sameagrifargument ==1 )
-                                  {
-                                  printf("ici5 %s\n",truename);
-                                  Add_UsedInSubroutine_Var_1(truename);
-                          }
-                          }
-                          NotifyAgrifFunction_0(truename);
-                       }
-                       }
-                       else
-                       {
-                       afterpercent = 0;
-                    }
-                    }
-      ;
-simple_const : TOK_TRUE
-                     {if ( couldaddvariable == 1 ) strcpy($$,".TRUE.");}
-      | TOK_FALSE    {if ( couldaddvariable == 1 ) strcpy($$,".FALSE.");}
-      | TOK_CSTINT   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | TOK_CSTREAL  {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | TOK_CSTREALDP{if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | TOK_CSTREALQP{if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | simple_const TOK_NAME
-                     {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      | string_constant opt_substring
-      ;
-string_constant : TOK_CHAR_CONSTANT
-                     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | string_constant TOK_CHAR_CONSTANT
-      | TOK_CHAR_MESSAGE
-                     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | TOK_CHAR_CUT
-                     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-opt_substring :      {if ( couldaddvariable == 1 ) strcpy($$," ");}
-      | substring   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-substring : '(' optexpr ':' optexpr ')'
-                    {if ( couldaddvariable == 1 ) sprintf($$,"(%s :%s)",$2,$4);}
-      ;
-optexpr :           {if ( couldaddvariable == 1 ) strcpy($$," ");}
-      | expr        {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-opt_expr : '\n'          {if ( couldaddvariable == 1 ) strcpy($$," ");}
-      | expr        {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-initial_value :      {   strcpy(InitialValueGiven," ");}
-      | before_initial '=' expr
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                          strcpy(InitValue,$3);
-                          strcpy(InitialValueGiven,"=");
-                       }
-                    }
-      | before_initial TOK_POINT_TO expr
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                          strcpy(InitValue,$3);
-                          strcpy(InitialValueGiven,"=>");
-                       }
-                    }
-      ;
-before_initial : {pos_curinit = setposcur();}
-      ;
-complex_const : '(' uexpr ',' uexpr ')'
-                    {sprintf($$,"(%s,%s)",$2,$4);}
-      ;
-use_stat : word_use  module_name
-                    {
-                      if ( couldaddvariable == 1 )
-                      {
-                      /* if variables has been declared in a subroutine       */
-                      if (insubroutinedeclare == 1)
-                      {
-                         copyuse_0($2);
-                      }
-                      sprintf(charusemodule,"%s",$2);
-                      Add_NameOfModuleUsed_1($2);
-
-                      if ( inmoduledeclare == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curuse,
-                                               pos_end-pos_curuse);
-                      }
-                      }
-                    }
-      | word_use  module_name ',' rename_list
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                      if (insubroutinedeclare == 1)
-                      {
-                         Add_CouplePointed_Var_1($2,$4);
-                      }
-                      if ( firstpass == 1 )
-                      {
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            coupletmp = $4;
-                            strcpy(ligne,"");
-                            while ( coupletmp )
-                            {
-                               strcat(ligne,coupletmp->c_namevar);
-                               strcat(ligne," => ");
-                               strcat(ligne,coupletmp->c_namepointedvar);
-                               coupletmp = coupletmp->suiv;
-                               if ( coupletmp ) strcat(ligne,",");
-                            }
-                            sprintf(charusemodule,"%s",$2);
-                         }
-                         Add_NameOfModuleUsed_1($2);
-                      }
-                      if ( inmoduledeclare == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curuse,
-                                               pos_end-pos_curuse);
-                      }
-                      }
-                    }
-      | word_use  module_name ',' TOK_ONLY ':' '\n'
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                      /* if variables has been declared in a subroutine       */
-                      if (insubroutinedeclare == 1)
-                      {
-                         copyuseonly_0($2);
-                      }
-                      sprintf(charusemodule,"%s",$2);
-                      Add_NameOfModuleUsed_1($2);
-
-                       if ( inmoduledeclare == 0 )
-                       {
-                          pos_end = setposcur();
-                          RemoveWordSET_0(fortranout,pos_curuse,
-                                                pos_end-pos_curuse);
-                       }
-                       }
-                    }
-      | word_use  module_name ',' TOK_ONLY ':' only_list
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       /* if variables has been declared in a subroutine      */
-                       if (insubroutinedeclare == 1)
-                       {
-                          Add_CouplePointed_Var_1($2,$6);
-                       }
-                       if ( firstpass == 1 )
-                       {
-                         if ( insubroutinedeclare == 1 )
-                         {
-                             coupletmp = $6;
-                             strcpy(ligne,"");
-                             while ( coupletmp )
-                             {
-                                strcat(ligne,coupletmp->c_namevar);
-                               if ( strcasecmp(coupletmp->c_namepointedvar,"") )
-                                                           strcat(ligne," => ");
-                                strcat(ligne,coupletmp->c_namepointedvar);
-                                coupletmp = coupletmp->suiv;
-                                if ( coupletmp ) strcat(ligne,",");
-                             }
-                             sprintf(charusemodule,"%s",$2);
-                          }
-                          Add_NameOfModuleUsed_1($2);
-                       }
-                       if ( firstpass == 0 )
-                       {
-                          if ( inmoduledeclare == 0 )
-                          {
-
-                            pos_end = setposcur();
-                             RemoveWordSET_0(fortranout,pos_curuse,
-                                                   pos_end-pos_curuse);
-                       if (oldfortranout) 
-                         variableisglobalinmodule($6,$2,oldfortranout,pos_curuseold);
-                        
-                          }
-                          else
-                          {
-
-                             /* if we are in the module declare and if the    */
-                             /* onlylist is a list of global variable         */
-                             variableisglobalinmodule($6, $2, fortranout,pos_curuse);
-                          }
-                       }
-                       }
-                    }
-      ;
-word_use : TOK_USE
-                   {
-                      pos_curuse = setposcur()-strlen($1);
-                     if (firstpass == 0 && oldfortranout) {
-                     pos_curuseold = setposcurname(oldfortranout);
-                     }
-                   }
-      ;
-module_name : TOK_NAME
-                    {strcpy($$,$1);}
-      ;
-rename_list : rename_name
-                    {
-                       if ( couldaddvariable == 1 ) $$ = $1;
-                    }
-      | rename_list ',' rename_name
-                    {
-                        if ( couldaddvariable == 1 )
-                        {
-                        /* insert the variable in the list $1                 */
-                        $3->suiv = $1;
-                        $$ = $3;
-                        }
-                    }
-      ;
-rename_name : TOK_NAME TOK_POINT_TO TOK_NAME
-                    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,$1);
-                       Save_Length($1,21);
-                       strcpy(coupletmp->c_namepointedvar,$3);
-                       Save_Length($3,22);
-                       coupletmp->suiv = NULL;
-                       $$ = coupletmp;
-                     }
-      ;
-only_list : only_name
-                    {
-                       if ( couldaddvariable == 1 ) $$ = $1;
-                    }
-      | only_list ',' only_name
-                    {
-                        if ( couldaddvariable == 1 )
-                        {
-                        /* insert the variable in the list $1                 */
-                        $3->suiv = $1;
-                        $$ = $3;
-                        }
-                    }
-      ;
-only_name : TOK_NAME TOK_POINT_TO TOK_NAME
-                    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,$1);
-                       Save_Length($1,21);
-                       strcpy(coupletmp->c_namepointedvar,$3);
-                       Save_Length($3,22);
-                       coupletmp->suiv = NULL;
-                       $$ = coupletmp;
-                       pointedvar=1;
-                       Add_UsedInSubroutine_Var_1($1);
-                    }
-      | TOK_NAME    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,$1);
-                       Save_Length($1,21);
-                       strcpy(coupletmp->c_namepointedvar,"");
-                       coupletmp->suiv = NULL;
-                       $$ = coupletmp;
-                     }
-      ;
-exec : iffable
-      | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'
-                     {
-                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     }
-      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'
-                     {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                         curmodulename);
-                                                         inallocate = 0;
-                     }
-      | TOK_NULLIFY '(' pointer_name_list ')'
-      | word_endunit /* end                                                   */
-                    {
-                       GlobalDeclaration = 0 ;
-                       if ( firstpass == 0 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                          if ( module_declar && insubroutinedeclare == 0 )
-                          {
-                              fclose(module_declar);
-                          }
-                       }
-                       if ( couldaddvariable == 1 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                       if ( inmodulemeet == 1 )
-                       {
-                         /* we are in a module                                */
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            /* it is like an end subroutine <name>            */
-                            insubroutinedeclare = 0 ;
-                            /*                                                */
-                            pos_cur = setposcur();
-                            closeandcallsubloopandincludeit_0(1);
-                            functiondeclarationisdone = 0;
-                         }
-                         else
-                         {
-                            /* it is like an end module <name>                */
-                            inmoduledeclare = 0 ;
-                            inmodulemeet = 0 ;
-                         }
-                       }
-                       else
-                       {
-                          insubroutinedeclare = 0;
-                          /*                                                  */
-                          pos_cur = setposcur();                        
-                          closeandcallsubloopandincludeit_0(2);
-                            functiondeclarationisdone = 0;
-                          if ( firstpass == 0 )
-                          {
-                             if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                             else fprintf(paramout,"C\n");
-                             fclose(paramout);
-                           }
-                        }
-                      }
-                      strcpy(subroutinename,"");
-                    }
-      | word_endprogram opt_name
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();                      
-                       closeandcallsubloopandincludeit_0(3);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    }
-      | word_endsubroutine opt_name
-                    {
-                       if ( couldaddvariable == 1 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();
-                                             
-                       closeandcallsubloopandincludeit_0(1);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    }
-      | word_endfunction opt_name
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();
-
-                       closeandcallsubloopandincludeit_0(0);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    }
-      | TOK_ENDMODULE opt_name
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       /* if we never meet the contains keyword               */
-                      Remove_Word_end_module_0(strlen($2));
-                       if ( inmoduledeclare == 1 )
-                       {
-                          if ( aftercontainsdeclare == 0 )
-                          {
-                             Write_GlobalParameter_Declaration_0();
-                             Write_NotGridDepend_Declaration_0();
-                             Write_GlobalType_Declaration_0();
-                             if ( module_declar_type )
-                             {
-                             strcpy (ligne, "\n#include \"Module_DeclarType_");
-                             strcat (ligne, curmodulename);
-                             strcat (ligne, ".h\"\n");
-                             tofich(fortranout,ligne,1); 
-                             }
-                             Write_Alloc_Subroutine_For_End_0();
-                          }
-                       }
-                                           
-                       inmoduledeclare = 0 ;
-                       inmodulemeet = 0 ;
-
-                      Write_Word_end_module_0();
-                      strcpy(curmodulename,"");
-                      aftercontainsdeclare = 1;
-                      if ( firstpass == 0 )
-                      {
-                         if ( module_declar && insubroutinedeclare == 0)
-                         {
-                           fclose(module_declar);
-                         }
-                         if ( module_declar_type && insubroutinedeclare == 0)
-                         {
-                          fclose(module_declar_type);
-                          module_declar_type = 0;
-                         }
-                      }
-                      GlobalDeclaration = 0 ;
-                      }
-                  }
-      | boucledo
-      | logif iffable
-      | TOK_WHERE '(' expr ')' opt_expr
-      | TOK_ELSEWHERE
-      | TOK_ENDWHERE
-      | logif TOK_THEN
-      | TOK_ELSEIF  '(' expr ')' TOK_THEN
-      | TOK_ELSE
-      | TOK_ENDIF opt_name
-      | TOK_CASE caselist ')'
-      | TOK_SELECTCASE '(' expr ')'
-      | TOK_CASEDEFAULT
-      | TOK_ENDSELECT
-      | TOK_CONTAINS
-                   {
-                      if (inmoduledeclare == 1 )
-                      {
-                         Remove_Word_Contains_0();
-                         Write_GlobalParameter_Declaration_0();
-                         Write_GlobalType_Declaration_0();
-                             if ( module_declar_type)
-                             {                         
-                             strcpy (ligne, "\n#include \"Module_DeclarType_");
-                             strcat (ligne, curmodulename);
-                             strcat (ligne, ".h\"\n");
-                             tofich(fortranout,ligne,1); 
-                             }
-                         Write_NotGridDepend_Declaration_0();
-                         Write_Alloc_Subroutine_0();
-                         inmoduledeclare = 0 ;
-                         aftercontainsdeclare = 1;
-                      }
-                      else
-                      {
-                      incontainssubroutine = 1;
-                      strcpy(previoussubroutinename,subroutinename);
-                       if ( couldaddvariable == 1 )
-                       {
-                          if ( firstpass == 1 ) List_ContainsSubroutine =
-                                                Addtolistnom(subroutinename,
-                                                     List_ContainsSubroutine,0);
-                          insubroutinedeclare = 0;
-                          /*                                                  */
-
-                          closeandcallsubloop_contains_0();
-                            functiondeclarationisdone = 0;
-                         if ( firstpass == 0 )
-                         {
-                            if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                            else fprintf(paramout,"C\n");
-                            fclose(paramout);
-                         }
-                         }
-                         strcpy(subroutinename,"");
-                      }
-                   }
-      ;
-word_endsubroutine : TOK_ENDSUBROUTINE
-                    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy($$,$1);
-                       pos_endsubroutine = setposcur()-strlen($1);
-                       functiondeclarationisdone = 0;
-                       }
-                    }
-      ;
-word_endunit : TOK_ENDUNIT
-                    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy($$,$1);
-                       pos_endsubroutine = setposcur()-strlen($1);
-                       }
-                    }
-      ;
-word_endprogram :  TOK_ENDPROGRAM
-                    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy($$,$1);
-                       pos_endsubroutine = setposcur()-strlen($1);
-                       }
-                    }
-      ;
-word_endfunction : TOK_ENDFUNCTION
-                    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy($$,$1);
-                       pos_endsubroutine = setposcur()-strlen($1);
-                       }
-                    }
-      ;
-caselist : expr
-      | caselist ',' expr
-      | caselist ':' expr
-      ;
-boucledo : worddo opt_int do_arg
-      | wordwhile expr
-      | TOK_ENDDO optname
-      ;
-do_arg :
-      | do_var '=' expr ',' expr
-      | do_var '=' expr ',' expr ',' expr
-opt_int :
-      | TOK_CSTINT opt_comma
-      ;
-opt_name : '\n'  {strcpy($$,"");}
-      | TOK_NAME {strcpy($$,$1);}
-      ;
-optname :
-      | TOK_NAME
-      ;
-worddo :  TOK_PLAINDO
-      ;
-wordwhile :TOK_DOWHILE
-      ;
-
-dotarget :
-      | TOK_CSTINT
-      ;
-
-iffable : TOK_CONTINUE
-      | ident_dims after_ident_dims
-      | goto
-      | io
-      | call
-      | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'
-                     {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     }
-      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'
-                     {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     }
-      | TOK_EXIT optexpr
-      | TOK_RETURN opt_expr
-      | TOK_CYCLE opt_expr
-      | stop opt_expr
-      | int_list
-      ;
-before_dims : {if ( couldaddvariable == 1 ) created_dimensionlist = 0;}
-ident_dims : ident before_dims dims dims
-              {
-                  created_dimensionlist = 1;
-                  if  ( agrif_parentcall == 1 )
-                  {
-                      ModifyTheAgrifFunction_0($3->dim.last);
-                      agrif_parentcall =0;
-                      fprintf(fortranout," = ");
-                  }
-              }
-      | ident_dims '%' ident before_dims dims dims
-      {created_dimensionlist = 1;}
-int_list : TOK_CSTINT
-      | int_list ',' TOK_CSTINT
-      ;
-after_ident_dims : '=' expr
-      | TOK_POINT_TO expr
-      ;
-call : keywordcall opt_call
-                   {
-                      inagrifcallargument = 0 ;
-                      incalldeclare=0;
-                      if ( oldfortranout &&
-                           !strcasecmp(meetagrifinitgrids,subroutinename) &&
-                           firstpass == 0 &&
-                           callmpiinit == 1)
-                      {
-                      /*   pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcall,
-                                               pos_end-pos_curcall);
-                         fprintf(oldfortranout,"      Call MPI_Init (%s) \n"
-                                                                   ,mpiinitvar);*/
-                      }
-                      if ( oldfortranout           &&
-                           callagrifinitgrids == 1 &&
-                           firstpass == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcall,
-                                               pos_end-pos_curcall);
-
-                         strcpy(subofagrifinitgrids,subroutinename);
-                      }
-                      Instanciation_0(sameagrifname);
-                   }
-      ;
-opt_call :
-      | '(' opt_callarglist  ')'
-      ;
-opt_callarglist :
-      | callarglist
-      ;
-keywordcall : before_call TOK_NAME
-                    {
-                       if (!strcasecmp($2,"MPI_Init") )
-                       {
-                          callmpiinit = 1;
-                       }
-                       else
-                       {
-                          callmpiinit = 0;
-                       }
-                       if (!strcasecmp($2,"Agrif_Init_Grids") )
-                       {
-                          callagrifinitgrids = 1;
-                          strcpy(meetagrifinitgrids,subroutinename);
-                       }
-                       else callagrifinitgrids = 0;
-                       if ( !strcasecmp($2,"Agrif_Open_File") )
-                       {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                       if ( Vartonumber($2) == 1 )
-                       {
-                          incalldeclare=1;
-                          inagrifcallargument = 1 ;
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                    }
-      ;
-before_call : TOK_CALL
-                    {pos_curcall=setposcur()-4;}
-callarglist :  callarg
-      | callarglist ',' callarg
-      ;
-
-callarg :  expr {
-                  if ( callmpiinit == 1 )
-                  {
-                     strcpy(mpiinitvar,$1);
-                     if ( firstpass == 1 )
-                     {
-                        Add_UsedInSubroutine_Var_1 (mpiinitvar);
-/*                        curvar=createvar($1,NULL);
-                        curlistvar=insertvar(NULL,curvar);
-                        List_Subr outineArgument_Var = AddListvarToListvar
-                         (curlistvar,List_SubroutineAr gument_Var,1);*/
-                     }
-                  }
-               }
-      | '*' label
-      ;
-
-stop : TOK_PAUSE
-      | TOK_STOP
-      ;
-
-io : iofctl ioctl
-      | read option_read
-      | write ioctl
-      | write ioctl outlist
-      | TOK_REWIND after_rewind
-      | TOK_FORMAT
-      ;
-opt_CHAR_INT :
-      | TOK_CSTINT TOK_NAME
-      ;
-idfile : '*'
-      | TOK_CSTINT
-      | ident
-      ;
-option_print :
-      | ',' outlist
-      ;
-option_inlist :
-      | inlist
-      ;
-option_read : ioctl option_inlist
-      | infmt opt_inlist
-      ;
-opt_outlist :
-      | outlist
-      ;
-opt_inlist :
-      | ',' inlist
-      ;
-ioctl :  '(' ctllist ')'
-      | '(' fexpr ')'
-      ;
-after_rewind :  '(' ident ')'
-      | '(' TOK_CSTINT ')'
-      | TOK_CSTINT
-      | '(' uexpr ')'
-      | TOK_NAME
-      ;
-ctllist : ioclause
-      | ctllist ',' ioclause
-      ;
-ioclause : fexpr
-      | '*'
-      | TOK_DASTER
-      | ident expr dims      
-      | ident expr
-      | ident expr '%' ident_dims
-      | ident '(' triplet ')'
-      | ident '*'
-      | ident TOK_DASTER
-      ;
-iofctl : TOK_OPEN
-      | TOK_CLOSE
-      ;
-infmt :  unpar_fexpr
-      | '*'
-      ;
-
-read :TOK_READ
-      | TOK_INQUIRE
-      | TOK_PRINT
-      ;
-
-write : TOK_WRITE
-      ;
-
-fexpr : unpar_fexpr
-      | '(' fexpr ')'
-      ;
-unpar_fexpr : lhs
-      | simple_const
-      | fexpr addop fexpr %prec '+'
-      | fexpr '*' fexpr
-      | fexpr TOK_SLASH fexpr
-      | fexpr TOK_DASTER fexpr
-      | addop fexpr %prec '*'
-      | fexpr TOK_DSLASH fexpr
-      | TOK_FILE expr
-      | TOK_EXIST expr
-      | TOK_ERR expr
-      | TOK_END expr
-      | TOK_NAME '=' expr
-      | predefinedfunction
-      ;
-addop : '+'
-      | '-'
-      ;
-inlist : inelt
-      | inlist ',' inelt
-      ;
-opt_lhs :
-      | lhs
-      ;
-inelt : opt_lhs opt_operation
-      | '(' inlist ')' opt_operation
-      | predefinedfunction opt_operation
-      | simple_const opt_operation
-      | '(' inlist ',' dospec ')'
-      ;
-opt_operation :
-      | operation
-      | opt_operation operation
-      ;
-outlist : uexpr    {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | other      {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | out2       {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-out2: uexpr ',' expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      | uexpr ',' other
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      | other ',' expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      | other ',' other
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      | out2 ',' expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      | out2 ',' other
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      | uexpr     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | predefinedfunction {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-other :  complex_const
-                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | '(' expr ')'
-                   {if ( couldaddvariable == 1 ) sprintf($$," (%s)",$2);}
-      | '(' uexpr ',' dospec ')'
-                   {if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);}
-      | '(' other ',' dospec ')'
-                   {if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);}
-      | '(' out2 ',' dospec ')'
-                   {if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);}
-      ;
-
-dospec : TOK_NAME '=' expr ',' expr
-                   {if ( couldaddvariable == 1 )
-                                              sprintf($$,"%s=%s,%s)",$1,$3,$5);}
-      | TOK_NAME '=' expr ',' expr ',' expr
-                   {if ( couldaddvariable == 1 )
-                                        sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);}
-      ;
-labellist : label
-      | labellist ',' label
-      ;
-label : TOK_CSTINT
-      ;
-goto : TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
-      | TOK_PLAINGOTO label
-      ;
-allocation_list : allocate_object
-      | ident_dims
-      | allocation_list ',' allocate_object
-      ;
-allocate_object : ident
-                   {Add_Allocate_Var_1($1,curmodulename);}
-      | structure_component
-      | array_element
-      ;
-array_element : ident '(' funargs ')'
-                   {Add_Allocate_Var_1($1,curmodulename);}
-      ;
-subscript_list : expr
-      | subscript_list ',' expr
-      ;
-
-allocate_object_list :allocate_object
-      | allocate_object_list ',' allocate_object
-      ;
-opt_stat_spec :
-      | ',' TOK_STAT '=' ident
-      ;
-pointer_name_list : ident
-      | pointer_name_list ',' ident
-      ;
-opt_construct_name :
-      | TOK_NAME
-      ;
-opt_construct_name_colon :
-      | TOK_CONSTRUCTID ':'
-      ;
-logif : TOK_LOGICALIF expr ')'
-      ;
-do_var : ident {strcpy($$,$1);}
-      ;
-%%
-
-void processfortran(char *fichier_entree)
-{
-   extern FILE *fortranin;
-   extern FILE *fortranout;
-   char nomfile[LONG_C];
-   int c;
-   int confirmyes;
-
-/*   fortrandebug = 1;*/
-   if ( mark == 1 ) printf("Firstpass == %d \n",firstpass);
-/******************************************************************************/
-/*  1-  Open input and output files                                           */
-/******************************************************************************/
-   strcpy(nomfile,commondirin);
-   strcat(nomfile,"/");
-   strcat(nomfile,fichier_entree);
-   fortranin=fopen( nomfile,"r");
-   if (! fortranin)
-   {
-      printf("Error : File %s does not exist\n",nomfile);
-      exit(1);
-   }
-
-   strcpy(curfile,nomfile);
-   strcpy(nomfile,commondirout);
-   strcat(nomfile,"/");
-   strcat(nomfile,fichier_entree);
-   strcpy(nomfileoutput,nomfile);
-   Save_Length(nomfileoutput,31);
-   if (firstpass == 1)
-   {
-      if (checkexistcommon == 1)
-      {
-         if (fopen(nomfile,"r"))
-         {
-            printf("Warning : file %s already exist\n",nomfile);
-            confirmyes = 0;
-            while (confirmyes==0)
-            {
-               printf("Override file %s ? [Y/N]\n",nomfile);
-               c=getchar();
-               getchar();
-               if (c==79 || c==110)
-               {
-                  printf("We stop\n");
-                  exit(1);
-               }
-               if (c==89 || c==121)
-               {
-                  confirmyes=1;
-               }
-            }
-         }
-      }
-   }
-
-/******************************************************************************/
-/*  2-  Variables initialization                                              */
-/******************************************************************************/
-
-   line_num_fortran_common=1;
-   line_num_fortran=1;
-   PublicDeclare = 0;
-   PrivateDeclare = 0;
-   ExternalDeclare = 0;
-   SaveDeclare = 0;
-   pointerdeclare = 0;
-   optionaldeclare = 0;
-   incalldeclare = 0;
-   VarType = 0;
-   VarTypepar = 0;
-   Allocatabledeclare = 0 ;
-   Targetdeclare = 0 ;
-   strcpy(NamePrecision," ");
-   VariableIsParameter =  0 ;
-   strcpy(NamePrecision,"");
-   c_star = 0 ;
-   functiondeclarationisdone = 0;
-   insubroutinedeclare = 0 ;
-   ininterfacedeclare = 0 ;   
-   strcpy(subroutinename," ");
-   isrecursive = 0;
-   strcpy(InitialValueGiven," ");
-   strcpy(EmptyChar," ");
-   inmoduledeclare = 0;
-   incontainssubroutine = 0;
-   module_declar_type = 0;
-   GlobalDeclarationType = 0;
-   colnum=0;
-   incom=0;
-   couldaddvariable=1;
-   afterpercent = 0;
-   aftercontainsdeclare = 1;
-   strcpy(nameinttypename,"");
-   /* Name of the file without format                                         */
-   tmp = strchr(fichier_entree, '.');
-   strncpy(curfilename,fichier_entree,strlen(fichier_entree)-strlen(tmp));
-   Save_Length(curfilename,30);
-/******************************************************************************/
-/*  3-  Parsing of the input file (1 time)                                    */
-/******************************************************************************/
-   if (firstpass == 0 )
-   {
-      fortranout=fopen(nomfileoutput,"w");
-
-/*      NewModule_Creation_0();*/
-   }
-
-   fortranparse();
-
-   if (firstpass == 0 )
-   {
-   NewModule_Creation_0();
-   }
-   
-   strcpy(curfile,mainfile);
-
-   if (firstpass == 0 )
-   {
-   fclose(fortranout);
-   }
-}
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.yy.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.yy.c	(revision 6807)
+++ 	(revision )
@@ -1,5248 +1,0 @@
-#line 2 "fortran.yy.c"
-
-#line 4 "fortran.yy.c"
-
-#define  YY_INT_ALIGNED short int
-
-/* A lexical scanner generated by flex */
-
-#define yy_create_buffer fortran_create_buffer
-#define yy_delete_buffer fortran_delete_buffer
-#define yy_flex_debug fortran_flex_debug
-#define yy_init_buffer fortran_init_buffer
-#define yy_flush_buffer fortran_flush_buffer
-#define yy_load_buffer_state fortran_load_buffer_state
-#define yy_switch_to_buffer fortran_switch_to_buffer
-#define yyin fortranin
-#define yyleng fortranleng
-#define yylex fortranlex
-#define yylineno fortranlineno
-#define yyout fortranout
-#define yyrestart fortranrestart
-#define yytext fortrantext
-#define yywrap fortranwrap
-#define yyalloc fortranalloc
-#define yyrealloc fortranrealloc
-#define yyfree fortranfree
-
-#define FLEX_SCANNER
-#define YY_FLEX_MAJOR_VERSION 2
-#define YY_FLEX_MINOR_VERSION 5
-#define YY_FLEX_SUBMINOR_VERSION 35
-#if YY_FLEX_SUBMINOR_VERSION > 0
-#define FLEX_BETA
-#endif
-
-/* First, we deal with  platform-specific or compiler-specific issues. */
-
-/* begin standard C headers. */
-#include <stdio.h>
-#include <string.h>
-#include <errno.h>
-#include <stdlib.h>
-
-/* end standard C headers. */
-
-/* flex integer type definitions */
-
-#ifndef FLEXINT_H
-#define FLEXINT_H
-
-/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
-
-#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
-
-/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,
- * if you want the limit (max/min) macros for int types. 
- */
-#ifndef __STDC_LIMIT_MACROS
-#define __STDC_LIMIT_MACROS 1
-#endif
-
-#include <inttypes.h>
-typedef int8_t flex_int8_t;
-typedef uint8_t flex_uint8_t;
-typedef int16_t flex_int16_t;
-typedef uint16_t flex_uint16_t;
-typedef int32_t flex_int32_t;
-typedef uint32_t flex_uint32_t;
-#else
-typedef signed char flex_int8_t;
-typedef short int flex_int16_t;
-typedef int flex_int32_t;
-typedef unsigned char flex_uint8_t; 
-typedef unsigned short int flex_uint16_t;
-typedef unsigned int flex_uint32_t;
-#endif /* ! C99 */
-
-/* Limits of integral types. */
-#ifndef INT8_MIN
-#define INT8_MIN               (-128)
-#endif
-#ifndef INT16_MIN
-#define INT16_MIN              (-32767-1)
-#endif
-#ifndef INT32_MIN
-#define INT32_MIN              (-2147483647-1)
-#endif
-#ifndef INT8_MAX
-#define INT8_MAX               (127)
-#endif
-#ifndef INT16_MAX
-#define INT16_MAX              (32767)
-#endif
-#ifndef INT32_MAX
-#define INT32_MAX              (2147483647)
-#endif
-#ifndef UINT8_MAX
-#define UINT8_MAX              (255U)
-#endif
-#ifndef UINT16_MAX
-#define UINT16_MAX             (65535U)
-#endif
-#ifndef UINT32_MAX
-#define UINT32_MAX             (4294967295U)
-#endif
-
-#endif /* ! FLEXINT_H */
-
-#ifdef __cplusplus
-
-/* The "const" storage-class-modifier is valid. */
-#define YY_USE_CONST
-
-#else	/* ! __cplusplus */
-
-/* C99 requires __STDC__ to be defined as 1. */
-#if defined (__STDC__)
-
-#define YY_USE_CONST
-
-#endif	/* defined (__STDC__) */
-#endif	/* ! __cplusplus */
-
-#ifdef YY_USE_CONST
-#define yyconst const
-#else
-#define yyconst
-#endif
-
-/* Returned upon end-of-file. */
-#define YY_NULL 0
-
-/* Promotes a possibly negative, possibly signed char to an unsigned
- * integer for use as an array index.  If the signed char is negative,
- * we want to instead treat it as an 8-bit unsigned char, hence the
- * double cast.
- */
-#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
-
-/* Enter a start condition.  This macro really ought to take a parameter,
- * but we do it the disgusting crufty way forced on us by the ()-less
- * definition of BEGIN.
- */
-#define BEGIN (yy_start) = 1 + 2 *
-
-/* Translate the current start state into a value that can be later handed
- * to BEGIN to return to the state.  The YYSTATE alias is for lex
- * compatibility.
- */
-#define YY_START (((yy_start) - 1) / 2)
-#define YYSTATE YY_START
-
-/* Action number for EOF rule of a given start state. */
-#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
-
-/* Special action meaning "start processing a new file". */
-#define YY_NEW_FILE fortranrestart(fortranin  )
-
-#define YY_END_OF_BUFFER_CHAR 0
-
-/* Size of default input buffer. */
-#ifndef YY_BUF_SIZE
-#define YY_BUF_SIZE 16384
-#endif
-
-/* The state buf must be large enough to hold one state per character in the main buffer.
- */
-#define YY_STATE_BUF_SIZE   ((YY_BUF_SIZE + 2) * sizeof(yy_state_type))
-
-#ifndef YY_TYPEDEF_YY_BUFFER_STATE
-#define YY_TYPEDEF_YY_BUFFER_STATE
-typedef struct yy_buffer_state *YY_BUFFER_STATE;
-#endif
-
-#ifndef YY_TYPEDEF_YY_SIZE_T
-#define YY_TYPEDEF_YY_SIZE_T
-typedef size_t yy_size_t;
-#endif
-
-extern yy_size_t fortranleng;
-
-extern FILE *fortranin, *fortranout;
-
-#define EOB_ACT_CONTINUE_SCAN 0
-#define EOB_ACT_END_OF_FILE 1
-#define EOB_ACT_LAST_MATCH 2
-
-    #define YY_LESS_LINENO(n)
-    
-/* Return all but the first "n" matched characters back to the input stream. */
-#define yyless(n) \
-	do \
-		{ \
-		/* Undo effects of setting up fortrantext. */ \
-        int yyless_macro_arg = (n); \
-        YY_LESS_LINENO(yyless_macro_arg);\
-		*yy_cp = (yy_hold_char); \
-		YY_RESTORE_YY_MORE_OFFSET \
-		(yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
-		YY_DO_BEFORE_ACTION; /* set up fortrantext again */ \
-		} \
-	while ( 0 )
-
-#define unput(c) yyunput( c, (yytext_ptr)  )
-
-#ifndef YY_STRUCT_YY_BUFFER_STATE
-#define YY_STRUCT_YY_BUFFER_STATE
-struct yy_buffer_state
-	{
-	FILE *yy_input_file;
-
-	char *yy_ch_buf;		/* input buffer */
-	char *yy_buf_pos;		/* current position in input buffer */
-
-	/* Size of input buffer in bytes, not including room for EOB
-	 * characters.
-	 */
-	yy_size_t yy_buf_size;
-
-	/* Number of characters read into yy_ch_buf, not including EOB
-	 * characters.
-	 */
-	yy_size_t yy_n_chars;
-
-	/* Whether we "own" the buffer - i.e., we know we created it,
-	 * and can realloc() it to grow it, and should free() it to
-	 * delete it.
-	 */
-	int yy_is_our_buffer;
-
-	/* Whether this is an "interactive" input source; if so, and
-	 * if we're using stdio for input, then we want to use getc()
-	 * instead of fread(), to make sure we stop fetching input after
-	 * each newline.
-	 */
-	int yy_is_interactive;
-
-	/* Whether we're considered to be at the beginning of a line.
-	 * If so, '^' rules will be active on the next match, otherwise
-	 * not.
-	 */
-	int yy_at_bol;
-
-    int yy_bs_lineno; /**< The line count. */
-    int yy_bs_column; /**< The column count. */
-    
-	/* Whether to try to fill the input buffer when we reach the
-	 * end of it.
-	 */
-	int yy_fill_buffer;
-
-	int yy_buffer_status;
-
-#define YY_BUFFER_NEW 0
-#define YY_BUFFER_NORMAL 1
-	/* When an EOF's been seen but there's still some text to process
-	 * then we mark the buffer as YY_EOF_PENDING, to indicate that we
-	 * shouldn't try reading from the input source any more.  We might
-	 * still have a bunch of tokens to match, though, because of
-	 * possible backing-up.
-	 *
-	 * When we actually see the EOF, we change the status to "new"
-	 * (via fortranrestart()), so that the user can continue scanning by
-	 * just pointing fortranin at a new input file.
-	 */
-#define YY_BUFFER_EOF_PENDING 2
-
-	};
-#endif /* !YY_STRUCT_YY_BUFFER_STATE */
-
-/* Stack of input buffers. */
-static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
-static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
-static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
-
-/* We provide macros for accessing buffer states in case in the
- * future we want to put the buffer states in a more general
- * "scanner state".
- *
- * Returns the top of the stack, or NULL.
- */
-#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
-                          ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
-                          : NULL)
-
-/* Same as previous macro, but useful when we know that the buffer stack is not
- * NULL or when we need an lvalue. For internal use only.
- */
-#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
-
-/* yy_hold_char holds the character lost when fortrantext is formed. */
-static char yy_hold_char;
-static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
-yy_size_t fortranleng;
-
-/* Points to current character in buffer. */
-static char *yy_c_buf_p = (char *) 0;
-static int yy_init = 0;		/* whether we need to initialize */
-static int yy_start = 0;	/* start state number */
-
-/* Flag which is used to allow fortranwrap()'s to do buffer switches
- * instead of setting up a fresh fortranin.  A bit of a hack ...
- */
-static int yy_did_buffer_switch_on_eof;
-
-void fortranrestart (FILE *input_file  );
-void fortran_switch_to_buffer (YY_BUFFER_STATE new_buffer  );
-YY_BUFFER_STATE fortran_create_buffer (FILE *file,int size  );
-void fortran_delete_buffer (YY_BUFFER_STATE b  );
-void fortran_flush_buffer (YY_BUFFER_STATE b  );
-void fortranpush_buffer_state (YY_BUFFER_STATE new_buffer  );
-void fortranpop_buffer_state (void );
-
-static void fortranensure_buffer_stack (void );
-static void fortran_load_buffer_state (void );
-static void fortran_init_buffer (YY_BUFFER_STATE b,FILE *file  );
-
-#define YY_FLUSH_BUFFER fortran_flush_buffer(YY_CURRENT_BUFFER )
-
-YY_BUFFER_STATE fortran_scan_buffer (char *base,yy_size_t size  );
-YY_BUFFER_STATE fortran_scan_string (yyconst char *yy_str  );
-YY_BUFFER_STATE fortran_scan_bytes (yyconst char *bytes,yy_size_t len  );
-
-void *fortranalloc (yy_size_t  );
-void *fortranrealloc (void *,yy_size_t  );
-void fortranfree (void *  );
-
-#define yy_new_buffer fortran_create_buffer
-
-#define yy_set_interactive(is_interactive) \
-	{ \
-	if ( ! YY_CURRENT_BUFFER ){ \
-        fortranensure_buffer_stack (); \
-		YY_CURRENT_BUFFER_LVALUE =    \
-            fortran_create_buffer(fortranin,YY_BUF_SIZE ); \
-	} \
-	YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
-	}
-
-#define yy_set_bol(at_bol) \
-	{ \
-	if ( ! YY_CURRENT_BUFFER ){\
-        fortranensure_buffer_stack (); \
-		YY_CURRENT_BUFFER_LVALUE =    \
-            fortran_create_buffer(fortranin,YY_BUF_SIZE ); \
-	} \
-	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
-	}
-
-#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
-
-/* Begin user sect3 */
-
-typedef unsigned char YY_CHAR;
-
-FILE *fortranin = (FILE *) 0, *fortranout = (FILE *) 0;
-
-typedef int yy_state_type;
-
-extern int fortranlineno;
-
-int fortranlineno = 1;
-
-extern char *fortrantext;
-#define yytext_ptr fortrantext
-
-static yy_state_type yy_get_previous_state (void );
-static yy_state_type yy_try_NUL_trans (yy_state_type current_state  );
-static int yy_get_next_buffer (void );
-static void yy_fatal_error (yyconst char msg[]  );
-
-/* Done after the current pattern has been matched and before the
- * corresponding action - sets up fortrantext.
- */
-#define YY_DO_BEFORE_ACTION \
-	(yytext_ptr) = yy_bp; \
-	fortranleng = (size_t) (yy_cp - yy_bp); \
-	(yy_hold_char) = *yy_cp; \
-	*yy_cp = '\0'; \
-	(yy_c_buf_p) = yy_cp;
-
-#define YY_NUM_RULES 176
-#define YY_END_OF_BUFFER 177
-/* This struct is not used in this scanner,
-   but its presence is necessary. */
-struct yy_trans_info
-	{
-	flex_int32_t yy_verify;
-	flex_int32_t yy_nxt;
-	};
-static yyconst flex_int16_t yy_accept[1162] =
-    {   0,
-        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-        0,    0,  177,  176,  165,  161,  164,  175,  152,  151,
-      155,  167,  152,  154,  154,  154,  157,  153,  137,  150,
-      156,  159,  158,  160,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  165,  161,  164,  175,  150,  145,  145,  145,
-      145,  145,  145,  176,  176,  173,  176,  176,  176,  161,
-      161,  154,  145,    0,    0,  165,    0,  166,    0,  164,
-      175,  175,  175,    0,  141,    0,    0,  167,  167,  167,
-      167,    0,    0,    0,  140,    0,    0,  132,   26,    0,
-
-      146,    0,    0,    0,    0,    0,    0,    0,  133,    0,
-      150,   25,    0,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-       43,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,   85,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  165,  163,    0,  163,    0,    0,    0,    0,
-        0,    0,  166,  162,  163,    0,  175,  174,  175,  175,
-      175,  163,  150,    4,  145,  145,  145,  145,   85,  145,
-
-      145,    0,  173,    0,    0,    0,    0,    0,    0,    0,
-      169,   26,    0,    0,    4,    0,  145,  145,  145,  145,
-      145,  145,    0,    0,    0,  175,  175,    0,    0,  167,
-      167,    0,    0,    0,    0,  139,    0,    0,    0,    0,
-        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-        0,  149,  146,    0,    0,    0,  142,    0,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  115,  145,  145,  145,    0,  145,  145,  145,  145,
-      145,   16,  145,  145,  145,  114,  145,  145,  145,  145,
-      145,    0,  145,    0,   96,  145,  145,  145,  145,  145,
-
-      121,  145,  145,  126,  145,  145,  145,  145,  145,  145,
-      145,   89,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  118,  145,  145,  145,
-      145,  145,  122,  145,  145,  145,  145,  145,  165,  163,
-        0,  166,    0,    0,    0,    0,    0,    0,    0,    0,
-      163,    0,  163,  175,  175,  175,  150,    4,    4,    4,
-        4,  145,  145,  145,  145,  145,  145,  145,    0,    0,
-        0,    0,  170,    0,    0,  169,    0,    0,    4,    4,
-        4,    4,  142,    0,  145,  145,    0,  145,  145,  145,
-      145,    0,    0,    0,  175,  175,    0,    0,  167,  167,
-
-        0,    0,    0,    0,  147,    0,  146,    0,  148,    0,
-       28,    0,   30,   29,   32,   31,   34,    0,    0,   36,
-        0,  146,    0,  147,    0,  146,    0,  148,    0,  142,
-        0,  125,  117,  145,  145,  120,  123,  145,  145,   22,
-      145,  145,  145,  145,  145,  116,  145,  145,  145,    0,
-      145,  145,  145,   94,    0,  108,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,    0,  109,  145,  145,  145,
-      145,  145,  145,  145,    0,   88,  145,  145,  145,  145,
-      145,  145,  145,    0,   98,  145,  145,    0,  111,  145,
-      145,  145,  145,  112,   21,  145,   60,   74,  145,  145,
-
-      145,  145,  145,  145,  145,  145,   79,   44,  145,  145,
-      145,  145,   69,  145,  127,  119,  145,   72,   54,  145,
-        0,   97,   99,  145,   92,  101,  145,  145,  165,  163,
-      166,    0,    0,    0,    0,    0,    0,    0,  163,    0,
-      163,  175,  175,  175,  150,    4,    4,  145,  145,  145,
-      145,  145,  145,   18,    0,    0,    0,    0,    0,  170,
-        0,    0,    4,    4,    0,  142,    0,  145,  145,  145,
-      145,    0,    0,    0,  175,  175,    0,    0,  167,  167,
-        0,    0,   38,   27,    0,   35,   37,    0,  142,    0,
-      142,  145,  145,  145,  145,  145,   49,  145,  145,  145,
-
-      124,  145,  145,    0,  145,  145,  145,    0,  145,  145,
-        0,    0,    0,    0,    0,    0,    0,    0,   42,  145,
-       95,  145,  145,  145,  145,  145,  145,  145,  145,   76,
-       76,   76,   76,  145,    0,  107,  113,  145,  145,   88,
-      145,  145,   90,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,   52,  145,   77,
-      145,  145,  145,    0,  145,  145,  145,  145,  145,  102,
-      145,  145,   55,   81,  165,  163,  166,    0,    0,    0,
-        0,    0,    0,  163,    0,  163,  175,  175,  175,  150,
-        4,    3,    0,  104,  145,  145,   86,  145,  145,   70,
-
-       71,   70,    0,    0,    0,    0,    4,    3,    0,  142,
-        0,  142,  145,   49,  145,  124,    0,   23,    0,  175,
-       23,    0,   23,   23,  167,   23,    0,   23,   23,   23,
-       33,  145,  145,   23,   23,   23,  145,  145,   63,  145,
-      145,  145,  145,    0,  145,  145,  138,    0,    0,   93,
-      145,   42,    0,   95,    0,    0,    0,    0,    0,    0,
-      145,  145,  145,  145,  145,  145,  145,  145,    0,  110,
-      145,  145,  145,  145,  145,  145,  145,   66,  145,  145,
-      129,  100,  128,  130,   39,  145,  145,  145,  145,  145,
-      145,  145,   83,    0,  145,   11,   75,   19,  145,  145,
-
-       82,  165,  163,  166,    0,    0,    0,    0,  163,  175,
-      175,   23,    4,    3,    3,  145,  145,  145,  145,    0,
-        0,    0,   23,    4,    3,    3,  145,   23,   23,   23,
-       24,    0,  168,   24,   24,   24,   24,   24,   24,   24,
-       24,   24,   24,  145,  145,  145,   58,  145,  145,  145,
-        0,    0,  145,  145,   40,   93,    0,  145,    0,    0,
-        0,    0,    0,    0,    0,  145,  145,  145,  145,  145,
-       73,  145,  145,  145,    0,    0,  145,  145,   17,   50,
-       45,  145,   46,    0,  145,  145,    9,  145,  145,   67,
-       84,    7,    0,    0,  145,    0,  145,  145,    0,    0,
-
-        0,    0,  175,   24,    4,  145,  145,   64,  145,    0,
-        0,   24,    4,   24,   24,   24,  145,    8,  145,  145,
-       87,  145,  145,   40,    0,    0,  145,  145,    0,  145,
-        0,    0,    0,    0,    0,   73,    0,  145,  145,  145,
-      145,  145,   56,  145,   65,    0,    0,    0,    0,  134,
-       12,   20,  145,    0,  145,   80,   68,  145,    0,  145,
-        0,  145,  145,    0,    0,    0,  175,    4,  145,   59,
-      145,    0,    0,    4,  145,  131,   47,  145,   51,    0,
-        0,  145,  145,    0,   57,    0,    0,    0,    0,    0,
-       56,  145,   41,  145,  106,  145,  145,    0,    0,    0,
-
-        0,    0,  134,   91,    0,  145,   61,    0,   62,    0,
-      145,  145,    0,   59,    0,  175,    4,    4,  145,  143,
-        0,    0,    4,    4,  145,   10,    0,    0,  145,  145,
-       57,    0,   41,    0,  106,    0,  145,   14,  145,  145,
-        0,    0,    0,  145,    0,    0,  103,    6,    0,  143,
-      175,    4,    4,  145,    0,    0,    4,    4,   48,    0,
-        0,  145,  145,    0,   14,    0,   15,  145,   53,    0,
-        0,    0,  145,    0,  103,    0,  175,    4,    2,  105,
-        0,    0,    4,    2,    0,    0,  145,  145,   15,    0,
-      145,    0,    0,    0,  145,    0,  105,  175,    4,    0,
-
-        0,    4,    0,    0,  136,  145,    0,   13,    0,    0,
-        0,  145,    0,  175,    1,    0,    0,  144,    1,  136,
-        0,  145,   13,    0,    0,    0,    0,  145,    0,  175,
-        0,    0,  135,    0,    0,    0,   78,    5,  175,    0,
-      135,   78,  175,    0,  175,    0,  175,    0,  175,    0,
-      175,    0,  175,  171,    0,    0,    0,    0,    0,  172,
-        0
-    } ;
-
-static yyconst flex_int32_t yy_ec[256] =
-    {   0,
-        1,    1,    1,    1,    1,    1,    1,    1,    2,    3,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    4,    5,    6,    7,    8,    9,   10,   11,   12,
-       13,   14,   15,   16,   17,   18,   19,   20,   21,   22,
-       23,   24,   25,   26,   27,   28,   29,   30,   31,   32,
-       33,   34,    1,    1,   35,   36,   37,   38,   39,   40,
-       41,   42,   43,   44,   45,   46,   47,   48,   49,   50,
-       51,   52,   53,   54,   55,   56,   57,   58,   59,   60,
-       61,    1,   62,    1,   63,    1,   64,   65,   66,   67,
-
-       68,   69,   70,   71,   72,   44,   73,   74,   75,   76,
-       77,   78,   79,   80,   81,   82,   83,   84,   85,   86,
-       87,   88,   89,   89,   89,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1
-    } ;
-
-static yyconst flex_int32_t yy_meta[90] =
-    {   0,
-        1,    2,    3,    2,    1,    4,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    5,    1,    6,
-        6,    6,    6,    6,    6,    6,    6,    6,    6,    1,
-        1,    1,    1,    1,    7,    8,    8,    9,    9,    5,
-       10,   11,    8,    8,    8,   10,   10,   10,    7,    8,
-        9,   10,   10,    5,   10,    8,   12,    8,    8,    8,
-        1,    1,    8,    7,    8,    8,    9,    9,    5,   10,
-       11,    8,    8,   10,   10,   10,    7,    8,    9,   10,
-       10,    5,   10,    8,   12,    8,    8,    8,    4
-    } ;
-
-static yyconst flex_int16_t yy_base[1215] =
-    {   0,
-        0,   88,    0,    0,    0,    0, 1215,   93, 1196,   91,
-        0,    0, 1179,   64,   97,  117,  132,   87,  124,   98,
-       99,  142,  173,  154,  108,  135,  134,  254,  172,  179,
-      175,  178,  219,  180,  323,  388,  384,  318,  386,  319,
-      186,  128,  250,  256,  392,  404,  438,  428,  204,  455,
-      432,  465,  544,  120,  537,  548,  627,  624,  622,  544,
-      644,  658,  251, 9159, 1175, 9159,  267,   99,  162,  569,
-      572,  620,  745,  164,  107,  262,  307,  335,  376,  522,
-        0,  167,  157, 1162, 9159,  278,  321, 1160, 1118,  372,
-      304,  532,  593,  567, 9159,  633,  832, 9159, 9159,  911,
-
-      798,  318,  319,  450,  799,  552,  320,  354, 9159,  978,
-      834, 9159,  865,  860,  862,  866,  914,  863,  973,  980,
-      974, 1013, 1024, 1045,  869, 1049, 1075, 1095, 1098, 1101,
-     1182, 1177, 1161, 1181, 1214, 1212, 1237, 1239, 1235, 1270,
-     1290, 1316, 1325, 1293, 1346, 1323, 1366, 1368, 1391, 1399,
-     1403, 1429, 1430, 1455, 1452, 1478, 1498, 1482, 1523, 1521,
-     1554, 1548, 1579, 1586, 1606, 1629, 1649, 1675, 1681, 1698,
-     1707, 1729,  871, 1114, 1109,  140, 1023,  187,  372,  403,
-      553,  401, 1095,  565, 1792, 1818, 1083, 9159,  643,  669,
-      589, 1844, 1870, 1580, 1865, 1867, 1868, 1905, 1926, 1922,
-
-     1925, 1078, 9159,  837,  437,  677,  249,  660, 1072,  712,
-     9159, 1062,  844,  625, 1874, 1993, 2022, 1042,  864,  473,
-      904,  621,  506,  651,  721,  798,  791,  890,  912,  936,
-      907,  725, 1029, 1143,  729, 9159, 1114, 1179, 2097, 2112,
-     2127,  229,  937, 1033, 1012, 1006,  994,  943,  883,  974,
-      891, 9159, 1476, 2142, 2157, 2172, 2182, 2202, 2178, 2180,
-     2200, 2203, 2223, 2243, 2246, 2244, 2276, 2269, 2299, 2307,
-     2301, 2324, 2344, 2351, 2377,  901, 1018, 2374, 2394, 2397,
-     2414, 2495, 2434, 2440, 2465, 2472, 2518, 2521, 2515, 2548,
-     2556, 1138, 2564,  968, 9159, 2581, 2597, 2604, 2627, 2649,
-
-     2650, 2690, 2693, 2686, 2726, 2738, 2746, 2747, 2763, 2783,
-     2799, 2800, 2803, 2820, 2840, 2843, 2870, 2891, 2895, 2903,
-     2926, 2928, 2935, 2961, 2981, 2958, 2984, 2978, 3004, 3011,
-     3027, 3052, 3048, 3059, 3085, 3068, 3105, 3111,  196,  203,
-      976,  383,  974,  988, 1018, 1014, 1025, 1029, 1042,  253,
-     3174, 3200, 3226, 1067, 1182, 1172, 3252,    0,  418,  288,
-     1096, 3228, 3229, 3231, 3251, 3267, 3287, 3290, 1188, 1566,
-      973,  740, 9159,  938,  866, 9159, 1268, 1178,  931, 1170,
-     1241, 1299, 3354, 3381,    0,  903, 3408, 1148, 1116, 1177,
-     1322, 1145,  410, 1415, 1235,  460, 1292, 1218, 1323, 1022,
-
-      963, 1520, 1662, 3418, 3430, 3440, 3450, 3460, 3470,  889,
-     9159,  865, 9159, 9159, 9159, 9159, 9159, 1239,  853, 9159,
-      846, 2472, 3480, 3490, 3500, 3510, 3520, 3530, 3545, 3555,
-     3575, 9159, 3289, 3553, 3573, 3551, 3574, 3590, 3596, 3612,
-     3628, 3634, 3635, 3655, 3671, 3651, 3687, 3688, 3696,  459,
-     3728, 3736, 3740, 3784, 3868, 9159, 3780, 3776, 3807, 3811,
-     3850, 3912, 3872, 3920, 3921, 1351, 9159, 3828, 4005, 4060,
-     4095, 3904, 4063, 4069, 1258, 4096, 4104, 4126, 4134, 4156,
-     4165, 4196, 4205, 1409, 9159, 4208, 4197, 1476, 9159, 4235,
-     4241, 4257, 4261, 4273, 4284, 4293, 4305, 4309, 4332, 4336,
-
-     4353, 4316, 4359, 4362, 4384, 4407, 4385, 4416, 4423, 4448,
-     4455, 4456, 4486, 4494, 4488, 4511, 4527, 4519, 4531, 4554,
-     1498, 9159, 4552, 4575, 4584, 4587, 4607, 4610,  493,  529,
-      551,  476, 1287,  816,  953, 1119, 1293,  841, 4678, 4704,
-     4730, 1607, 1346, 1458, 4756, 1362, 1397, 4733, 4732, 4759,
-     4627, 4768, 4817,  733, 1619, 1594, 1406,  728, 1537, 9159,
-     1571, 1651, 1625, 1613, 4839, 4867, 4894, 1627, 1658, 1686,
-     1714, 1394,    0, 1756, 1574,    0, 1668,  724, 1709,  724,
-     1763, 1775, 9159, 9159,  708, 9159, 9159, 4904, 4916, 4926,
-     4936, 4771, 4931, 5013, 4934, 5068, 5069, 5071, 5075, 5072,
-
-     5120, 5121, 5123, 1725, 5127, 5153, 5176, 1832, 5175, 5179,
-     1458, 1493, 1739, 1516, 1519, 1873, 1592, 1739, 5201, 5224,
-     5202, 5241, 5240, 5257, 5278, 5280, 5301, 5284, 5352, 9159,
-     5351, 5346, 5349, 5353, 1802, 9159, 5355, 5385, 5401, 9159,
-     5405, 5408, 5412, 5428, 5449, 5451, 5458, 5460, 5495, 5501,
-     5531, 5527, 5539, 5571, 5564, 5575, 5591, 5602, 5623, 5614,
-     5634, 5635, 5660,  693, 5666, 5667, 5692, 5703, 5715, 9159,
-     5723, 5719, 5740, 5746,  846, 1103, 1234, 1788, 1768, 1386,
-     1788, 1615, 1847, 1854,  236,  590, 1781, 1913,  715, 5809,
-     1790, 1645, 2264, 9159, 5785, 5805, 1690, 5806, 5807, 2344,
-
-     9159, 1951, 1858, 1924, 2256,  679, 1930, 1879, 5870, 5880,
-     5907, 5917, 1811,  658, 5946,  624,    0, 9159, 6034,    0,
-        0,  613,  609, 9159,  604,  586, 2245, 2364, 2389, 9159,
-     9159, 6063, 6118, 6139, 6138, 6134, 6135, 6141, 6161, 6173,
-     6184, 6209, 6217, 1654, 6260, 6248, 6216, 1844, 1864, 6239,
-     6280, 9159, 1689, 9159, 1930, 1750, 1763, 1934, 1933, 2077,
-     6300, 6292, 6317, 6337, 6338, 6344, 6369, 6376, 2212, 9159,
-     6360, 6413, 6392, 6412, 6424, 6433, 6456, 6435, 6465, 6476,
-     6488, 6497, 6508, 6509, 6552, 6529, 6540, 6549, 6560, 6585,
-     6593, 6605, 6628, 2392, 6636, 6637, 6648, 6659, 6694, 6685,
-
-     6686, 6775, 2286,  518, 2092, 2103, 1938, 2148, 2420, 2303,
-      472,  442, 2196,    0, 1803, 6692, 6717, 6768, 6756, 2424,
-     2334,  426,  422, 2432,  378, 1883, 6858, 6945, 6974,  337,
-     9159, 1922, 9159,    0,  328, 9159,  314, 2481, 2510, 9159,
-     6929, 6757, 7029, 7031, 7037, 7040, 7033, 7077, 7070, 7086,
-     2264, 2842, 7093, 7097, 7118, 9159, 2372, 7129, 2384, 2060,
-     2411, 2418, 2078, 2421, 2139, 7138, 7149, 7170, 7179, 7195,
-     7201, 7227, 7234, 7236, 2483, 3160, 7259, 7257, 7279, 7280,
-     7282, 7302, 7318, 2564, 7325, 7319, 7345, 7356, 7377, 7357,
-     7368, 7388, 2513, 2467, 7400, 2603, 7389, 7425, 2468, 2371,
-
-     2235, 2479,  361,  296,  182, 7409, 7432, 2249, 7455,  622,
-     2529,  227, 1008, 7505,    0,  207, 7482, 7503, 7505, 7514,
-     7535, 7536, 7544, 9159, 2413, 2526, 7567, 7571, 2546, 7593,
-     2547, 2562, 2567, 2526, 2575, 9159, 2526, 7587, 7625, 7594,
-     7631, 7632, 7648, 7657, 7668, 3179, 3203, 2672, 3229, 3335,
-     7684, 7688, 7709, 2597, 7705, 7725, 7732, 7736,  178, 7758,
-     2596, 7775, 7769, 2619, 2617, 2641, 2696, 2668, 7795, 7801,
-     7807, 2677, 2720, 3150, 7827, 7818, 7834, 7867, 7850, 2625,
-     2685, 7870, 7890, 2688, 7859, 2699, 2731, 2741, 2661, 2665,
-     9159, 7911, 7907, 7910, 7927, 7933, 7963, 2822, 3360, 3384,
-
-     3411, 4103, 4220, 7959, 2702, 7970, 7966, 2741, 7986, 2738,
-     8003, 8019, 2758, 9159, 2765, 2781, 2809, 2818, 8030, 8026,
-     2900, 2883, 2903, 2951, 8042, 8051, 2820, 2829, 8063, 8086,
-     9159, 2838, 9159, 2846, 9159, 2846, 8088, 8090, 8113, 8134,
-     3067, 4430, 2880, 8136,  175, 2911, 8125, 8156, 2877, 9159,
-     1190, 2938, 2908, 8157, 3034, 3081, 3049, 3028, 8173, 2959,
-     2985, 8189, 8182, 3029, 9159, 3039, 8205, 8212, 8214, 3241,
-     4684, 3056, 8235, 3049, 9159, 3056, 3212, 3072,    0, 8237,
-     1210, 3169, 3157,  144, 3103, 3103, 8257, 8260, 9159, 3110,
-     8283, 3255, 4708, 3110, 8290,  123, 9159, 3235, 3207, 3329,
-
-     3387, 3558, 3232, 3256, 8306, 8313, 3278, 8315, 8396, 4870,
-     3259, 8391, 3280, 3664,    0, 3349, 3414, 9159,  103, 9159,
-     3346, 8392, 9159, 3745, 4900, 8473, 3347, 8450,   90, 1237,
-     1328, 3570, 8470, 4973, 4977, 3380, 8471, 9159, 3676, 3645,
-     9159, 9159, 3693, 3608, 3764, 3684, 3616, 1433, 3705, 3782,
-     3810, 3774, 3875, 9159, 3852, 3697, 3910, 3892, 3896, 9159,
-     9159, 8553, 8565, 8577, 8589, 8601, 8613, 8621, 8623, 8635,
-     8647, 8659, 8671, 8678, 8687, 8699, 8711, 8723, 8735, 8747,
-     8754, 8762, 8774, 8786, 8798, 8810, 8822, 8834, 8846, 8858,
-     8870, 8882, 8894, 8906, 8918, 8930, 8942, 8954, 8966, 8978,
-
-     8990, 9002, 9014, 9026, 9038, 9050, 9062, 9074, 9086, 9098,
-     9110, 9122, 9134, 9146
-    } ;
-
-static yyconst flex_int16_t yy_def[1215] =
-    {   0,
-     1161,    1, 1162, 1162,    1,    2, 1163, 1163,    1,    2,
-        1,    2, 1161, 1161, 1161, 1161, 1161, 1164, 1165, 1161,
-     1161, 1166, 1167, 1161, 1161, 1161, 1161, 1161, 1161, 1168,
-     1161, 1161, 1161, 1161, 1169, 1169,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36, 1161, 1161,   53, 1170, 1161,   36,   36,   36,
-       36,   36,   36, 1161, 1171, 1161, 1171, 1171, 1171, 1161,
-     1161, 1172, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1164, 1164, 1164, 1165, 1161, 1165, 1165, 1166, 1161, 1166,
-     1166, 1167, 1173, 1167, 1161, 1167, 1167, 1161, 1161, 1161,
-
-     1174, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1175,
-     1161, 1161, 1161,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-     1169,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   53,  173, 1176, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161,  173, 1161,  173, 1161, 1170, 1161, 1170, 1170,
-     1170, 1161, 1161, 1177,   36,   36,   36,   36,   36,   36,
-
-       36, 1171, 1161, 1171, 1171, 1171, 1171, 1178, 1179, 1179,
-     1161, 1179, 1179, 1179, 1180, 1179, 1161,  217,  217,  217,
-      217,  217, 1161, 1161, 1161, 1164, 1164, 1165, 1165, 1166,
-     1166, 1173, 1173, 1173, 1173, 1161, 1167, 1167, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1181, 1161, 1161, 1161, 1161, 1161,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36, 1182,  131,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36, 1161,   36, 1161, 1161,   36,   36,   36,   36,   36,
-
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,  173,  173,
-     1161,  173, 1176, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-      185, 1161, 1161, 1170, 1170, 1170, 1161, 1177, 1177, 1177,
-     1177,   36,   36,   36,   36,   36,   36,   36, 1171, 1171,
-     1183, 1183, 1161, 1179, 1179, 1161, 1179, 1179, 1180, 1180,
-     1180, 1180, 1179, 1179,  217,  217, 1179,  217,  217,  217,
-      217, 1161, 1161, 1161, 1164, 1164, 1165, 1165, 1166, 1166,
-
-     1173, 1167, 1167, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1181, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36, 1161,
-       36,   36,   36,   36, 1161, 1161,   36,   36,   36,   36,
-       36,   36,   36,   36,   36, 1161, 1161,   36, 1161,   36,
-       36,   36,   36,   36, 1161,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161, 1161,   36,   36, 1161, 1161,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-     1161, 1161,   36,   36,   36,   36,   36,   36,  173,  173,
-      173, 1161, 1161, 1161, 1161, 1161, 1161, 1161,  185, 1161,
-     1161, 1170, 1170, 1170, 1161, 1177, 1177,   36,   36,   36,
-       36,   36,   36, 1161, 1171, 1171, 1171, 1183, 1183, 1161,
-     1179, 1179, 1180, 1180, 1179, 1179, 1179,  217,  217,  217,
-      217, 1161, 1184, 1161, 1164, 1185, 1165, 1186, 1187, 1188,
-     1189, 1190, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
-
-       36,   36,   36, 1161,   36,   36,   36, 1161,   36,   36,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36, 1161,
-     1161,   36,   36,   36, 1161, 1161,   36,   36,   36, 1161,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36,   36,   36, 1161,
-       36,   36,   36,   36,  173,  173,  173, 1161, 1161, 1161,
-     1161, 1161, 1161,  173, 1161, 1161, 1170, 1170, 1191, 1161,
-     1177, 1192, 1161, 1161,   36,   36, 1161,   36,   36, 1161,
-
-     1161, 1161, 1171, 1171, 1179, 1193, 1180, 1194, 1179, 1179,
-     1179, 1179,  217,  217, 1161,  217, 1195, 1161, 1161, 1196,
-     1197, 1198, 1199, 1161, 1200, 1201, 1202, 1203, 1203, 1161,
-     1161, 1161,   36, 1161,   36,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36, 1161, 1161,   36,
-       36, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-       36,   36,   36,   36,   36,   36,   36,   36, 1161, 1161,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
-
-       36, 1161,  802,  802, 1161, 1161, 1161, 1161,  802, 1204,
-     1205, 1204, 1206, 1207, 1207,   36,   36,   36,   36, 1208,
-     1208, 1209, 1210, 1211, 1212, 1212, 1161, 1210, 1161,  829,
-     1161, 1161, 1161, 1197, 1199, 1161, 1201, 1203, 1203, 1161,
-     1161,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-     1161, 1161,   36,   36,   36, 1161, 1161,   36, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161,   36,   36,   36,   36,   36,
-       36,   36,   36,   36, 1161, 1213,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
-       36,   36, 1161, 1161,   36, 1161,   36,   36, 1161, 1161,
-
-     1161, 1161, 1204, 1204, 1206,   36,   36, 1161,   36, 1208,
-     1208, 1210, 1211, 1210,  829,  829,   36,   36,   36,   36,
-       36,   36,   36, 1161, 1161, 1161,   36,   36, 1161,   36,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161,   36,   36,   36,
-       36,   36,   36,   36,   36, 1213, 1213, 1161, 1214, 1213,
-       36,   36,   36, 1161,   36,   36,   36,   36, 1161,   36,
-     1161,   36,   36, 1161, 1161, 1161, 1204, 1206,   36,   36,
-       36, 1208, 1208, 1211,   36,   36,   36,   36,   36, 1161,
-     1161,   36,   36, 1161,   36, 1161, 1161, 1161, 1161, 1161,
-     1161,   36,   36,   36,   36,   36,   36, 1161, 1214, 1214,
-
-     1213, 1214, 1214,   36, 1161,   36,   36, 1161,   36, 1161,
-       36,   36, 1161, 1161, 1161, 1204, 1206, 1206,   36,   36,
-     1208, 1208, 1211, 1211,   36,   36, 1161, 1161,   36,   36,
-     1161, 1161, 1161, 1161, 1161, 1161,   36,   36,   36,   36,
-     1161, 1213, 1161,   36, 1161, 1161,   36,   36, 1161, 1161,
-     1204, 1206, 1206,   36, 1208, 1208, 1211, 1211,   36, 1161,
-     1161,   36,   36, 1161, 1161, 1161,   36,   36,   36, 1161,
-     1213, 1161,   36, 1161, 1161, 1161, 1204, 1206, 1206,   36,
-     1208, 1208, 1211, 1211, 1161, 1161,   36,   36, 1161, 1161,
-       36, 1161, 1213, 1161,   36, 1161, 1161, 1204, 1206, 1208,
-
-     1208, 1211, 1161, 1161,   36,   36, 1161,   36, 1161, 1213,
-     1161,   36, 1161, 1204, 1206, 1208, 1208, 1161, 1211, 1161,
-     1161,   36, 1161, 1161, 1213, 1213, 1161,   36, 1161, 1204,
-     1208, 1161,   36, 1213, 1214, 1161,   36, 1161, 1204, 1208,
-     1161, 1161, 1204, 1208, 1204, 1208, 1204, 1208, 1204, 1208,
-     1204, 1208, 1204, 1161, 1208, 1208, 1208, 1208, 1208, 1161,
-        0, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161
-    } ;
-
-static yyconst flex_int16_t yy_nxt[9249] =
-    {   0,
-       14,   15,   16,   17,   18,   19,   14,   20,   21,   22,
-       23,   24,   25,   26,   25,   27,   25,   28,   29,   30,
-       30,   30,   30,   30,   30,   30,   30,   30,   30,   25,
-       31,   32,   33,   34,   35,   36,   37,   38,   39,   40,
-       41,   42,   43,   42,   42,   44,   45,   46,   47,   48,
-       42,   49,   50,   51,   42,   42,   52,   42,   42,   42,
-       25,   25,   42,   35,   36,   37,   38,   39,   40,   41,
-       42,   43,   42,   44,   45,   46,   47,   48,   42,   49,
-       50,   51,   42,   42,   52,   42,   42,   42,   14,   53,
-       54,   55,   56,   71,   67,   66,   67,   68,   76,   77,
-
-       78,  203, 1138,   74,   72,  211,  206,   57,   57,   57,
-       57,   57,   57,   57,   57,   57,   57,   75,   79,   77,
-       79,   79,   77,   79,   58,   59,   82,   73,   60,   85,
-       61,   69,   74,   78,   77,   80,   74,   74,   74, 1113,
-       83,   62,   63,  176,   89,   75,  211,   74,   99,  176,
-       75,   75,   75,   58,   59,   82,   73,   60,  224,   61,
-       69,   75,  115,   86,  203,   74,   74,   74,   83,   62,
-       63,   74,   98,   74,   74,   93,   74,   87,   75,   75,
-       75,   90,   94,   95,  109,   75,  224,   75,   75,   75,
-     1074,  115,   86,   74, 1008,   91,  110,  529,  223,  530,
-
-       74,  226,   74,   74,  531,   87,  530,   75,  227,  207,
-       90,   74,   96,   75,   74,   75,   75,   74,   74,   74,
-      115,  346,   74,   91,  387,   75,   97,  223,   75,  211,
-      226,   75,   75,   75,  142,   75,  227,  207,  115,  176,
-       74,   96,  161,   74,  968,  176,   74,   74,   74,  115,
-      346,  203,  112,   75,   97,  100,   75,  100,   74,   75,
-       75,   75,  142,   76,   77,   78,  410,  115,  204,  203,
-      204,  161,   75,  101,  101,  101,  101,  101,  101,  101,
-      101,  101,  101,   85,  115,  115,  370,   74,  102,  143,
-      115,  538,  103,   74,  104,  410,  144,  145,  188,  105,
-
-       75,  106,  107,  201,  146,  205,   89,   75,   79,   77,
-       79,  108,  228,  115,  115,  370,   89,  102,  143,  115,
-      538,  103,   74,  104,  144,  145,   85,  105,  546,  106,
-      107,  201,  146,   85,  205,   75,   78,   77,   78,  108,
-      113,  228,  114,  114,  114,  114,  114,  114,  114,  114,
-      114,  114,  115,  115,  387,  231,  129,  546,  116,  117,
-      130,  138,  118,  188,  139,  242,  131,  140,  119,  243,
-      132,  250,  229,  141,   89,  120,  121,  225,   77,  225,
-      211,  115,  115,  231,  531,  129,  530,  116,  117,  130,
-      138,  118,  139,  242,  131,  140,  119,  243,  132,  250,
-
-      229,  141,  251,  120,  121,  113,  230,  114,  114,  114,
-      114,  114,  114,  114,  114,  114,  114,  347,  124,  359,
-      115,  359,  122,  967,  211,  125,  147,  118,  211,  126,
-      251,  133,  127,  134,  148,  230,  135,  136,  150,  203,
-      149,  123,  128,  137,  188,  347,  151,  124,  573,  115,
-      348,  122,  152,  350,  125,  147,  118,  126,  153,  133,
-      127,  134,  157,  148,  135,  136,  168,  150,  149,  123,
-      128,  137,  115,  169,  188,  151,  158,  573,  348,  159,
-      152,  350,  160,  170,  207,  154,  153,  155,  244,  162,
-      387,  157,  156,  163,  675,  168,  676,  164,  576,  115,
-
-      604,  115,  169,  245,  158,  165,  171,  159,  166,  167,
-      160,  170,  207,  154,  678,  155,  172,  244,  162,  804,
-      156,  389,  163,   78,   77,   80,  164,  576,  115,  604,
-      677,  245,  676,  165,   93,  171,  166,  167,  183,  184,
-      185,   94,   95,  678,  172,  173,   77,  174,  175,  389,
-      188,  392,  677,  176,  676,  189,  186,  186,  186,  186,
-      186,  186,  186,  186,  186,  186,   79,   77,   79,   93,
-       79,   77,   79,   79,   77,   79,   94,   95,  115,  392,
-      177,  178,  208,   74,  179,  208,  180,  190,   89,  198,
-      248,  188,  142,  176,  233,  234,  233,  181,  182,  176,
-
-      249,  191,  235,  236,  224,  208,   89,  115,  208,  177,
-      178,  349,   74,  179,   85,  180,  190,  198,  836,  248,
-      142,  210,  211,  210,  203,  181,  182,  211,  249,  191,
-      192,  194,  224,  212,  208,   93,  176,  208,  387,  349,
-      356,  387,   94,   95,  110,  188,  193,  193,  193,  193,
-      193,  193,  193,  193,  193,  193,  197,  391,  195,  213,
-      129,  372,  373,  372,  130,  125,   74,  237,  356,  126,
-      131,  188,  196,  214,  132,  387,  378,  354,  115,  203,
-       75,  211,  128,  143,  972,  197,  391,  195,  213,  129,
-      144,  199,  168,  130,  125,   74,  237,  126,  131,  169,
-
-      196,  214,  132,  355,  378,  393,  354,  115,   75,  170,
-      128,  369,  143,  375,  376,  375,  200,  188,  144,  199,
-      794,  168,  394,   77,  394,  731,   89,  234,  169,  724,
-      373,  234,  355,  393,  401,  236,  554,  170,  401,  236,
-      369,  559,  560,  559,  200,  209,  210,  211,  210,  209,
-      209,  209,  215,  209,  209,  209,  209,  209,  209,  209,
-      209,  209,  216,  209,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  209,  209,  209,  209,  209,  195,
-      218,  218,  218,  218,  219,  218,  125,  218,  218,  218,
-      220,  218,  218,  196,  218,  218,  218,  218,  221,  218,
-
-      218,  218,  218,  222,  218,  209,  209,  218,  195,  218,
-      218,  218,  218,  219,  218,  125,  218,  218,  220,  218,
-      218,  196,  218,  218,  218,  218,  221,  218,  218,  218,
-      218,  222,  218,  209,   93,  239,  240,  246,  204,  203,
-      204,   94,   95,  395,  554,  396,  211,  802,  241,  803,
-      680,  110,  247,  111,  111,  111,  111,  111,  111,  111,
-      111,  111,  111,  587,  239,  240,  246,  375,  376,  375,
-      586,  395,  339,  396,  340,  205,  241,  258,  377,  680,
-      247,  387,  584,  238,  257,  257,  257,  257,  257,  257,
-      257,  257,  257,  257,  115,   85,  115,  261,  388,  115,
-
-      115,  115,  115,  268,  205,  115,  583,  377,  115,   89,
-     1161,  238,  100,  115,  100,  115,  115,   85,  259,  115,
-      387,  387,  115,  115,  341,  115,  261,  388,  115,  115,
-      115,  115,  268,  211,  115,  397,  419,  115,   89, 1161,
-      211,  115,  421,  115,  115,  102,  259,  115,  115,  103,
-      115,  104,  341,  115,  411,  390,  105,  450,  106,  107,
-      417,  400,  260,  397,  419,  234,  398,  115,  108,  294,
-      421,  294,  401,  236,  102,  373,  188,  115,  103,  295,
-      104,  399,  115,  390,  105,  450,  106,  107,  681,  400,
-      260,  420,  412,  418,  398,  115,  108,  253,  253,  253,
-
-      253,  253,  253,  253,  253,  253,  253,  115,  264,  399,
-      211,  416,  115,  115,  115,  254,  255,  681,  262,  115,
-      412,  418,  263,  415,   89,  265,  115,  115,  256,  414,
-      233,  234,  233,  115,  349,  258,  115,  264,  235,  236,
-      532,  115,  115,  115,  254,  255,  262,  115,  115,  266,
-      413,  263,  115,  265,  115,  115,  256,  344,  115,  387,
-      580,  115,  349,  115,  211,  533,  115,  534,  532,  188,
-      974,  345,  115,  535,  211,  265,  115,  115,  266,  115,
-      203,  115,  536,  115,  115,  188,  344,  115,  115,  580,
-      267,  537,  115,  533,  115,  534,  342,  269,  115,  345,
-
-      115,  535,  115,  265,  804,  115,  803,  542,  115,  115,
-      536,  188,  115,  115,  115,  342,   93,  115,  267,  537,
-       89,  270,  271,   94,   95,  269,  115,  272,  115,  115,
-      115,  273,  274,  387,  115,  115,  542,  115,  115,  292,
-      115,  292,  547,  115,  233,  234,  233,  275,  115,  270,
-      271,  115,  235,  236,  115,  272,  115,  682,  115,  402,
-      273,  274,   89,  115,  115,  387,  115,   85,  569,  115,
-      547,  380,  211,  380,  188,  275,  115,  203, 1161,  115,
-      211,   93,  115,  276,  188,  276,  682,  402,   94,   95,
-      203,  475,  188,  568,  387,  115,  569,  572,   70,  113,
-
-      115,  277,  277,  277,  277,  277,  277,  277,  277,  277,
-      277,  115,  203,  281,  115,  115,  115,   66,  282,  475,
-      115,  568,  280,   85,  115,  572,  544,  543,  555,  115,
-      115,  570,  562,  403,  115,  804,  278,  803,  279,  188,
-      115,  281,  115,  211,  115,  115,  115,  282,  115,  115,
-      280,  115, 1077,  115,  544,  543,  578,  555,  115,  570,
-      562,  403,  115,  284,  278,  115,  279,  115,  283,  115,
-      211,  115, 1100,  115,  115,  115,  115,  115,  115,  285,
-      115,  563,  115,  289,  288,  578,  286,  575,  115, 1161,
-      287,  284,  115,  115,  585,  115,  283,   85,  115, 1139,
-
-      115,  211,  115,  115,  115,  115,  640,  115,  285,  115,
-      563,  289,  288,  561,  286,  575,  115,  292,  287,  292,
-      115,  290,  585,  115,  115,   89,  294,  115,  294,  115,
-      203,  683,  115,  115,  640, 1161,  295,  291,  115,  387,
-      679,  561,  296,  115,  577,  564,  115, 1161,  188,  290,
-      115,  115,  466,  115,  466,  115,  115,  115,  115,  261,
-      683,  115,  115,  301,  115,  291, 1161,  571,  679,  293,
-      296,  115,  577,  564,  115,  579,  115, 1161,  115,  115,
-      115, 1161,  297,  467,  115,  115,  115,  697,  261,  697,
-     1140,  115,  301,  115,  298,  571,  299,  293,  688,  300,
-
-      115, 1161,  115,  579,  115,  115,  115,  115,  203,  115,
-      484,  297,  484,  691,  115,  303,  574,   77,  574,  115,
-      485,  115,  298,  302,  299,  115,  688,  300,  304,  115,
-      115,  115,  717,  115,  115,  203,  115,  115,  115, 1161,
-     1161,  691,  115,  303,  115,  305,  692,  115, 1161,  115,
-      306,  302,  115,  704,  115, 1161,  115,  304, 1161,  115,
-      188,  717,  115,  115,  115, 1161,  115,  115,  115,  115,
-     1161,  115,  115,  305,  692,  308,  307,  488,  306,  488,
-      115,  704,  115,  115,  115, 1161,  115,  489, 1161,  115,
-      310,  115,  115,  115,  115, 1150,  689,  115,  115,  521,
-
-      309,  521, 1161,  308,  307,  311,  752, 1161,  115,  522,
-      115,  115,  115,  239,  240,  115,  115,  115,  115,  310,
-      115,  115,   93,  115,  315,  689,  241, 1161,  309,   94,
-       95,  312,  115,  311,  752,  115,  115,  115,  559,  560,
-      559,  115,  239,  240, 1161,  115,  115,  753, 1161,  313,
-      115,  115,  314,  315,  241,  115,  318,  115, 1161,  312,
-      115,  115,  115,  115,  755,  316,  115,  556,  203,  556,
-      756,  317,  581,  211,  115,  753,  115,  313, 1161,  115,
-      314,  359,  115,  359,  115,  318,  115,  115,  319,  115,
-      320,  115,  755,  115,  316,  556,  203,  556,  756,  317,
-
-      581,  115,  115,  324,  115, 1161,  321,  322,  557,  188,
-      323,  115,  720,  115,  360,  211,  115,  319,  115,  320,
-      115,  203,  115,  705,  325,  115,  326,  211,  361,  115,
-     1161,  324,  115,  327,  321,  322,  557,  557,  323,  115,
-      115,  720,  115,  360,  387,  115,  815,  115,  815,  115,
-      759,  705,  325,  211,  115,  326,  361,  328,  687,  115,
-      115,  327,  708,  329,   93,  557,  808,  115,  115,  115,
-      703,   94,   95,   85,  115,  387,  707,  330,  759,  713,
-      265, 1161,  115,  115,  331,  328,  687,  115,  115,  706,
-      708,  697,  329,  697,  808,  332,  714,  115,  703,  851,
-
-      582, 1161,  115,  387,  707,  330,  722,  713,  265,  115,
-      115,   89,  115,  331,  115,  115, 1161,  115,  706,  335,
-      115, 1161,  333,  332,  715,  714,  334,  851,  115,  582,
-      115,  387,  115, 1161,  115,  722,  859,  115,  115, 1161,
-      336,  115, 1161,  115,  115,  337,  115,  725,  335,  115,
-      333,  115,  716,  715,  334, 1161,  115,  719,   77,  719,
-      115,  115,  115,  115,  859,   93,  115,  744,  115,  336,
-      115,  338,   94,   95,  337,  115,  725,   93,  754,  115,
-      760,  716,  115,  188,  729,  730, 1161, 1161,  115,  693,
-     1161,  693,  115,  342,  184,  351,  744,  115,  861,  694,
-
-      338,  727,  806,  635,  815,  635,  815,  754,  862,  760,
-      115,  352,  352,  352,  352,  352,  352,  352,  352,  352,
-      352,  353,  807,  810, 1161,  805,  861,  176,  387, 1161,
-      727,  806,  813,  608,  636,  608,  862,  352,  352,  352,
-      352,  352,  352,  352,  352,  352,  352,  353,  700,  827,
-      700,  807,  810,  176,  805,  804,  184,  809,  701, 1161,
-      203,  813,  702,  352,  352,  352,  352,  352,  352,  352,
-      352,  352,  352,  353,  748,  380,  211,  380,  827,  176,
-      826,  211,  826,  856,  826,  211,  826,  110,  749,  357,
-      357,  357,  357,  357,  357,  357,  357,  357,  357,  115,
-
-      820,  115,  115,  748,  115,  857,  115,  115,  381, 1161,
-      267,  757,  856,  270,  363,  188,  749,  362,  115,  272,
-      115,  364,  382,  832,   77,  832,  203,  758,  115,  820,
-      115,  115,  211,  115,  857,  115,  115,  381,  267,  115,
-      757,  270,  363, 1161,  115,  362,  115,  272,  115,  364,
-      382,  811,  702,  365,  702,  758,  115, 1161,  115,  115,
-      115,  115,  297,  368,  115,  115,  702,  860,  115,  863,
-     1161,  367,  824,  115,  298,  115,  299,  821,  115,  366,
-      811,  365,  864,  901, 1161,  115,  115, 1161,  115,  115,
-      115,  297,  368,  115,  115,  211,  860, 1161,  863,  367,
-
-     1161,  824,  298,  115,  299,  821,  115,  366, 1161, 1161,
-      864,  901,  383,  383,  383,  383,  383,  383,  383,  383,
-      383,  383,  374,  374,  211,  374,  374,  374,  374,  374,
-      374,  374,  374,  374,  374,  374,  374,  374,  374,  384,
-      374,  385,  385,  385,  385,  385,  385,  385,  385,  385,
-      385,  374,  374,  374,  374,  374,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  374,  374,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      374,  404, 1161,  404,  932,  865,  405,  405,  405,  405,
-      405,  405,  405,  405,  405,  405,  406, 1161,  406,  935,
-      899,  407,  407,  407,  407,  407,  407,  407,  407,  407,
-      407,  408,  932,  408,  865,  900,  409,  409,  409,  409,
-      409,  409,  409,  409,  409,  409,  423,  935,  423,  899,
-     1161,  424,  424,  424,  424,  424,  424,  424,  424,  424,
-      424,  425, 1161,  425,  900, 1161,  426,  426,  426,  426,
-      426,  426,  426,  426,  426,  426,  427,  902,  427,  432,
-      937,  428,  428,  428,  428,  428,  428,  428,  428,  428,
-
-      428,  257,  257,  257,  257,  257,  257,  257,  257,  257,
-      257, 1161,  115,  769,  115,  769,  902,  115,  937,  115,
-      429,  430,  430,  430,  430,  430,  430,  430,  430,  430,
-      430,  115,  433,  115,  115,  905,  908,  115,  908,  115,
-      431,  115,  115,  115,  770,  434,  115,   93,  115,  429,
-      908,  435,  908,  115,  839,  840,  115,  115,  211,  115,
-      433,  115,  115,  115,  905,  693,  115,  693,  115,  431,
-      436,  115, 1161,  434, 1161,  694,  115,  115,  115,  435,
-      115,  115,  115,  115,  115,  115,  115,  804,  439,  803,
-      437,  115, 1161, 1161,  822,  176,  115,  115,  436,  115,
-
-      438,  805,  924,  115,  115,  188,  115,  115,  115,  115,
-      115,  115,  115, 1161,  115,  115,  439, 1161,  437, 1161,
-      441,  440,  115,  822,  115,  115, 1161,  115,  438,  115,
-      805,  924,  115,  115, 1161,  115,  203,  115,  115,  115,
-      115,  115,  903, 1161,  115,  700,  115,  700,  441,  440,
-      115,  442,  115,  443,  445,  701,  444,  115,  115,  702,
-      115, 1161,  115,  115,  115,  446,   93,  115, 1161,  115,
-      115,  903,  911,   94,   95,  115, 1161,  115,  115,  442,
-      115,  443,  445,  115,  444,  115, 1161,  115,  115,  447,
-      115,   93,  115,  893,  446,  893,  448,  115,   94,   95,
-
-     1161,  911, 1161,  894,  115,  115, 1161,  115,  115,  451,
-      929,  115,  115,  115,  115,  449,  115,  447,  965,  115,
-      931,  804,  184,  809,  448,  115,  203,  115,  115,  176,
-      115,  453,  115,  115,  211,  452,  115,  115,  451,  929,
-      115,  466,  115,  466,  449,  115,  965,  115,  115,  931,
-      115,  933,  454,  115, 1161,  115,  934,  115,  115,  936,
-      453,  980,  115,  910,  452,  115, 1161,  115,  115, 1161,
-     1161,  913,  467,  115,  115,  115,  465,  115,  115,  115,
-      933,  454,  115,   93,  875,  934,  875,  115,  936,  980,
-       94,   95,  910,  115,  876,  115,  455,  115,  455,  115,
-
-      913,  959,  115,  115,  115,  465,  115,  964,  115,  239,
-      240,  115,   93,  966,  893,  115,  893,  468,  469,   94,
-       95,  115,  241, 1161,  894,  115, 1161,  456,  115,  115,
-      959,  203,  457,  115,  458,  115,  964,  459,  239,  240,
-      115,  460,  966, 1161,  461,  468,  469,  462,  463,  472,
-      241,  464,  115,  115,  115,  115,  470,  115,  115,  471,
-      115,  457,  989,  458,  991,  884,  459,  884,  115,  460,
-     1161,  115,  461, 1161,  115,  462,  463,  981,  472,  464,
-      973,  115,  115,  115,  115,  470,  115,  115,  471,  115,
-      115,  989,  474,  991,  473,  115,  115,  984,  115,  115,
-
-      986,  115,  115,  115,  896,  981,  896,  987,  973,  115,
-     1161,  115,  476,  954, 1161,  115,  115,  115,  988,  115,
-      115,  474,  473,  990,  115,  984,  477,  115,  986,  115,
-     1010,  115,  115, 1161,  115,  987,  115,  115,  115,  961,
-      476,  954,  478,  115,  115,  115,  988, 1161, 1005,  115,
-      115,  990, 1161, 1013,  477, 1161, 1161,  115,  479, 1010,
-      115,  115,  115, 1161, 1161,  115,  115,  115,  961, 1014,
-      478, 1027,  115,  998,  948,  998, 1005, 1015,  115,  203,
-      115,  480, 1013,  115,  115,  115,  479,  481,  115,  115,
-      115,  484,  483,  484,  488,  115,  488, 1014,  188, 1027,
-
-      482,  485,  115,  115,  489, 1017, 1015, 1018,  115,  480,
-     1161, 1161,  115,  115, 1035, 1021,  481,  115,  115, 1036,
-      115,  483,  203, 1028,  115,  115, 1031,  115,  482,  115,
-      115,  115,  115, 1016, 1017,  486, 1018, 1161,  490,  115,
-      492, 1032, 1035,  115, 1021,  487,  115, 1036,  491,  115,
-     1043, 1161, 1028,  115,  115, 1031,  115, 1161,  115, 1022,
-      115,  115, 1016,  486,  493,  115,  490,  115,  492, 1033,
-     1032,  115,  115,  487,  115, 1034,  491,  115, 1043,  115,
-      115,  115, 1045,  188,  495,  115,  115, 1161, 1022,  115,
-     1046,  494,  496,  493,  115, 1161, 1161,  115, 1033,  115,
-
-      115,  115,  115, 1050, 1034, 1161,  115,  115, 1161,  115,
-      115, 1045, 1049,  495,  115,  115,  115,  115, 1046,  494,
-      496,  497,  115, 1041,  948, 1041,  115,  115,  115, 1051,
-      498,  115, 1050,  115,  115, 1161,  115,  500,  115,  115,
-     1049,  499,  115,  852,  115,  852,  115, 1052, 1161,  497,
-     1161,  115,  115,  115,  115, 1161,  115, 1051,  498,  115,
-     1053, 1161,  115,  115,  115, 1061,  500,  115,  115, 1060,
-      499,  115,  501,  115,  115, 1161, 1052,  115,  925,  115,
-      115,  115,  115,  115,  115,  203, 1064,  502,  115, 1053,
-      503,  926, 1065,  115, 1061, 1161,  115, 1060,  504, 1066,
-
-      501,  115,  203,  115,  115,  211,  115,  925,  115,  115,
-      505,  115, 1161, 1161, 1064,  502, 1072, 1056,  503,  926,
-     1065,  115, 1076,  115,  115,  115,  504, 1066, 1161,  115,
-      115, 1161,  507,  115,  115, 1161,  506,  115,  115,  505,
-      508, 1057,  115, 1161,  115, 1072, 1056, 1055,  115, 1075,
-     1076,  115, 1161,  211,  115, 1079,  115,  509,  115,  115,
-      115,  507,  115,  115,  506,  115,  115,  115,  508,  115,
-     1057,  115,  115, 1078,  115, 1055,  115,  512, 1075,  115,
-      510,  115,  511, 1079,  115,  509, 1161, 1161,  115,  115,
-     1161,  115,  115, 1058,  115,  115,  115,  115,  115,  513,
-
-      115, 1161, 1078,  115, 1085,  515,  512,  115,  510,  115,
-      511,  115,  115, 1161,  115,  115,  115,  115,  115,  514,
-      115,  115, 1058,  115,  115,  516,  115, 1086,  513,  115,
-      211,  517, 1085,  515,  115, 1161,  203,  115,  115,  115,
-     1161,  115,  115,  115,  115,  115,  115,  115,  514,  115,
-      115,  211,  115,  521,  516,  521, 1086,  518, 1161,  517,
-      519,  115,  115,  522,  115,  115,  115,  115, 1070,  948,
-     1070, 1081,  115, 1161,  115, 1084, 1089, 1161,  520,  115,
-      115, 1090,  115,  203, 1083,  518,  115,  115,  519,  523,
-      115,  115,  115,  115, 1094,  115, 1161, 1096,  115,  524,
-
-     1081,  115,  115, 1084, 1089,  115,  520,  115,  115, 1097,
-     1090,  115,  115, 1083,  526,  115,  115, 1082,  523,  115,
-      115,  115,  115, 1094,  115, 1096, 1099,  115,  524,  115,
-     1161,  115,  525,  115, 1161, 1161,  115, 1097,  115,  115,
-      115, 1103,  526, 1161,  115,  115, 1082, 1111,  115,  115,
-      115, 1161,  211,  115, 1099, 1104,  527, 1107,  115,  211,
-      525,  947,  948,  947,  528, 1161,  115, 1161,  115,  949,
-     1103,  203,  950,  115,  115,  531, 1111,  539, 1161,  115,
-      947,  948,  947, 1104,  527, 1107,  115, 1023,  949, 1024,
-     1161,  950,  528,  540,  540,  540,  540,  540,  540,  540,
-
-      540,  540,  540,  541,  947,  948,  947, 1101, 1161,  176,
-     1161, 1102,  949, 1161,  188,  950, 1023, 1161, 1024,  540,
-      540,  540,  540,  540,  540,  540,  540,  540,  540,  541,
-     1000, 1001, 1000, 1161, 1161,  176, 1101,  188, 1002, 1102,
-     1161, 1003, 1092,  948, 1092,  540,  540,  540,  540,  540,
-      540,  540,  540,  540,  540,  541, 1109,  948, 1109, 1098,
-     1115,  176,  115,  115, 1161,  550,  548,  115,  115,  110,
-      115,  545,  545,  545,  545,  545,  545,  545,  545,  545,
-      545,  115,  549, 1114,  115,  115,  551, 1098, 1115, 1120,
-      115,  115,  115,  554,  550,  548,  115,  115, 1121,  115,
-
-     1161,  115, 1161, 1161,  115,  552,  115, 1161, 1161,  115,
-      549, 1114,  115, 1127,  115,  551, 1123, 1120,  482,  115,
-      115,  115, 1161,  115,  115,  553,  115, 1121,  115,  115,
-      115,  203,  115, 1161,  552,  115,  947,  948,  947, 1129,
-      115, 1127,  115,  115,  949, 1123,  482,  950,  115, 1161,
-      115,  203,  115,  115,  553,  115,  211,  115,  115, 1161,
-     1161, 1000, 1001, 1000, 1161, 1161, 1116, 1129,  115, 1002,
-      115,  115, 1003,  383,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  211, 1161, 1000, 1001, 1000, 1117, 1118,
-     1117, 1161,  565, 1002, 1132, 1116, 1003, 1131, 1136, 1161,
-
-      566,  566,  566,  566,  566,  566,  566,  566,  566,  566,
-      211, 1161, 1042, 1001, 1042, 1117, 1118, 1117, 1142,  567,
-      949,  565, 1132,  950, 1161, 1131, 1136,  383,  383,  383,
-      383,  383,  383,  383,  383,  383,  383,  405,  405,  405,
-      405,  405,  405,  405,  405,  405,  405, 1142,  567,  405,
-      405,  405,  405,  405,  405,  405,  405,  405,  405,  407,
-      407,  407,  407,  407,  407,  407,  407,  407,  407,  407,
-      407,  407,  407,  407,  407,  407,  407,  407,  407,  409,
-      409,  409,  409,  409,  409,  409,  409,  409,  409,  409,
-      409,  409,  409,  409,  409,  409,  409,  409,  409,  424,
-
-      424,  424,  424,  424,  424,  424,  424,  424,  424,  424,
-      424,  424,  424,  424,  424,  424,  424,  424,  424,  426,
-      426,  426,  426,  426,  426,  426,  426,  426,  426,  426,
-      426,  426,  426,  426,  426,  426,  426,  426,  426,  428,
-      428,  428,  428,  428,  428,  428,  428,  428,  428,  428,
-      428,  428,  428,  428,  428,  428,  428,  428,  428,  588,
-      211,  588, 1161, 1161,  589,  589,  589,  589,  589,  589,
-      589,  589,  589,  589,  430,  430,  430,  430,  430,  430,
-      430,  430,  430,  430, 1161,  115, 1161,  115, 1161,  590,
-      115,  590,  115,  429,  591,  591,  591,  591,  591,  591,
-
-      591,  591,  591,  591,  115,  592,  115,  115,  115,  593,
-      203, 1119,  115,  115,  115, 1161,  115, 1141,  188,  115,
-     1161,  115,  429, 1161,  115, 1161,  115,  115,  594,  115,
-      115, 1161,  115,  592,  115,  115,  115,  115,  593, 1119,
-     1161,  115,  115,  115, 1161, 1141,  115,  203,  595,  115,
-     1149,  115, 1161,  115,  115,  115, 1146,  594,  115,  115,
-     1161, 1161,  596, 1161,  115,  115,  188,  115,  115,  115,
-     1161,  115,  597,  115,  115,  115,  595,  115,  188, 1149,
-      115,  115, 1161,  598, 1146,  115,  203,  115,  115,  115,
-      115,  596, 1144,  115,  115,  188,  115,  115,  115,  203,
-
-      599,  597,  115,  115,  115,  115, 1161,  188,  115,  115,
-      115,  598, 1161,  600,  115,  115,  115, 1130,  115,  115,
-     1144,  115,  115,  115,  115,  601,  115,  115,  599, 1143,
-      115, 1157,  115,  602,  115,  115,  115, 1148, 1161,  115,
-      115,  115,  600,  603, 1145, 1130, 1124,  948, 1124,  115,
-      115,  115,  115, 1161,  601,  115,  115, 1143, 1151,  115,
-     1157,  602,  115, 1161,  115, 1148,  188,  115,  115,  115,
-      115,  603, 1145,  605,  115,  115,  203,  115,  606,  115,
-     1161,  115, 1161, 1161,  203,  608, 1151,  608, 1161,  115,
-     1161,  115,  607,  115, 1161, 1161,  115, 1161, 1161,  115,
-
-     1161,  605, 1147,  115,  115, 1161, 1161,  606,  115,  115,
-      115, 1153, 1154, 1153,  115,  115, 1161,  115,  115,  115,
-      607,  115, 1161,  115, 1161, 1155,  609, 1161,  619,  115,
-      620, 1147, 1161,  115, 1161, 1152, 1161,  115, 1161,  115,
-      610,  115, 1161,  115,  115,  115,  621,  115,  115, 1161,
-      115, 1161,  115, 1155,  203,  609,  619,  115,  620,  622,
-      115,  115,  115, 1152,  115,  115, 1161,  115,  610,  455,
-      115,  455, 1161, 1161,  115,  621, 1153, 1154, 1153,  115,
-     1161,  629, 1161, 1161,  115, 1161, 1161,  622,  115,  115,
-     1156,  115,  115, 1159, 1160, 1159,  115, 1159, 1160, 1159,
-
-      456,  623, 1161,  115, 1161,  611,  115,  612, 1161,  629,
-      613,  115,  203,  115,  614, 1161, 1161,  615,  115, 1156,
-      616,  617, 1161, 1161,  618,  115, 1161, 1161, 1161,  623,
-      626,  115, 1161, 1161,  611,  115,  612, 1161,  115,  613,
-      115, 1161,  614,  115, 1161,  615,  115, 1161,  616,  617,
-      624,  115,  618,  115,  115,  115, 1161,  637,  626,  115,
-      115,  627, 1161, 1158, 1161,  115,  625,  115, 1161, 1161,
-     1161, 1161,  115,  115,  115,  115,  628, 1161, 1161,  624,
-      115, 1161, 1161,  115,  115,  637, 1161, 1161,  115,  115,
-      627, 1158, 1161,  115,  625, 1161, 1161, 1161, 1161, 1161,
-
-     1161,  115,  115, 1161,  628,  630,  630,  630,  630,  630,
-      630,  630,  630,  630,  630,  630, 1161,  630,  630,  630,
-      630,  630,  631,  630,  632,  632,  632,  632,  632,  632,
-      632,  632,  632,  632,  630,  630,  630,  630,  630,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  633,  633,  630,  630,  633,  633,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  630,  115, 1161,  635,  638,  635,  115,
-
-     1161, 1161,  115,  115, 1000, 1001, 1000, 1161,  115, 1161,
-     1161,  634, 1002,  115, 1161, 1003,  115, 1161, 1161, 1161,
-     1161, 1161,  639,  115, 1161, 1161,  638,  636,  115,  115,
-      115,  115,  115, 1161,  115,  115, 1161,  115,  115,  634,
-     1161,  115, 1161,  115,  115, 1161,  641, 1161,  115,  115,
-      639, 1161, 1161, 1161, 1161, 1161, 1161,  115,  115,  115,
-      115, 1161, 1161,  115,  115,  115, 1161,  115,  115, 1161,
-     1161, 1161,  115,  115, 1161,  641,  115,  115, 1161,  115,
-      642, 1161, 1161, 1161, 1161,  115, 1161,  643, 1161,  115,
-      115, 1161, 1161, 1161,  115,  115, 1161,  115,  644,  115,
-
-     1161, 1161,  115, 1161,  115,  645, 1161,  115,  642,  115,
-     1161, 1161,  646, 1161, 1161,  643, 1161, 1161,  115,  115,
-     1161, 1000, 1001, 1000,  115, 1161, 1161,  644,  115, 1002,
-      115,  650, 1003,  115,  645,  115,  115,  115,  647,  115,
-      646,  648,  115, 1161,  115, 1161,  115,  115, 1161,  115,
-      115, 1161, 1161, 1161, 1161, 1161,  649, 1161,  115,  115,
-      650,  115, 1161, 1161,  115,  115, 1161,  647,  115,  115,
-      648,  115, 1161,  115,  115,  652,  115,  115,  115, 1161,
-      115, 1161, 1161,  651,  649, 1161,  115, 1161,  115,  115,
-     1161,  115, 1161, 1161,  115,  115,  115, 1161,  115, 1161,
-
-      115, 1161,  653,  115,  652, 1161,  654,  115, 1161,  115,
-      115,  651,  115, 1161,  115, 1161,  115, 1161,  115, 1161,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1161,  115,
-      653, 1161,  115, 1161,  654,  655,  115,  115,  115,  115,
-     1161,  115,  115,  115,  115, 1161,  115,  115,  115, 1161,
-      115, 1161,  115, 1161,  115,  115,  115, 1161,  115, 1161,
-     1161,  115,  115, 1161,  655,  115,  115, 1161,  115,  659,
-      115,  115,  115,  115,  115,  115, 1161,  115, 1161,  115,
-      656, 1161,  657, 1161,  115,  115,  115,  115, 1161,  115,
-      115,  658,  115,  115, 1161,  115,  661,  659,  115,  115,
-
-      115,  115, 1161, 1161,  115, 1161,  115, 1161,  656, 1161,
-      657, 1161,  660,  115, 1161,  115,  115,  115,  115,  115,
-      658,  115,  115,  115,  115,  661, 1161,  115, 1161,  664,
-      115, 1071,  948, 1071,  115,  662, 1161,  115,  115,  949,
-      660,  115,  950,  115, 1161, 1161,  115,  115,  115,  663,
-      115, 1161,  115,  115, 1161,  115, 1161,  115, 1161, 1161,
-      115, 1161,  115,  662, 1161,  115,  115, 1161, 1161,  115,
-      115, 1161, 1161, 1161,  665,  115,  115, 1161,  663,  115,
-     1161, 1161,  115, 1161,  115, 1161,  115,  115,  115,  115,
-      115,  115, 1161,  666,  115,  115, 1161,  115, 1161, 1161,
-
-     1161,  115,  665,  668,  115, 1161,  667, 1161,  115,  115,
-     1161,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,
-      115,  666,  115,  115,  115,  115, 1161,  115,  115,  115,
-      669,  668, 1161,  115,  667, 1161,  115,  115,  670,  115,
-     1161,  115, 1161, 1161, 1161,  115, 1161,  115, 1161,  115,
-      115,  115, 1161,  115,  115, 1161,  115,  115,  115,  669,
-     1161,  115,  115, 1161,  115,  115,  115,  115, 1161,  115,
-      115, 1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115,
-      115, 1161,  115, 1161,  115, 1161,  115,  115,  115, 1161,
-      115,  115,  115,  115,  115,  115, 1161, 1161, 1161,  115,
-
-      115, 1161,  671, 1161, 1161,  115, 1161,  115,  115,  115,
-     1161, 1161,  115,  672,  115,  115, 1161,  115,  115, 1161,
-      115,  115,  115,  115, 1161, 1161,  115, 1161,  115, 1161,
-      671, 1161, 1161,  115, 1161,  115, 1161,  115,  115, 1161,
-      115,  115,  672,  115,  115,  673,  115,  115,  674,  115,
-      115, 1161,  115, 1161, 1161,  115,  115, 1161, 1161, 1161,
-      115,  698, 1161,  115, 1161,  115,  115, 1161,  115, 1161,
-      115, 1161, 1161,  115,  673,  115, 1161,  674,  115,  677,
-      115,  684, 1161, 1161, 1161, 1093,  948, 1093,  115, 1161,
-      698,  115, 1161,  949, 1161,  115,  950,  685,  685,  685,
-
-      685,  685,  685,  685,  685,  685,  685,  686,  115, 1110,
-      948, 1110, 1161,  176, 1161, 1161, 1161,  949, 1161, 1161,
-      950, 1161, 1161,  685,  685,  685,  685,  685,  685,  685,
-      685,  685,  685,  686,  693, 1161,  693, 1161, 1161,  176,
-     1161, 1161, 1161, 1161,  694, 1161, 1161, 1161, 1161,  685,
-      685,  685,  685,  685,  685,  685,  685,  685,  685,  686,
-      697, 1161,  697, 1161, 1161,  176,  696,  115, 1161, 1161,
-      695,  115,  115,  110,  600,  690,  690,  690,  690,  690,
-      690,  690,  690,  690,  690,  115,  115, 1161, 1161, 1161,
-     1161, 1161, 1161,  115, 1161,  696,  115, 1161,  115,  695,
-
-      115,  115,  115,  600, 1161,  115, 1161,  115,  645,  732,
-      115, 1161,  115,  115,  115,  646, 1161, 1161,  700,  699,
-      700,  115,  115, 1161,  115, 1161, 1161,  115,  701, 1161,
-     1161,  115,  702, 1161,  115, 1161,  115,  645,  732,  115,
-      115,  211, 1161,  646, 1161, 1161, 1161,  699, 1161,  115,
-     1161,  115,  115,  709, 1161,  709,  115, 1161,  710,  710,
-      710,  710,  710,  710,  710,  710,  710,  710, 1161,  211,
-      115, 1126,  948, 1126, 1161, 1161, 1161, 1161, 1161,  949,
-      115, 1161,  950, 1161, 1161,  115,  566,  566,  566,  566,
-      566,  566,  566,  566,  566,  566,  211, 1161,  115, 1161,
-
-     1161,  947,  948,  947, 1161,  565, 1161, 1161,  711,  949,
-      711, 1161,  950,  712,  712,  712,  712,  712,  712,  712,
-      712,  712,  712,  589,  589,  589,  589,  589,  589,  589,
-      589,  589,  589, 1161,  565,  589,  589,  589,  589,  589,
-      589,  589,  589,  589,  589,  591,  591,  591,  591,  591,
-      591,  591,  591,  591,  591,  591,  591,  591,  591,  591,
-      591,  591,  591,  591,  591,  733, 1161, 1161,  115, 1161,
-      115, 1161, 1161,  115,  947,  948,  947, 1161, 1000, 1001,
-     1000, 1161,  949,  737,  115,  950, 1002,  115, 1161, 1003,
-     1161, 1161, 1161, 1161,  733, 1161, 1161,  115, 1161,  115,
-
-     1161, 1161,  115, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161,  737,  115,  718,  718,  115,  718,  718,  718,  718,
-      718,  718,  718,  718,  718,  718,  718,  718,  718,  718,
-      734,  718,  735,  735,  735,  735,  735,  735,  735,  735,
-      735,  735,  718,  718,  718,  718,  718,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-      736,  736,  736,  718,  718,  736,  736,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-
-      736,  718,  115,  115,  738,  115,  115,  115,  115,  115,
-      115,  115, 1161,  740,  115, 1161, 1161, 1161,  739,  741,
-     1161,  115,  115, 1161,  115,  115, 1161, 1161,  115, 1161,
-     1161,  115,  115,  738,  115,  115,  115,  115,  115,  115,
-      115, 1161,  740,  115, 1161, 1161,  739,  741, 1161,  115,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1161,  115,
-      115,  115,  115, 1161, 1161,  745,  115, 1161, 1161,  742,
-     1161, 1161, 1161,  115,  115,  743,  115, 1161, 1161, 1161,
-      115, 1161, 1161,  115,  115, 1161,  115,  115,  115,  115,
-      115,  115,  115, 1161,  745,  115, 1161,  742,  746, 1161,
-
-     1161,  115,  115,  743,  115, 1161,  115, 1161,  115,  115,
-      115, 1161, 1161,  115,  750,  115,  115,  747,  115, 1161,
-      751,  115, 1161, 1161, 1161, 1161,  746, 1161,  115,  115,
-     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
-      115,  115,  115,  750,  115, 1161,  747,  115, 1161,  751,
-     1161, 1161, 1161, 1161,  115,  115,  115,  115,  115, 1161,
-      115, 1161, 1161,  115,  115,  115, 1161, 1161, 1161,  115,
-      115,  761, 1161, 1161,  115,  115, 1161,  115,  762,  115,
-      115, 1161,  115,  115, 1161, 1161, 1161,  115,  763, 1161,
-     1161,  115,  115,  115,  115, 1161,  115, 1161, 1161,  761,
-
-     1161, 1161,  764,  115,  115,  115, 1161,  762,  115,  115,
-      115, 1161,  115,  765,  115, 1161,  763,  115,  768,  115,
-      115,  115,  115,  115, 1161,  115, 1161, 1161, 1161,  766,
-      764,  115, 1161,  115, 1161,  115, 1161,  115,  115,  767,
-      115,  115,  765,  115, 1161, 1161,  115,  768,  115, 1161,
-     1161, 1161,  115,  769,  115,  769, 1161,  766, 1161,  115,
-     1161,  115, 1161,  258,  115,  115, 1161, 1161,  767,  115,
-      257,  257,  257,  257,  257,  257,  257,  257,  257,  257,
-      115, 1161,  115,  115,  770,  115,  115,  115,  115,  115,
-     1161,  115,  115, 1161,  115, 1161, 1161, 1161, 1161,  115,
-
-      771, 1161,  115, 1161, 1161,  115,  115, 1161,  115,  115,
-     1161, 1161,  115, 1161,  115,  115,  115,  115,  115,  115,
-      115,  115, 1161,  115,  115, 1161, 1161,  115,  771, 1161,
-      115, 1161, 1161,  115,  115,  115,  115, 1161,  772,  115,
-      115,  774,  115,  773,  115,  775,  115,  115,  115, 1161,
-     1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115, 1161,
-     1161,  115,  115, 1161,  115,  115,  772,  115,  115,  115,
-      774,  115,  773,  115,  775,  115,  115, 1161, 1161,  776,
-      115,  115,  115,  115, 1161,  115,  115,  777,  115,  115,
-      115,  115,  115,  115,  780, 1161,  115,  115, 1161,  115,
-
-     1161, 1161,  115, 1161,  778,  779, 1161,  776, 1161,  115,
-     1161,  115,  115,  115,  115, 1161,  777,  115, 1161,  115,
-     1161,  115, 1161,  780, 1161, 1161,  115, 1161,  115,  115,
-      115,  781,  778,  779,  115,  115, 1161, 1161, 1161,  115,
-      115,  115, 1161, 1161, 1161, 1161,  782, 1161,  115, 1161,
-     1161, 1161, 1161, 1161,  115, 1161, 1161, 1161,  115, 1161,
-      781,  115, 1161,  115,  115,  115,  115,  783, 1161,  115,
-      115, 1161,  784,  115,  782, 1161,  115,  785,  115, 1161,
-      115, 1161,  115, 1161,  115, 1161, 1161, 1161, 1161, 1161,
-      115, 1161,  115, 1161,  115,  115,  783, 1161,  115,  115,
-
-      784, 1161,  115,  787, 1161,  115,  785,  115,  115,  115,
-      115, 1161,  115,  786,  115, 1161, 1161,  115, 1161, 1161,
-      115, 1161,  788, 1161,  115,  115, 1161,  115,  115,  789,
-      115, 1161,  787, 1161,  115, 1161,  115, 1161,  115,  115,
-     1161,  115,  786,  115,  115,  115, 1161, 1161,  115, 1161,
-      788, 1161,  115,  115,  115,  115,  115,  115,  789,  115,
-     1161,  790,  115, 1161, 1161,  115, 1161,  115,  115,  792,
-      115, 1161,  115,  115,  115, 1161,  115,  115, 1161, 1161,
-     1161, 1161,  115,  115, 1161, 1161,  115,  791,  115, 1161,
-      790,  115, 1161, 1161,  115,  115,  793,  115,  792,  115,
-
-      115,  115,  115,  115,  115,  115,  115, 1161, 1161, 1161,
-     1161, 1161, 1161,  115, 1161,  791,  115, 1161,  795,  115,
-      796, 1161, 1161,  115, 1161,  793,  115, 1161,  115,  115,
-      115,  115, 1161, 1161,  115,  115, 1161,  115, 1161,  797,
-      798,  115,  115, 1161, 1161,  115,  795,  115,  796,  115,
-     1161, 1161, 1161,  115,  115,  115,  115,  115,  115, 1161,
-      115, 1161,  115, 1161, 1161, 1161,  115,  797,  799,  798,
-     1161,  115,  801,  115,  115, 1161,  115,  800,  115,  115,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1161, 1161,
-     1161,  115, 1161,  115, 1161, 1161,  799, 1161, 1161,  115,
-
-      801, 1161, 1161,  115,  115,  800, 1161, 1161,  115,  115,
-     1161, 1161,  176, 1161,  115, 1161, 1161, 1161,  176,  115,
-     1161,  115, 1161,  816,  115, 1161,  110,  115,  111,  111,
-      111,  111,  111,  111,  111,  111,  111,  111,  115,  115,
-      115,  115, 1161, 1161,  115,  115,  819,  817,  115, 1161,
-     1161,  818,  816,  115, 1161, 1161, 1161, 1161,  115,  115,
-      115, 1161, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,
-      115, 1161,  211,  115,  115,  819,  817, 1161, 1161,  818,
-     1161, 1161,  211, 1161, 1161, 1161,  115,  115,  115,  710,
-      710,  710,  710,  710,  710,  710,  710,  710,  710,  710,
-
-      710,  710,  710,  710,  710,  710,  710,  710,  710,  211,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,  211,
-     1161, 1161, 1161, 1161, 1161, 1161,  712,  712,  712,  712,
-      712,  712,  712,  712,  712,  712,  712,  712,  712,  712,
-      712,  712,  712,  712,  712,  712,  823,  823,  211,  823,
-      823,  823,  823,  823,  823,  823,  823,  823,  823,  823,
-      823,  823,  823,  828,  823,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  823,  823,  823,  823,  823,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-
-      830,  830,  830,  830,  830,  830,  823,  823,  830,  830,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-      830,  830,  830,  830,  823,  832,   77,  832, 1161, 1161,
-      833,  833, 1161,  833, 1161, 1161, 1161,  833,  833, 1161,
-     1161,  833, 1161, 1161,  833,  833,  833,  833,  833,  833,
-      833,  833,  833,  831,  831, 1161,  831,  831,  831,  831,
-      831,  831,  831,  831,  831,  831,  831,  831,  831,  831,
-      841,  831,  842,  842,  842,  842,  842,  842,  842,  842,
-      842,  842,  831,  831,  831,  831,  831,  843,  843,  843,
-
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  843,  843,  831,  831,  843,  843,  843,  843,  843,
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  831,  115, 1161, 1161,  258, 1161,  115,  257,  257,
-      257,  257,  257,  257,  257,  257,  257,  257,  115,  845,
-     1161,  844,  115,  115,  115,  115, 1161,  115, 1161, 1161,
-      115,  115, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
-     1161,  115, 1161, 1161,  846,  115, 1161,  115,  845,  844,
-
-      115,  115,  115,  115,  115, 1161,  115,  115, 1161,  115,
-     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
-     1161, 1161,  846,  115,  115, 1161,  115, 1161, 1161,  115,
-      847, 1161, 1161, 1161, 1161, 1161,  115,  115,  848, 1161,
-     1161,  115,  115,  115, 1161,  849, 1161,  115,  115, 1161,
-      115,  115,  115, 1161,  115,  115,  115, 1161,  847,  850,
-     1161,  852,  115,  852, 1161,  115,  848, 1161, 1161,  115,
-      115, 1161,  115,  115,  849, 1161, 1161,  115,  115,  115,
-      115, 1161,  115, 1161,  115,  115,  855,  115,  850, 1161,
-      115, 1161,  115, 1161,  115, 1161,  853,  115,  115,  115,
-
-     1161,  115,  115, 1161, 1161, 1161, 1161,  115, 1161,  854,
-     1161,  115, 1161,  115,  115,  855,  115, 1161,  858,  115,
-      115, 1161, 1161,  115, 1161,  853,  115, 1161,  115,  115,
-     1161,  115, 1161,  115,  115, 1161,  866,  854, 1161,  115,
-     1161,  115, 1161,  115, 1161,  115,  867,  858,  115, 1161,
-     1161,  115, 1161,  115, 1161,  115,  115,  868, 1161, 1161,
-      115,  115, 1161,  115, 1161,  866, 1161, 1161,  115, 1161,
-      115,  115,  115,  115,  867,  869,  115,  115,  115, 1161,
-      115,  115,  871,  115, 1161,  115,  868, 1161, 1161,  870,
-      115,  115, 1161, 1161,  874, 1161, 1161,  115,  115,  115,
-
-      115,  115, 1161,  115,  869,  115,  115,  115,  115, 1161,
-      115,  871,  115,  115,  875,  115,  875,  870,  115,  115,
-      872,  873,  115,  874,  876,  115,  115, 1161,  115,  115,
-     1161,  115,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
-      877,  115, 1161, 1161,  115,  115,  115,  115,  872,  873,
-      115,  115,  115, 1161,  878,  115, 1161,  115,  115, 1161,
-      115, 1161,  879,  115, 1161,  115,  115,  115,  877,  115,
-     1161,  880,  115,  115,  115,  115,  115,  115, 1161, 1161,
-      115,  115, 1161,  878, 1161, 1161,  115,  115,  115, 1161,
-      115,  879,  115,  115,  115,  115,  115, 1161,  115,  115,
-
-      880,  115, 1161,  115,  115,  115, 1161,  881, 1161,  115,
-      115, 1161, 1161, 1161,  115,  115,  115,  882,  115,  115,
-     1161,  883,  115, 1161,  115, 1161, 1161,  115,  115,  115,
-     1161,  115, 1161,  115, 1161,  881,  115,  115, 1161,  115,
-     1161,  115,  115,  115,  115,  882,  115,  115,  115,  883,
-      115,  115, 1161,  884, 1161,  884,  115,  115, 1161, 1161,
-      115,  115,  115,  115, 1161,  115, 1161, 1161,  115,  115,
-     1161,  115,  115, 1161,  115, 1161,  115,  115,  115,  115,
-     1161,  886,  115,  888, 1161, 1161,  115, 1161,  115,  115,
-      115,  115,  115,  115,  115, 1161, 1161,  115,  887,  115,
-
-     1161,  885,  115,  115, 1161,  115, 1161, 1161,  115,  886,
-      115, 1161,  888,  889, 1161,  115, 1161,  115, 1161,  115,
-      115,  115, 1161,  115,  115, 1161,  887,  115,  115,  885,
-      115,  891,  115,  115, 1161, 1161,  890, 1161,  115,  115,
-     1161,  889, 1161, 1161,  115, 1161,  115, 1161,  115, 1161,
-     1161,  892, 1161,  115, 1161, 1161,  115, 1161,  115, 1161,
-      891,  115,  115, 1161,  890, 1161,  115,  115,  115, 1161,
-      115,  115, 1161,  115,  115,  115,  115, 1161,  895,  892,
-     1161,  115,  115, 1161, 1161, 1161,  115,  115, 1161,  115,
-      115,  115, 1161,  115, 1161,  896,  115,  896,  115,  115,
-
-      115,  115, 1161, 1161,  115,  115, 1161,  895, 1161,  115,
-     1161,  115,  115, 1161, 1161, 1161,  115,  115,  115,  115,
-      115, 1161,  115, 1161,  115,  115,  115,  115,  115,  115,
-      897,  906, 1161,  115, 1161, 1161, 1161, 1161,  898,  115,
-      115, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,  115,
-     1161,  115, 1161,  115,  115,  115,  115,  115, 1161,  897,
-      906, 1161,  115, 1161,  907, 1161,  898,  115, 1161,  908,
-      115,  908, 1161,  115,  258,  115,  802,   77,  804,  175,
-      115, 1161, 1161, 1161, 1161,  115, 1161, 1161, 1161, 1161,
-      909,  115,  907, 1161, 1161,  115,  115, 1161,  115, 1161,
-
-     1161, 1161,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
-      115,  177,  178, 1161, 1161,  179, 1161,  180, 1161,  909,
-      115,  115, 1161, 1161,  115,  115, 1161, 1161,  341,  182,
-     1161,  115, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
-      177,  178, 1161, 1161,  179, 1161,  180, 1161, 1161,  115,
-     1161, 1161, 1161, 1161, 1161, 1161,  341,  182,  912,  912,
-      211,  912,  912,  912,  912,  912,  912,  912,  912,  912,
-      912,  912,  912,  912,  912,  914,  912,  915,  915,  915,
-      915,  915,  915,  915,  915,  915,  915,  912,  912,  912,
-      912,  912,  916,  916,  916,  916,  916,  916,  916,  916,
-
-      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
-      916,  916,  916,  916,  916,  916,  916,  916,  912,  912,
-      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
-      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
-      916,  916,  916,  916,  916,  916,  912,  211,  257,  257,
-      257,  257,  257,  257,  257,  257,  257,  257, 1161, 1161,
-     1161, 1161, 1161, 1161,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  383,  374,  374,  211,  374,  374,  374,
-      374,  374,  374,  374,  374,  374,  374,  374,  374,  374,
-      374,  384,  374,  385,  385,  385,  385,  385,  385,  385,
-
-      385,  385,  385,  374,  374,  374,  374,  374,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  374,  374,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  374,  115, 1161,  917, 1161,  115,  115,  918,
-      115,  115,  115,  919,  115, 1161,  115, 1161,  920,  115,
-     1161, 1161,  115, 1161,  115, 1161,  115, 1161, 1161, 1161,
-      115, 1161,  115,  115,  917, 1161,  115,  115,  918,  115,
-
-      115,  115,  919,  115,  922,  115, 1161,  920,  115,  115,
-      115,  115,  115, 1161,  115,  921,  115, 1161,  115, 1161,
-      115,  115, 1161,  115, 1161,  115, 1161,  115, 1161, 1161,
-      115,  115,  115,  922,  923, 1161,  115, 1161,  115,  115,
-      115,  927, 1161, 1161,  921,  115,  115, 1161,  928,  115,
-      115,  115,  115, 1161,  115, 1161,  115,  115,  115, 1161,
-      115,  115,  923,  115, 1161,  115, 1161,  115,  115,  927,
-     1161,  115,  115, 1161,  115, 1161,  928,  115,  115, 1161,
-      930,  115,  115,  115, 1161, 1161,  115, 1161,  115, 1161,
-     1161,  938,  115, 1161,  939, 1161, 1161,  115, 1161,  115,
-
-     1161,  115,  115, 1161,  115, 1161,  115, 1161,  930,  115,
-      115, 1161,  115,  115, 1161,  941, 1161,  115,  115,  938,
-     1161,  940,  939,  115, 1161, 1161, 1161, 1161, 1161,  115,
-      115, 1161,  115,  115,  115,  115, 1161, 1161,  115, 1161,
-      115, 1161,  115,  942,  941, 1161, 1161,  115,  115,  940,
-     1161,  115, 1161, 1161,  115, 1161, 1161, 1161,  115, 1161,
-      115,  115, 1161,  115,  115,  943,  115, 1161,  115,  115,
-      115,  942,  944,  115, 1161,  115,  115, 1161, 1161, 1161,
-      115,  945,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
-      115,  115, 1161,  115,  943,  115,  115,  115,  115,  115,
-
-     1161,  944,  115, 1161,  115, 1161,  951, 1161,  115,  945,
-      952, 1161,  115,  115,  115,  115,  115,  115,  115,  115,
-      115,  115,  115, 1161, 1161,  115, 1161,  115, 1161, 1161,
-     1161, 1161,  115,  115,  951,  115,  115, 1161,  952, 1161,
-      115,  115,  115,  115,  953,  115, 1161,  115,  115, 1161,
-      115, 1161,  115,  115, 1161,  115, 1161,  115,  115,  115,
-      115,  115, 1161,  115,  115,  115, 1161, 1161, 1161, 1161,
-      115,  115,  956,  953, 1161, 1161,  955, 1161,  115,  115,
-     1161,  115,  115,  115,  115, 1161,  115,  115,  115, 1161,
-      115,  115, 1161,  115, 1161,  115,  115, 1161,  115,  115,
-
-      956,  957,  115, 1161,  955, 1161,  115,  115,  115,  115,
-      115,  115, 1161,  115, 1161,  958,  115, 1161, 1161,  115,
-      115,  115,  115,  962,  115,  115,  115,  115,  115,  957,
-      115,  115, 1161, 1161,  115, 1161,  115,  115,  115,  115,
-      115,  115,  115,  969,  958,  115, 1161, 1161,  115,  115,
-     1161,  115,  962,  115, 1161,  960,  115,  115,  115,  115,
-     1161, 1161,  115,  115,  115, 1161,  115,  963,  115,  115,
-      115,  115,  969, 1161, 1161, 1161, 1161,  115,  115, 1161,
-     1161,  115, 1161,  960,  970,  115, 1161, 1161,  115,  115,
-      115,  971, 1161,  115,  115,  115,  963, 1161, 1161, 1161,
-
-      115, 1161, 1161, 1161, 1161, 1161,  115,  211,  115, 1161,
-     1161, 1161,  970,  115, 1161, 1161,  115,  975,  115, 1161,
-      971,  115, 1161,  115,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  383, 1161,  115,  115,  115, 1161,  115,
-     1161, 1161,  115,  976,  115,  115,  975, 1161,  115, 1161,
-      115, 1161, 1161,  115, 1161, 1161,  115, 1161,  115, 1161,
-     1161, 1161, 1161,  115, 1161,  977,  115,  115,  115,  115,
-      115,  115,  976,  115,  115,  115, 1161,  115,  115, 1161,
-     1161, 1161,  115,  115,  115, 1161,  115, 1161,  115,  978,
-     1161,  979, 1161,  977, 1161,  115, 1161,  115,  115,  115,
-
-     1161,  115, 1161,  115,  115,  115,  115,  115, 1161,  983,
-      115, 1161,  115,  982, 1161, 1161,  115,  978, 1161,  979,
-      115,  115, 1161, 1161,  115,  115,  115,  115,  994,  992,
-      115,  985,  115,  115,  115,  115, 1161, 1161,  983,  115,
-      115,  982, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
-      115, 1161,  115, 1161, 1161,  115,  115,  994,  992,  115,
-      985,  115,  115,  993,  115,  115,  115, 1161,  115, 1161,
-      115,  115, 1161, 1161,  115,  115, 1161, 1161,  115, 1161,
-     1161, 1161,  115, 1161,  995,  115,  996,  115,  115, 1161,
-     1161,  115,  993,  115,  115,  115,  115, 1161, 1161,  115,
-
-      115,  115,  115, 1161,  997, 1161,  115,  115, 1161, 1161,
-      115,  115,  995,  115,  996, 1161,  115, 1161,  115, 1161,
-      115,  115,  115,  115, 1161,  115, 1161,  115, 1161,  115,
-     1161,  115,  997, 1161, 1161, 1161,  115,  115,  115,  115,
-     1161,  115, 1161,  115,  115, 1004, 1161,  115,  115,  115,
-     1161,  115,  115, 1006, 1161, 1161,  115, 1161,  115,  115,
-     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
-      115,  115,  115,  115, 1004,  115, 1161,  115,  115, 1161,
-     1161, 1006, 1161, 1161, 1161,  115,  115, 1007,  115,  115,
-      115, 1161,  115,  115, 1161,  115, 1009,  115, 1161,  115,
-
-      115, 1161, 1161,  115,  115, 1161,  115, 1161,  115,  115,
-     1161,  115, 1161,  115,  115, 1007, 1012,  115, 1161, 1161,
-     1161,  115,  115, 1161, 1161, 1009,  115, 1011,  115,  115,
-     1161, 1161,  115, 1161,  115,  115, 1161,  115,  115,  115,
-      115,  115, 1161,  115, 1012, 1020,  115, 1161,  115, 1019,
-      115, 1161,  115, 1161,  115, 1011,  115,  115,  115, 1161,
-      115,  115, 1161,  115,  115, 1161,  115, 1161,  115,  115,
-      115,  115, 1025,  115, 1020,  115,  115, 1019, 1161, 1161,
-      115,  115,  115, 1161,  115, 1161,  115,  115,  115,  115,
-      115, 1161, 1161,  115, 1161,  115, 1161,  115,  115,  115,
-
-     1025,  115,  115,  115,  115, 1026,  115, 1161,  115,  115,
-     1161, 1161,  115,  115, 1161,  115, 1161, 1161,  115, 1029,
-      115, 1161,  115,  115,  115, 1161, 1030,  115, 1161,  115,
-      115,  115, 1161,  115, 1026,  115, 1161, 1161,  115, 1161,
-      115,  115, 1161,  115,  115,  115,  115, 1029,  115,  115,
-      115,  115, 1161,  115, 1161, 1030, 1038, 1161,  115, 1037,
-      115,  115, 1161,  115,  115, 1161,  115,  115, 1161, 1161,
-      115,  115,  115,  115,  115,  115, 1161, 1161,  115,  115,
-      115, 1161, 1161, 1161, 1038, 1161, 1039, 1037,  115, 1161,
-      115,  115,  115,  115, 1161,  115,  115,  115,  115, 1040,
-
-      115,  115,  115, 1161,  115,  115, 1044, 1161,  115,  115,
-     1161, 1161,  115, 1161, 1039, 1161,  115, 1161, 1161,  115,
-      115, 1161,  115,  115, 1161,  115,  115,  115, 1040,  115,
-     1161,  115, 1161,  115,  115, 1044, 1161,  115,  115,  115,
-      115, 1047,  115, 1161,  115, 1161, 1161,  115, 1161,  115,
-     1161,  115, 1161,  115,  115, 1161,  115, 1048,  115, 1161,
-      115, 1161, 1161, 1161,  115,  115,  115,  115, 1161,  115,
-     1047,  115,  115, 1161, 1161, 1054,  115, 1161, 1161,  115,
-     1059,  115,  115,  115,  115,  115, 1048,  115, 1161,  115,
-      115, 1161, 1161,  115,  115,  115, 1161,  115,  115, 1161,
-
-      115, 1161,  115, 1054,  115,  115, 1161,  115, 1062, 1059,
-      115,  115, 1161, 1161,  115, 1161,  115, 1161, 1161,  115,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1063,  115,
-     1161,  115,  115, 1161, 1161, 1067, 1062, 1161, 1161,  115,
-     1161,  115, 1161,  115,  115, 1161, 1161,  115, 1161,  115,
-     1161,  115,  115,  115,  115, 1068,  115, 1063,  115,  115,
-     1161, 1161, 1161, 1067,  115, 1161,  115,  115,  115,  115,
-      115,  115, 1069,  115, 1073,  115,  115, 1161,  115, 1161,
-     1161,  115, 1161, 1161, 1068, 1161, 1161,  115,  115,  115,
-      115,  115, 1161,  115,  115,  115,  115,  115, 1161,  115,
-
-     1161, 1069,  115, 1073,  115, 1161,  115,  115, 1161,  115,
-     1080, 1161,  115, 1161, 1161,  115,  115,  115, 1161,  115,
-      115,  115, 1161,  115,  115,  115,  115, 1087,  115, 1161,
-     1161, 1161, 1161, 1161, 1088,  115,  115,  115, 1080,  115,
-     1161,  115,  115, 1161,  115,  115,  115, 1161,  115, 1161,
-      115,  115,  115,  115,  115, 1161, 1087,  115,  115, 1091,
-     1161, 1161, 1088,  115, 1161,  115, 1161,  115,  115,  115,
-      115,  115, 1095,  115,  115,  115,  115,  115, 1161, 1161,
-      115, 1161,  115, 1161, 1161, 1161,  115, 1091,  115, 1161,
-      115,  115, 1161,  115,  115,  115,  115, 1161,  115,  115,
-
-      115, 1095, 1106,  115, 1161,  115, 1161, 1161, 1161, 1161,
-      115, 1161, 1161,  115, 1105, 1161,  115,  115,  115, 1161,
-      115, 1108,  115,  115,  115,  115, 1161, 1161,  115,  115,
-     1161, 1106, 1161, 1161, 1161, 1161,  115, 1161,  115, 1161,
-      115,  115, 1105,  115, 1112,  115,  115,  115, 1161,  115,
-     1108,  115,  115,  115,  115, 1161, 1161, 1161,  115,  115,
-     1161, 1122, 1161, 1161,  115, 1161,  115, 1161,  115,  115,
-     1161,  115, 1112, 1161,  115, 1161,  115, 1161,  115, 1161,
-     1161,  115, 1161,  115, 1161, 1161, 1161,  115, 1161, 1122,
-     1161, 1161, 1161, 1161,  115, 1161,  115, 1124,  948, 1124,
-
-     1161, 1161, 1125, 1125, 1161, 1125, 1161, 1161, 1161, 1125,
-     1125, 1161, 1161, 1125, 1161, 1161, 1125, 1125, 1125, 1125,
-     1125, 1125, 1125, 1125, 1125,  115,  115, 1161, 1161, 1161,
-      115,  115, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1133,
-     1161, 1161, 1128, 1161,  115,  115, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161,  115,  115, 1161, 1161, 1161,  115,
-      115, 1161, 1161, 1161, 1161, 1161, 1161, 1133, 1161, 1161,
-     1128, 1161,  115,  115,  947,  948,  947, 1161, 1161, 1134,
-     1134, 1161, 1135, 1161,  115,  950, 1134, 1134, 1137,  115,
-     1134, 1161, 1161, 1134, 1134, 1134, 1134, 1134, 1134, 1134,
-
-     1134, 1134, 1161,  115,  115,  115, 1161, 1161, 1161,  115,
-      115, 1161, 1161,  115, 1161, 1161, 1161, 1137,  115, 1161,
-     1161, 1161, 1161,  115,  115, 1161, 1161, 1161, 1161, 1161,
-     1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115,  115,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161,  115,  115,   64,   64,   64,   64,   64,   64,   64,
-       64,   64,   64,   64,   64,   65,   65,   65,   65,   65,
-       65,   65,   65,   65,   65,   65,   65,   81,   81, 1161,
-       81,   81,   81,   81,   81,   81,   81,   81,   81,   84,
-       84, 1161,   84,   84,   84,   84,   84,   84,   84,   84,
-
-       84,   88,   88,   88,   88,   88,   88,   88,   88,   88,
-       88,   88,   88,   92,   92,   92,   92,   92,   92,   92,
-       92,   92,   92,   92,   92,  111,  111,  115,  115,  115,
-      115,  115,  115,  115,  115,  187,  187,  187,  187,  187,
-      187,  187,  187,  187,  187,  187,  187,  202,  202,  202,
-      202,  202,  202,  202,  202,  202,  202,  202,  202,  209,
-      209,  209,  209,  209,  209, 1161,  209,  209,  209, 1161,
-      209,  232,  232,  232,  232,  232,  232,  232,  232,  232,
-      232,  232,  232,  101, 1161, 1161,  101,  252,  252,  252,
-     1161, 1161,  252, 1161,  252,  252, 1161,  252,  252,  343,
-
-      343,  343,  343,  343,  343,  343,  343,  343,  343,  343,
-      343,  358,  358, 1161,  358,  358,  358,  358,  358,  358,
-      358,  358,  358,  371,  371,  371,  371,  371,  371, 1161,
-      371,  371,  371, 1161,  371,  374,  374,  374,  374,  374,
-      374,  374,  374,  374,  374,  374,  374,  379,  379,  379,
-      379,  379,  379,  379,  379,  379,  379,  379,  379,  422,
-     1161, 1161,  422,  276, 1161, 1161, 1161,  276, 1161, 1161,
-     1161, 1161, 1161,  276,  558,  558,  558,  558,  558,  558,
-      558,  558,  558,  558,  558,  558,  718,  718, 1161,  718,
-      718,  718,  718,  718,  718,  718,  718,  718,  721,  721,
-
-     1161,  721,  721,  721,  721,  721,  721,  721,  721,  721,
-      723,  723, 1161,  723,  723,  723,  723,  723,  723,  723,
-      723,  723,   88,   88,   88,   88,   88,   88,   88,   88,
-       88,   88,   88,   88,  726,  726,  726,  726,  726,  726,
-      726,  726,  726,  726,  726,  726,   92,   92,   92,   92,
-       92,   92,   92,   92,   92,   92,   92,   92,  728,  728,
-      728,  728,  728,  728,  728,  728,  728,  728,  728,  728,
-      812,  812,  812,  812,  812,  812,  812,  812,  812,  812,
-      812,  812,  814,  814, 1161,  814,  814,  814,  814,  814,
-      814,  814,  814,  814,  823,  823,  823,  823,  823,  823,
-
-      823,  823,  823,  823,  823,  823,  825,  825,  825,  825,
-      825,  825,  825,  825,  825,  825,  825,  825,  831,  831,
-     1161,  831,  831,  831,  831,  831,  831,  831,  831,  831,
-      834,  834, 1161,  834,  834,  834,  834,  834,  834,  834,
-      834,  834,   81,   81, 1161,   81,   81,   81,   81,   81,
-       81,   81,   81,   81,  835,  835, 1161,  835,  835,  835,
-      835,  835,  835,  835,  835,  835,   84,   84, 1161,   84,
-       84,   84,   84,   84,   84,   84,   84,   84,  837,  837,
-      837,  837,  837,  837,  837,  837,  837,  837,  837,  837,
-       88,   88,   88,   88,   88,   88,   88,   88,   88,   88,
-
-       88,   88,  838,  838,  838,  838,  838,  838,  838,  838,
-      838,  838,  838,  838,   92,   92,   92,   92,   92,   92,
-       92,   92,   92,   92,   92,   92,  187,  187,  187,  187,
-      187,  187,  187,  187,  187,  187,  187,  187,  904,  904,
-      904,  904,  904,  904,  904,  904,  904,  904,  904,  904,
-      358,  358, 1161,  358,  358,  358,  358,  358,  358,  358,
-      358,  358,  814,  814, 1161,  814,  814,  814,  814,  814,
-      814,  814,  814,  814,  202,  202,  202,  202,  202,  202,
-      202,  202,  202,  202,  202,  202,  912,  912,  912,  912,
-      912,  912,  912,  912,  912,  912,  912,  912,  374,  374,
-
-      374,  374,  374,  374,  374,  374,  374,  374,  374,  374,
-      379,  379,  379,  379,  379,  379,  379,  379,  379,  379,
-      379,  379,  825,  825,  825,  825,  825,  825,  825,  825,
-      825,  825,  825,  825,  946,  946,  946,  946,  946,  946,
-      946,  946,  946,  946,  946,  946,  999,  999,  999,  999,
-      999,  999,  999,  999,  999,  999,  999,  999,   13, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161
-    } ;
-
-static yyconst flex_int16_t yy_chk[9249] =
-    {   0,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    2,
-        2,    2,    2,   10,    8,    8,    8,    8,   15,   15,
-
-       15,   68, 1129,   14,   10, 1119,   68,    2,    2,    2,
-        2,    2,    2,    2,    2,    2,    2,   14,   16,   16,
-       16,   54,   54,   54,    2,    2,   18,   10,    2,   19,
-        2,    8,   14,   17,   17,   17,   15,   20,   21, 1096,
-       18,    2,    2,  176,   22,   14, 1084,   25,   26,  176,
-       15,   20,   21,    2,    2,   18,   10,    2,   75,    2,
-        8,   25,   42,   19,   69,   15,   20,   21,   18,    2,
-        2,   17,   24,   27,   26,   23,   25,   19,   15,   20,
-       21,   22,   23,   23,   29,   17,   75,   27,   26,   25,
-     1045,   42,   19,   24,  959,   22,   30,  339,   74,  339,
-
-       17,   82,   27,   26,  340,   19,  340,   24,   83,   69,
-       22,   29,   23,   17,   31,   27,   26,   32,   30,   34,
-       41,  178,   24,   22,  916,   29,   23,   74,   31,  912,
-       82,   32,   30,   34,   41,   24,   83,   69,   49,  685,
-       29,   23,   49,   31,  905,  685,   32,   30,   34,   41,
-      178,  207,   33,   29,   23,   28,   31,   28,   33,   32,
-       30,   34,   41,   76,   76,   76,  242,   49,   67,   67,
-       67,   49,   33,   28,   28,   28,   28,   28,   28,   28,
-       28,   28,   28,   86,   43,   63,  207,   33,   28,   43,
-       44,  350,   28,   28,   28,  242,   43,   43,  904,   28,
-
-       33,   28,   28,   63,   44,   67,   91,   28,   77,   77,
-       77,   28,   86,   43,   63,  207,  837,   28,   43,   44,
-      350,   28,   28,   28,   43,   43,   87,   28,  360,   28,
-       28,   63,   44,  835,   67,   28,   78,   78,   78,   28,
-       35,   86,   35,   35,   35,   35,   35,   35,   35,   35,
-       35,   35,   38,   40,  830,   91,   38,  360,   35,   35,
-       38,   40,   35,  903,   40,  102,   38,   40,   35,  103,
-       38,  107,   87,   40,   90,   35,   35,   79,   79,   79,
-      825,   38,   40,   91,  342,   38,  342,   35,   35,   38,
-       40,   35,   40,  102,   38,   40,   35,  103,   38,  107,
-
-       87,   40,  108,   35,   35,   36,   90,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,  179,   37,  359,
-       39,  359,   36,  903,  823,   37,   45,   36,  822,   37,
-      108,   39,   37,   39,   45,   90,   39,   39,   46,  205,
-       45,   36,   37,   39,  812,  179,   46,   37,  393,   39,
-      180,   36,   46,  182,   37,   45,   36,   37,   46,   39,
-       37,   39,   48,   45,   39,   39,   51,   46,   45,   36,
-       37,   39,   47,   51,  811,   46,   48,  393,  180,   48,
-       46,  182,   48,   51,  205,   47,   46,   47,  104,   50,
-      220,   48,   47,   50,  529,   51,  529,   50,  396,   52,
-
-      450,   47,   51,  104,   48,   50,   52,   48,   50,   50,
-       48,   51,  205,   47,  532,   47,   52,  104,   50,  804,
-       47,  220,   50,   80,   80,   80,   50,  396,   52,  450,
-      530,  104,  530,   50,   92,   52,   50,   50,   55,   55,
-       55,   92,   92,  532,   52,   53,   53,   53,   53,  220,
-       56,  223,  531,   53,  531,   56,   55,   55,   55,   55,
-       55,   55,   55,   55,   55,   55,  184,  184,  184,   94,
-       70,   70,   70,   71,   71,   71,   94,   94,   60,  223,
-       53,   53,   70,   53,   53,   71,   53,   56,  726,   60,
-      106,  191,   60,  686,   93,   93,   93,   53,   53,  686,
-
-      106,   56,   93,   93,  181,   70,  725,   60,   71,   53,
-       53,  181,   53,   53,  723,   53,   56,   60,  722,  106,
-       60,   72,   72,   72,  910,   53,   53,  214,  106,   56,
-       57,   58,  181,   72,   70,   96,   57,   71,  222,  181,
-      191,  716,   96,   96,   57,  189,   57,   57,   57,   57,
-       57,   57,   57,   57,   57,   57,   59,  222,   58,   72,
-       59,  208,  208,  208,   59,   58,   57,   96,  191,   58,
-       59,  190,   58,   72,   59,  714,  214,  189,   61,  206,
-       57,  706,   58,   61,  910,   59,  222,   58,   72,   59,
-       61,   61,   62,   59,   58,   57,   96,   58,   59,   62,
-
-       58,   72,   59,  190,  214,  224,  189,   61,   57,   62,
-       58,  206,   61,  210,  210,  210,   62,  689,   61,   61,
-      664,   62,  225,  225,  225,  585,  580,  232,   62,  578,
-      558,  235,  190,  224,  232,  232,  554,   62,  235,  235,
-      206,  372,  372,  372,   62,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   97,  101,  101,  105,  204,  204,
-      204,   97,   97,  226,  538,  227,  213,  675,  101,  675,
-      534,  111,  105,  111,  111,  111,  111,  111,  111,  111,
-      111,  111,  111,  421,  101,  101,  105,  375,  375,  375,
-      419,  226,  173,  227,  173,  204,  101,  114,  213,  534,
-      105,  219,  412,   97,  113,  113,  113,  113,  113,  113,
-      113,  113,  113,  113,  114,  228,  115,  118,  219,  114,
-
-      116,  115,  118,  125,  204,  116,  410,  213,  125,  231,
-      173,   97,  100,  114,  100,  115,  118,  229,  116,  116,
-      386,  221,  125,  114,  173,  115,  118,  219,  114,  116,
-      115,  118,  125,  379,  116,  228,  249,  125,  230,  173,
-      374,  114,  251,  115,  118,  100,  116,  116,  117,  100,
-      125,  100,  173,  117,  243,  221,  100,  276,  100,  100,
-      248,  231,  117,  228,  249,  401,  229,  117,  100,  294,
-      251,  294,  401,  401,  100,  371,  343,  117,  100,  294,
-      100,  230,  117,  221,  100,  276,  100,  100,  535,  231,
-      117,  250,  243,  248,  229,  117,  100,  110,  110,  110,
-
-      110,  110,  110,  110,  110,  110,  110,  119,  121,  230,
-      913,  247,  119,  121,  120,  110,  110,  535,  119,  120,
-      243,  248,  120,  246,  400,  121,  119,  121,  110,  245,
-      233,  233,  233,  120,  341,  277,  119,  121,  233,  233,
-      344,  119,  121,  120,  110,  110,  119,  122,  120,  122,
-      244,  120,  122,  121,  119,  121,  110,  177,  123,  218,
-      400,  120,  341,  123,  212,  345,  122,  346,  344,  354,
-      913,  177,  277,  347,  209,  123,  122,  123,  122,  124,
-      202,  122,  348,  126,  124,  187,  177,  123,  126,  400,
-      124,  349,  123,  345,  122,  346,  183,  126,  124,  177,
-
-      277,  347,  126,  123,  676,  123,  676,  354,  124,  127,
-      348,  175,  126,  124,  127,  174,  237,  126,  124,  349,
-       89,  127,  127,  237,  237,  126,  124,  127,  127,  128,
-      126,  128,  129,  389,  128,  130,  354,  129,  127,  292,
-      130,  292,  361,  127,  234,  234,  234,  130,  128,  127,
-      127,  129,  234,  234,  130,  127,  127,  536,  128,  237,
-      128,  129,   88,  128,  130,  388,  129,   84,  389,  130,
-      361,  380,  380,  380,  356,  130,  128,   65,   13,  129,
-      378,  238,  130,  131,  355,  131,  536,  237,  238,  238,
-      369,  292, 1051,  388,  390,  133,  389,  392,    9,  131,
-
-      133,  131,  131,  131,  131,  131,  131,  131,  131,  131,
-      131,  132, 1081,  133,  133,  134,  132,    7,  134,  292,
-      134,  388,  132,  398,  133,  392,  356,  355,  369,  133,
-      132,  390,  378,  238,  134,  677,  131,  677,  131, 1130,
-      132,  133,  133,  381,  134,  132,  136,  134,  135,  134,
-      132,  136, 1051,  135,  356,  355,  398,  369,  132,  390,
-      378,  238,  134,  136,  131,  136,  131,  135,  135,  139,
-      377,  137, 1081,  138,  139,  136,  137,  135,  138,  137,
-      136,  381,  135,  139,  138,  398,  137,  395,  139,    0,
-      137,  136,  138,  136,  418,  135,  135,  397,  139, 1130,
-
-      137,  382,  138,  139,  140,  137,  475,  138,  137,  140,
-      381,  139,  138,  377,  137,  395,  139,  142,  137,  142,
-      138,  140,  418,  140,  141,  399,  143,  144,  143,  141,
-     1131,  537,  144,  140,  475,    0,  143,  141,  140,  391,
-      533,  377,  144,  141,  397,  382,  144,    0,  543,  140,
-      142,  140,  466,  141,  466,  142,  144,  146,  141,  143,
-      537,  144,  146,  146,  143,  141,    0,  391,  533,  142,
-      144,  141,  397,  382,  144,  399,  146,    0,  143,  142,
-      145,    0,  145,  466,  142,  145,  146,  680,  143,  680,
-     1131,  146,  146,  143,  145,  391,  145,  142,  543,  145,
-
-      147,    0,  148,  399,  146,  147,  143,  148,  557,  145,
-      484,  145,  484,  546,  145,  148,  394,  394,  394,  147,
-      484,  148,  145,  147,  145,  149,  543,  145,  149,  147,
-      149,  148,  572,  150,  147, 1148,  148,  151,  150,    0,
-        0,  546,  151,  148,  149,  150,  547,  147,    0,  148,
-      151,  147,  150,  557,  149,    0,  151,  149,    0,  149,
-      544,  572,  150,  152,  153,    0,  151,  150,  152,  153,
-        0,  151,  149,  150,  547,  153,  152,  488,  151,  488,
-      150,  557,  152,  153,  151,    0,  155,  488,    0,  154,
-      155,  155,  152,  153,  154, 1148,  544,  152,  153,  521,
-
-      154,  521,    0,  153,  152,  155,  611,    0,  154,  521,
-      152,  153,  156,  253,  253,  155,  158,  156,  154,  155,
-      155,  158,  402,  154,  158,  544,  253,    0,  154,  402,
-      402,  156,  157,  155,  611,  158,  154,  157,  559,  559,
-      559,  156,  253,  253,    0,  158,  156,  612,    0,  157,
-      158,  157,  157,  158,  253,  160,  160,  159,    0,  156,
-      160,  157,  159,  158,  614,  159,  157,  370,  370,  370,
-      615,  159,  402,  561,  160,  612,  159,  157,    0,  157,
-      157,  194,  162,  194,  160,  160,  159,  162,  161,  160,
-      161,  159,  614,  161,  159,  556,  556,  556,  615,  159,
-
-      402,  162,  160,  162,  159,    0,  161,  161,  370,  542,
-      161,  162,  575,  163,  194,  564,  162,  161,  163,  161,
-      164,  555,  161,  561,  163,  164,  164,  563,  194,  162,
-        0,  162,  163,  164,  161,  161,  556,  370,  161,  164,
-      165,  575,  163,  194,  568,  165,  692,  163,  692,  164,
-      617,  561,  163,  562,  164,  164,  194,  165,  542,  165,
-      163,  164,  564,  166,  403,  556,  682,  164,  166,  165,
-      555,  403,  403,  577,  165,  569,  563,  166,  617,  568,
-      166,    0,  166,  167,  167,  165,  542,  165,  167,  562,
-      564,  697,  166,  697,  682,  167,  569,  166,  555,  744,
-
-      403,    0,  167,  570,  563,  166,  577,  568,  166,  168,
-      166,  579,  167,  167,  168,  169,    0,  167,  562,  169,
-      169,    0,  168,  167,  570,  569,  168,  744,  168,  403,
-      167,  571,  170,    0,  169,  577,  753,  170,  168,    0,
-      170,  171,    0,  168,  169,  171,  171,  579,  169,  169,
-      168,  170,  571,  570,  168,    0,  168,  574,  574,  574,
-      171,  170,  169,  172,  753,  581,  170,  604,  172,  170,
-      171,  172,  581,  581,  171,  171,  579,  582,  613,  170,
-      618,  571,  172,  687,  582,  582,    0,    0,  171,  678,
-        0,  678,  172,  185,  185,  185,  604,  172,  756,  678,
-
-      172,  581,  679,  635,  815,  635,  815,  613,  757,  618,
-      172,  185,  185,  185,  185,  185,  185,  185,  185,  185,
-      185,  186,  681,  687,    0,  678,  756,  186,  713,    0,
-      581,  679,  691,  608,  635,  608,  757,  186,  186,  186,
-      186,  186,  186,  186,  186,  186,  186,  192,  683,  713,
-      683,  681,  687,  192,  678,  684,  684,  684,  683,    0,
-      703,  691,  683,  192,  192,  192,  192,  192,  192,  192,
-      192,  192,  192,  193,  608,  215,  215,  215,  713,  193,
-      708,  708,  708,  748,  826,  826,  826,  193,  608,  193,
-      193,  193,  193,  193,  193,  193,  193,  193,  193,  195,
-
-      703,  196,  197,  608,  195,  749,  196,  197,  215,    0,
-      195,  616,  748,  196,  196,  688,  608,  195,  195,  196,
-      196,  197,  215,  832,  832,  832,  704,  616,  195,  703,
-      196,  197,  707,  195,  749,  196,  197,  215,  195,  198,
-      616,  196,  196,    0,  198,  195,  195,  196,  196,  197,
-      215,  688,  702,  198,  702,  616,  200,    0,  198,  201,
-      199,  200,  199,  201,  201,  199,  702,  755,  198,  758,
-        0,  200,  707,  198,  199,  200,  199,  704,  201,  199,
-      688,  198,  759,  807,    0,  200,  198,    0,  201,  199,
-      200,  199,  201,  201,  199,  216,  755,    0,  758,  200,
-
-        0,  707,  199,  200,  199,  704,  201,  199,    0,    0,
-      759,  807,  216,  216,  216,  216,  216,  216,  216,  216,
-      216,  216,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  239,    0,  239,  860,  760,  239,  239,  239,  239,
-      239,  239,  239,  239,  239,  239,  240,    0,  240,  863,
-      805,  240,  240,  240,  240,  240,  240,  240,  240,  240,
-      240,  241,  860,  241,  760,  806,  241,  241,  241,  241,
-      241,  241,  241,  241,  241,  241,  254,  863,  254,  805,
-        0,  254,  254,  254,  254,  254,  254,  254,  254,  254,
-      254,  255,    0,  255,  806,    0,  255,  255,  255,  255,
-      255,  255,  255,  255,  255,  255,  256,  808,  256,  259,
-      865,  256,  256,  256,  256,  256,  256,  256,  256,  256,
-
-      256,  257,  257,  257,  257,  257,  257,  257,  257,  257,
-      257,    0,  259,  769,  260,  769,  808,  259,  865,  260,
-      257,  258,  258,  258,  258,  258,  258,  258,  258,  258,
-      258,  259,  260,  260,  261,  813,  901,  262,  901,  261,
-      258,  259,  262,  260,  769,  261,  259,  727,  260,  257,
-      908,  262,  908,  261,  727,  727,  262,  263,  705,  259,
-      260,  260,  263,  261,  813,  693,  262,  693,  261,  258,
-      263,  262,    0,  261,    0,  693,  263,  264,  266,  262,
-      265,  261,  264,  266,  262,  265,  263,  803,  266,  803,
-      264,  263,    0,    0,  705,  803,  264,  266,  263,  265,
-
-      265,  693,  851,  268,  263,  810,  264,  266,  268,  265,
-      267,  264,  266,    0,  265,  267,  266,    0,  264,    0,
-      268,  267,  268,  705,  264,  266,    0,  265,  265,  267,
-      693,  851,  268,  269,    0,  271,  821,  268,  269,  267,
-      271,  270,  810,    0,  267,  700,  270,  700,  268,  267,
-      268,  269,  269,  270,  271,  700,  270,  267,  272,  700,
-      270,    0,  269,  272,  271,  272,  728,  269,    0,  271,
-      270,  810,  821,  728,  728,  270,    0,  272,  273,  269,
-      269,  270,  271,  273,  270,  274,    0,  272,  270,  273,
-      274,  729,  272,  794,  272,  794,  274,  273,  729,  729,
-
-        0,  821,    0,  794,  274,  272,    0,  273,  278,  278,
-      857,  275,  273,  278,  274,  275,  275,  273,  900,  274,
-      859,  809,  809,  809,  274,  273,  820,  278,  279,  809,
-      275,  280,  274,  279,  824,  279,  280,  278,  278,  857,
-      275,  284,  278,  284,  275,  275,  900,  279,  281,  859,
-      280,  861,  281,  281,    0,  278,  862,  279,  275,  864,
-      280,  925,  279,  820,  279,  280,    0,  281,  283,    0,
-        0,  824,  284,  283,  284,  279,  283,  281,  280,  284,
-      861,  281,  281,  838,  875,  862,  875,  283,  864,  925,
-      838,  838,  820,  284,  875,  281,  282,  283,  282,  285,
-
-      824,  894,  283,  284,  285,  283,  286,  899,  284,  422,
-      422,  286,  839,  902,  893,  283,  893,  285,  285,  839,
-      839,  284,  422,    0,  893,  286,    0,  282,  285,  282,
-      894,  911,  282,  285,  282,  286,  899,  282,  422,  422,
-      286,  282,  902,    0,  282,  285,  285,  282,  282,  289,
-      422,  282,  287,  286,  289,  288,  287,  287,  282,  288,
-      288,  282,  934,  282,  937,  884,  282,  884,  289,  282,
-        0,  287,  282,    0,  288,  282,  282,  926,  289,  282,
-      911,  287,  290,  289,  288,  287,  287,  290,  288,  288,
-      291,  934,  291,  937,  290,  291,  289,  929,  293,  287,
-
-      931,  290,  288,  293,  896,  926,  896,  932,  911,  291,
-        0,  290,  293,  884,    0,  296,  290,  293,  933,  291,
-      296,  291,  290,  935,  291,  929,  296,  293,  931,  290,
-      961,  297,  293,    0,  296,  932,  297,  291,  298,  896,
-      293,  884,  297,  298,  296,  293,  933,    0,  954,  296,
-      297,  935,    0,  964,  296,    0,    0,  298,  298,  961,
-      297,  299,  296,    0,    0,  297,  299,  298,  896,  965,
-      297,  980,  298,  948,  948,  948,  954,  966,  297,  972,
-      299,  299,  964,  300,  301,  298,  298,  300,  300,  301,
-      299,  302,  301,  302,  303,  299,  303,  965,  967,  980,
-
-      300,  302,  300,  301,  303,  968,  966,  968,  299,  299,
-        0,    0,  300,  301,  989,  972,  300,  300,  301,  990,
-      304,  301,  973,  981,  302,  304,  984,  303,  300,  302,
-      300,  301,  303,  967,  968,  302,  968,    0,  303,  304,
-      304,  986,  989,  302,  972,  302,  303,  990,  303,  304,
-     1005,    0,  981,  302,  304,  984,  303,    0,  302,  973,
-      305,  303,  967,  302,  305,  305,  303,  304,  304,  987,
-      986,  302,  306,  302,  303,  988,  303,  306, 1005,  305,
-      307,  308, 1008, 1016,  307,  307,  308,    0,  973,  305,
-     1010,  306,  308,  305,  305,    0,    0,  309,  987,  307,
-
-      308,  306,  309, 1015,  988,    0,  306,  305,    0,  307,
-      308, 1008, 1013,  307,  307,  308,  309,  310, 1010,  306,
-      308,  309,  310,  998,  998,  998,  309,  307,  308, 1016,
-      310,  309, 1015,  311,  312,    0,  310,  313,  311,  312,
-     1013,  311,  313,  852,  309,  852,  310, 1017,    0,  309,
-        0,  310,  311,  312,  314,    0,  313, 1016,  310,  314,
-     1018,    0,  311,  312,  310, 1028,  313,  311,  312, 1027,
-      311,  313,  314,  314,  315,    0, 1017,  316,  852,  315,
-      311,  312,  316,  314,  313, 1022, 1032,  315,  314, 1018,
-      316,  852, 1034,  315, 1028,    0,  316, 1027,  316, 1036,
-
-      314,  314, 1021,  315,  317, 1023,  316,  852,  315,  317,
-      317,  316,    0,    0, 1032,  315, 1043, 1022,  316,  852,
-     1034,  315, 1049,  317,  316,  318,  316, 1036,    0,  319,
-      318,    0,  319,  317,  319,    0,  318,  320,  317,  317,
-      319, 1023,  320,    0,  318, 1043, 1022, 1021,  319, 1046,
-     1049,  317,    0, 1024,  318, 1053,  320,  320,  319,  318,
-      321,  319,  322,  319,  318,  321,  320,  322,  319,  323,
-     1023,  320,  318, 1052,  323, 1021,  319,  323, 1046,  321,
-      321,  322,  322, 1053,  320,  320,    0,    0,  323,  321,
-        0,  322,  326, 1024,  321,  324,  322,  326,  323,  324,
-
-      324,    0, 1052,  323, 1060,  326,  323,  321,  321,  322,
-      322,  326,  328,    0,  324,  325,  323,  328,  327,  325,
-      325,  326, 1024,  327,  324,  327,  326, 1061,  324,  324,
-     1058,  328, 1060,  326,  325,    0, 1055,  327,  329,  326,
-        0,  328,  324,  329,  325,  330,  328,  327,  325,  325,
-      330, 1057,  327,  332,  327,  332, 1061,  329,    0,  328,
-      330,  331,  325,  332,  330,  327,  331,  329, 1041, 1041,
-     1041, 1055,  329,    0,  330, 1058, 1064,    0,  331,  330,
-      331, 1066,  333, 1056, 1057,  329,  332,  333,  330,  333,
-      331,  332,  330,  334, 1072,  331,    0, 1074,  334,  334,
-
-     1055,  333,  336, 1058, 1064,  332,  331,  336,  331, 1076,
-     1066,  333,  334, 1057,  336,  332,  333, 1056,  333,  335,
-      332,  336,  334, 1072,  335, 1074, 1078,  334,  334,  333,
-        0,  336,  335,  332,    0,    0,  336, 1076,  335,  337,
-      334, 1085,  336,    0,  337,  338, 1056, 1094,  335,  336,
-      338,    0,  974,  335, 1078, 1086,  337, 1090,  337, 1083,
-      335,  876,  876,  876,  338,    0,  335,    0,  337,  876,
-     1085, 1082,  876,  337,  338,  351, 1094,  351,    0,  338,
-      946,  946,  946, 1086,  337, 1090,  337,  974,  946,  974,
-        0,  946,  338,  351,  351,  351,  351,  351,  351,  351,
-
-      351,  351,  351,  352,  947,  947,  947, 1082,    0,  352,
-        0, 1083,  947,    0, 1077,  947,  974,    0,  974,  352,
-      352,  352,  352,  352,  352,  352,  352,  352,  352,  353,
-      949,  949,  949,    0,    0,  353, 1082, 1098,  949, 1083,
-        0,  949, 1070, 1070, 1070,  353,  353,  353,  353,  353,
-      353,  353,  353,  353,  353,  357, 1092, 1092, 1092, 1077,
-     1099,  357,  362,  363,    0,  364,  362,  362,  363,  357,
-      364,  357,  357,  357,  357,  357,  357,  357,  357,  357,
-      357,  362,  363, 1098,  364,  365,  365, 1077, 1099, 1103,
-      365,  362,  363,  368,  364,  362,  362,  363, 1104,  364,
-
-        0,  366,    0,    0,  365,  366,  366,    0,    0,  362,
-      363, 1098,  364, 1111,  365,  365, 1107, 1103,  366,  365,
-      366,  367,    0,  433,  368,  367,  367, 1104,  433,  368,
-      366, 1100,  365,    0,  366,  366,  950,  950,  950, 1113,
-      367, 1111,  433,  368,  950, 1107,  366,  950,  366,    0,
-      367, 1116,  433,  368,  367,  367,  383,  433,  368,    0,
-        0,  999,  999,  999,    0,    0, 1100, 1113,  367,  999,
-      433,  368,  999,  383,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  384,    0, 1000, 1000, 1000, 1101, 1101,
-     1101,    0,  383, 1000, 1121, 1100, 1000, 1116, 1127,    0,
-
-      384,  384,  384,  384,  384,  384,  384,  384,  384,  384,
-      387,    0, 1001, 1001, 1001, 1117, 1117, 1117, 1136,  384,
-     1001,  383, 1121, 1001,    0, 1116, 1127,  387,  387,  387,
-      387,  387,  387,  387,  387,  387,  387,  404,  404,  404,
-      404,  404,  404,  404,  404,  404,  404, 1136,  384,  405,
-      405,  405,  405,  405,  405,  405,  405,  405,  405,  406,
-      406,  406,  406,  406,  406,  406,  406,  406,  406,  407,
-      407,  407,  407,  407,  407,  407,  407,  407,  407,  408,
-      408,  408,  408,  408,  408,  408,  408,  408,  408,  409,
-      409,  409,  409,  409,  409,  409,  409,  409,  409,  423,
-
-      423,  423,  423,  423,  423,  423,  423,  423,  423,  424,
-      424,  424,  424,  424,  424,  424,  424,  424,  424,  425,
-      425,  425,  425,  425,  425,  425,  425,  425,  425,  426,
-      426,  426,  426,  426,  426,  426,  426,  426,  426,  427,
-      427,  427,  427,  427,  427,  427,  427,  427,  427,  428,
-      428,  428,  428,  428,  428,  428,  428,  428,  428,  429,
-     1102,  429,    0,    0,  429,  429,  429,  429,  429,  429,
-      429,  429,  429,  429,  430,  430,  430,  430,  430,  430,
-      430,  430,  430,  430,    0,  436,    0,  434,    0,  431,
-      436,  431,  434,  430,  431,  431,  431,  431,  431,  431,
-
-      431,  431,  431,  431,  436,  434,  434,  435,  437,  435,
-     1144, 1102,  435,  437,  436,    0,  434, 1132, 1147,  436,
-        0,  434,  430,    0,  438,    0,  435,  437,  438,  438,
-      439,    0,  436,  434,  434,  439,  435,  437,  435, 1102,
-        0,  435,  437,  438,    0, 1132,  440, 1140,  439,  439,
-     1147,  440,    0,  438,  435,  437, 1144,  438,  438,  439,
-        0,    0,  441,    0,  439,  440, 1114,  441,  442,  443,
-        0,  438,  442,  442,  443,  440,  439,  439, 1139, 1147,
-      440,  441,    0,  443, 1144,  446, 1146,  442,  443,  444,
-      446,  441, 1140,  440,  444, 1143,  441,  442,  443, 1156,
-
-      444,  442,  442,  443,  446,  445,    0, 1149,  444,  441,
-      445,  443,    0,  445,  446,  442,  443, 1114,  444,  446,
-     1140,  447,  448,  444,  445,  447,  447,  448,  444, 1139,
-      449, 1156,  446,  448,  445,  449,  444, 1146,    0,  445,
-      447,  448,  445,  449, 1143, 1114, 1124, 1124, 1124,  449,
-      447,  448,  445,    0,  447,  447,  448, 1139, 1149,  449,
-     1156,  448,  451,    0,  449, 1146, 1145,  451,  447,  448,
-      452,  449, 1143,  451,  453,  452, 1152,  449,  452,  453,
-        0,  451,    0,    0, 1150,  454, 1149,  454,    0,  452,
-        0,  451,  453,  453,    0,    0,  451,    0,    0,  452,
-
-        0,  451, 1145,  453,  452,    0,    0,  452,  453,  451,
-      458, 1151, 1151, 1151,  457,  458,    0,  452,  454,  457,
-      453,  453,    0,  454,    0, 1152,  454,    0,  457,  458,
-      458, 1145,    0,  457,    0, 1150,    0,  454,    0,  458,
-      454,  459,    0,  457,  458,  460,  459,  454,  457,    0,
-      460,    0,  454, 1152, 1155,  454,  457,  458,  458,  460,
-      459,  457,  468, 1150,  460,  454,    0,  468,  454,  455,
-      459,  455,    0,    0,  460,  459, 1153, 1153, 1153,  460,
-        0,  468,    0,    0,  461,    0,    0,  460,  459,  461,
-     1155,  468,  460, 1158, 1158, 1158,  468, 1159, 1159, 1159,
-
-      455,  461,    0,  461,    0,  455,  463,  455,    0,  468,
-      455,  463, 1157,  461,  455,    0,    0,  455,  461, 1155,
-      455,  455,    0,    0,  455,  463,    0,    0,    0,  461,
-      463,  461,    0,    0,  455,  463,  455,    0,  472,  455,
-      463,    0,  455,  472,    0,  455,  462,    0,  455,  455,
-      462,  462,  455,  463,  464,  465,    0,  472,  463,  464,
-      465,  464,    0, 1157,    0,  462,  462,  472,    0,    0,
-        0,    0,  472,  464,  465,  462,  465,    0,    0,  462,
-      462,    0,    0,  464,  465,  472,    0,    0,  464,  465,
-      464, 1157,    0,  462,  462,    0,    0,    0,    0,    0,
-
-        0,  464,  465,    0,  465,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,    0,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  470,    0,  471,  473,  471,  470,
-
-        0,    0,  473,  474, 1002, 1002, 1002,    0,  474,    0,
-        0,  470, 1002,  470,    0, 1002,  473,    0,    0,    0,
-        0,    0,  474,  470,    0,    0,  473,  471,  470,  471,
-      476,  473,  474,    0,  471,  476,    0,  474,  477,  470,
-        0,  470,    0,  477,  473,    0,  477,    0,  471,  476,
-      474,    0,    0,    0,    0,    0,    0,  477,  471,  476,
-      478,    0,    0,  471,  476,  478,    0,  477,  479,    0,
-        0,    0,  477,  479,    0,  477,  471,  476,    0,  478,
-      478,    0,    0,    0,    0,  477,    0,  479,    0,  478,
-      480,    0,    0,    0,  478,  480,    0,  479,  480,  481,
-
-        0,    0,  479,    0,  481,  481,    0,  478,  478,  480,
-        0,    0,  481,    0,    0,  479,    0,    0,  481,  480,
-        0, 1003, 1003, 1003,  480,    0,    0,  480,  481, 1003,
-      482,  487, 1003,  481,  481,  482,  487,  480,  482,  483,
-      481,  483,  486,    0,  483,    0,  481,  486,    0,  482,
-      487,    0,    0,    0,    0,    0,  486,    0,  483,  482,
-      487,  486,    0,    0,  482,  487,    0,  482,  483,  490,
-      483,  486,    0,  483,  490,  491,  486,  482,  487,    0,
-      491,    0,    0,  490,  486,    0,  483,    0,  490,  486,
-        0,  492,    0,    0,  491,  493,  492,    0,  490,    0,
-
-      493,    0,  492,  490,  491,    0,  493,  494,    0,  491,
-      492,  490,  494,    0,  493,    0,  490,    0,  495,    0,
-      492,    0,  491,  495,  493,  492,  494,  496,    0,  493,
-      492,    0,  496,    0,  493,  496,  494,  495,  492,  497,
-        0,  494,  493,  498,  497,    0,  496,  495,  498,    0,
-      502,    0,  495,    0,  494,  502,  496,    0,  497,    0,
-        0,  496,  498,    0,  496,  495,  499,    0,  497,  502,
-      500,  499,  498,  497,  496,  500,    0,  498,    0,  502,
-      499,    0,  500,    0,  502,  499,  497,  501,    0,  500,
-      498,  501,  501,  503,    0,  499,  504,  502,  503,  500,
-
-      499,  504,    0,    0,  500,    0,  501,    0,  499,    0,
-      500,    0,  503,  499,    0,  504,  501,  500,  505,  507,
-      501,  501,  503,  505,  507,  504,    0,  503,    0,  508,
-      504, 1042, 1042, 1042,  501,  505,    0,  505,  507, 1042,
-      503,  506, 1042,  504,    0,    0,  506,  505,  507,  506,
-      508,    0,  505,  507,    0,  508,    0,  509,    0,    0,
-      506,    0,  509,  505,    0,  505,  507,    0,    0,  508,
-      506,    0,    0,    0,  509,  506,  509,    0,  506,  508,
-        0,    0,  510,    0,  508,    0,  509,  510,  506,  511,
-      512,  509,    0,  510,  511,  512,    0,  508,    0,    0,
-
-        0,  510,  509,  512,  509,    0,  511,    0,  511,  512,
-        0,  510,    0,    0,    0,    0,  510,    0,  511,  512,
-      513,  510,  515,  511,  512,  513,    0,  515,  514,  510,
-      514,  512,    0,  514,  511,    0,  511,  512,  517,  513,
-        0,  515,    0,    0,    0,  516,    0,  514,    0,  513,
-      516,  515,    0,  518,  513,    0,  515,  514,  518,  514,
-        0,  517,  514,    0,  516,  519,  517,  513,    0,  515,
-      519,    0,  518,    0,  516,  514,    0,    0,    0,  516,
-      517,    0,  518,    0,  519,    0,  523,  518,  520,    0,
-      517,  523,  516,  520,  519,  517,    0,    0,    0,  519,
-
-      518,    0,  520,    0,    0,  523,    0,  520,  517,  524,
-        0,    0,  519,  524,  524,  523,    0,  520,  525,    0,
-      523,  526,  520,  525,    0,    0,  526,    0,  524,    0,
-      520,    0,    0,  523,    0,  520,    0,  525,  524,    0,
-      526,  527,  524,  524,  528,  527,  527,  525,  528,  528,
-      526,    0,  525,    0,    0,  526,  524,    0,    0,    0,
-      527,  551,    0,  528,    0,  525,  551,    0,  526,    0,
-      527,    0,    0,  528,  527,  527,    0,  528,  528,  539,
-      551,  539,    0,    0,    0, 1071, 1071, 1071,  527,    0,
-      551,  528,    0, 1071,    0,  551, 1071,  539,  539,  539,
-
-      539,  539,  539,  539,  539,  539,  539,  540,  551, 1093,
-     1093, 1093,    0,  540,    0,    0,    0, 1093,    0,    0,
-     1093,    0,    0,  540,  540,  540,  540,  540,  540,  540,
-      540,  540,  540,  541,  548,    0,  548,    0,    0,  541,
-        0,    0,    0,    0,  548,    0,    0,    0,    0,  541,
-      541,  541,  541,  541,  541,  541,  541,  541,  541,  545,
-      550,    0,  550,    0,    0,  545,  549,  548,    0,    0,
-      548,  549,  548,  545,  549,  545,  545,  545,  545,  545,
-      545,  545,  545,  545,  545,  549,  548,    0,    0,    0,
-        0,    0,    0,  550,    0,  549,  548,    0,  550,  548,
-
-      549,  548,  552,  549,    0,  592,    0,  552,  552,  592,
-      592,    0,  550,  549,  548,  552,    0,    0,  553,  552,
-      553,  552,  550,    0,  592,    0,    0,  550,  553,    0,
-        0,  552,  553,    0,  592,    0,  552,  552,  592,  592,
-      550,  565,    0,  552,    0,    0,    0,  552,    0,  552,
-        0,  553,  592,  565,    0,  565,  553,    0,  565,  565,
-      565,  565,  565,  565,  565,  565,  565,  565,    0,  566,
-      553, 1110, 1110, 1110,    0,    0,    0,    0,    0, 1110,
-      553,    0, 1110,    0,    0,  553,  566,  566,  566,  566,
-      566,  566,  566,  566,  566,  566,  567,    0,  553,    0,
-
-        0, 1125, 1125, 1125,    0,  566,    0,    0,  567, 1125,
-      567,    0, 1125,  567,  567,  567,  567,  567,  567,  567,
-      567,  567,  567,  588,  588,  588,  588,  588,  588,  588,
-      588,  588,  588,    0,  566,  589,  589,  589,  589,  589,
-      589,  589,  589,  589,  589,  590,  590,  590,  590,  590,
-      590,  590,  590,  590,  590,  591,  591,  591,  591,  591,
-      591,  591,  591,  591,  591,  593,    0,    0,  595,    0,
-      593,    0,    0,  595, 1134, 1134, 1134,    0, 1135, 1135,
-     1135,    0, 1134,  595,  593, 1134, 1135,  595,    0, 1135,
-        0,    0,    0,    0,  593,    0,    0,  595,    0,  593,
-
-        0,    0,  595,    0,    0,    0,    0,    0,    0,    0,
-        0,  595,  593,  594,  594,  595,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-
-      594,  594,  596,  597,  596,  598,  600,  596,  597,  599,
-      598,  600,    0,  599,  599,    0,    0,    0,  598,  600,
-        0,  596,  597,    0,  598,  600,    0,    0,  599,    0,
-        0,  596,  597,  596,  598,  600,  596,  597,  599,  598,
-      600,    0,  599,  599,    0,    0,  598,  600,    0,  596,
-      597,    0,  598,  600,  601,  602,  599,  603,    0,  601,
-      602,  605,  603,    0,    0,  605,  605,    0,    0,  602,
-        0,    0,    0,  601,  602,  603,  603,    0,    0,    0,
-      605,    0,    0,  601,  602,    0,  603,  606,  601,  602,
-      605,  603,  606,    0,  605,  605,    0,  602,  606,    0,
-
-        0,  601,  602,  603,  603,    0,  606,    0,  605,  609,
-      607,    0,    0,  610,  609,  607,  606,  607,  610,    0,
-      610,  606,    0,    0,    0,    0,  606,    0,  609,  607,
-        0,    0,  610,    0,  606,  619,  621,    0,  609,  607,
-      619,  621,  610,  609,  607,    0,  607,  610,    0,  610,
-        0,    0,    0,    0,  619,  621,  609,  607,  620,    0,
-      610,    0,    0,  620,  619,  621,    0,    0,    0,  619,
-      621,  620,    0,    0,  623,  622,    0,  620,  622,  623,
-      622,    0,  619,  621,    0,    0,    0,  620,  623,    0,
-        0,  624,  620,  623,  622,    0,  624,    0,    0,  620,
-
-        0,    0,  624,  623,  622,  620,    0,  622,  623,  622,
-      624,    0,  625,  625,  626,    0,  623,  625,  628,  626,
-      624,  623,  622,  628,    0,  624,    0,    0,    0,  626,
-      624,  625,    0,  626,    0,  627,    0,  628,  624,  627,
-      627,  625,  625,  626,    0,    0,  625,  628,  626,    0,
-        0,    0,  628,  629,  627,  629,    0,  626,    0,  625,
-        0,  626,    0,  632,  627,  628,    0,    0,  627,  627,
-      631,  631,  631,  631,  631,  631,  631,  631,  631,  631,
-      632,    0,  627,  633,  629,  632,  629,  634,  633,  637,
-        0,  629,  634,    0,  637,    0,    0,    0,    0,  632,
-
-      634,    0,  633,    0,    0,  629,  634,    0,  637,  632,
-        0,    0,  633,    0,  632,  629,  634,  633,  637,  638,
-      629,  634,    0,  637,  638,    0,    0,  632,  634,    0,
-      633,    0,    0,  629,  634,  639,  637,    0,  638,  641,
-      639,  641,  642,  639,  641,  642,  643,  642,  638,    0,
-        0,  643,    0,  638,  639,    0,    0,    0,  641,    0,
-        0,  642,  644,    0,  639,  643,  638,  644,  641,  639,
-      641,  642,  639,  641,  642,  643,  642,    0,    0,  644,
-      643,  644,  639,  645,    0,  646,  641,  645,  645,  642,
-      646,  644,  647,  643,  648,    0,  644,  647,    0,  648,
-
-        0,    0,  645,    0,  646,  647,    0,  644,    0,  644,
-        0,  647,  645,  648,  646,    0,  645,  645,    0,  646,
-        0,  647,    0,  648,    0,    0,  647,    0,  648,  649,
-      645,  649,  646,  647,  649,  650,    0,    0,    0,  647,
-      650,  648,    0,    0,    0,    0,  650,    0,  649,    0,
-        0,    0,    0,    0,  650,    0,    0,    0,  649,    0,
-      649,  652,    0,  649,  650,  651,  652,  651,    0,  650,
-      651,    0,  652,  653,  650,    0,  649,  653,  653,    0,
-      652,    0,  650,    0,  651,    0,    0,    0,    0,    0,
-      652,    0,  653,    0,  651,  652,  651,    0,  655,  651,
-
-      652,    0,  653,  655,    0,  654,  653,  653,  652,  656,
-      654,    0,  651,  654,  656,    0,    0,  655,    0,    0,
-      653,    0,  656,    0,  654,  657,    0,  655,  656,  657,
-      657,    0,  655,    0,  654,    0,  658,    0,  656,  654,
-        0,  658,  654,  656,  657,  655,    0,    0,  660,    0,
-      656,    0,  654,  660,  657,  658,  656,  659,  657,  657,
-        0,  659,  659,    0,    0,  658,    0,  660,  661,  662,
-      658,    0,  657,  661,  662,    0,  659,  660,    0,    0,
-        0,    0,  660,  658,    0,    0,  659,  661,  662,    0,
-      659,  659,    0,    0,  663,  660,  663,  661,  662,  663,
-
-      665,  666,  661,  662,  659,  665,  666,    0,    0,    0,
-        0,    0,    0,  663,    0,  661,  662,    0,  665,  665,
-      666,    0,    0,  663,    0,  663,  667,    0,  663,  665,
-      666,  667,    0,    0,  665,  666,    0,  668,    0,  667,
-      668,  663,  668,    0,    0,  667,  665,  665,  666,  669,
-        0,    0,    0,  672,  669,  667,  668,  671,  672,    0,
-      667,    0,  671,    0,    0,    0,  668,  667,  669,  668,
-        0,  668,  672,  667,  673,    0,  671,  671,  669,  673,
-      674,    0,  672,  669,  668,  674,  671,  672,    0,    0,
-        0,  671,    0,  673,    0,    0,  669,    0,    0,  674,
-
-      672,    0,    0,  673,  671,  671,    0,    0,  673,  674,
-        0,    0,  690,    0,  674,    0,    0,    0,  690,  695,
-        0,  673,    0,  695,  695,    0,  690,  674,  690,  690,
-      690,  690,  690,  690,  690,  690,  690,  690,  695,  696,
-      698,  699,    0,    0,  696,  698,  699,  696,  695,    0,
-        0,  698,  695,  695,    0,    0,    0,    0,  696,  698,
-      699,    0,    0,    0,    0,    0,  695,    0,  696,  698,
-      699,    0,  709,  696,  698,  699,  696,    0,    0,  698,
-        0,    0,  710,    0,    0,    0,  696,  698,  699,  709,
-      709,  709,  709,  709,  709,  709,  709,  709,  709,  710,
-
-      710,  710,  710,  710,  710,  710,  710,  710,  710,  711,
-        0,    0,    0,    0,    0,    0,    0,    0,    0,  712,
-        0,    0,    0,    0,    0,    0,  711,  711,  711,  711,
-      711,  711,  711,  711,  711,  711,  712,  712,  712,  712,
-      712,  712,  712,  712,  712,  712,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  719,  719,  719,    0,    0,
-      719,  719,    0,  719,    0,    0,    0,  719,  719,    0,
-        0,  719,    0,    0,  719,  719,  719,  719,  719,  719,
-      719,  719,  719,  732,  732,    0,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  733,    0,    0,  735,    0,  733,  734,  734,
-      734,  734,  734,  734,  734,  734,  734,  734,  736,  737,
-        0,  733,  735,  736,  737,  738,    0,  735,    0,    0,
-      738,  733,    0,    0,    0,    0,  733,  736,  737,    0,
-        0,  735,    0,    0,  738,  739,    0,  736,  737,  733,
-
-      739,  735,  736,  737,  738,    0,  735,  740,    0,  738,
-        0,    0,  740,    0,  739,  736,  737,    0,  741,  735,
-        0,    0,  738,  741,  739,    0,  740,    0,    0,  739,
-      740,    0,    0,    0,    0,    0,  740,  741,  741,    0,
-        0,  740,  739,  742,    0,  742,    0,  741,  742,    0,
-      747,  743,  741,    0,  740,  747,  743,    0,  740,  743,
-        0,  745,  742,  745,    0,  741,  741,    0,    0,  747,
-      743,    0,  742,  750,  742,    0,    0,  742,  750,  747,
-      743,    0,  746,    0,  747,  743,  746,  746,  743,    0,
-      742,    0,  750,    0,  745,    0,  745,  747,  743,  745,
-
-        0,  746,  750,    0,    0,    0,    0,  750,    0,  745,
-        0,  746,    0,  745,  751,  746,  746,    0,  751,  751,
-      750,    0,    0,  745,    0,  745,  762,    0,  745,  746,
-        0,  762,    0,  751,  761,    0,  761,  745,    0,  761,
-        0,  745,    0,  751,    0,  762,  762,  751,  751,    0,
-        0,  763,    0,  761,    0,  762,  763,  763,    0,    0,
-      762,  751,    0,  761,    0,  761,    0,    0,  761,    0,
-      763,  764,  765,  762,  762,  764,  764,  765,  766,    0,
-      763,  761,  766,  766,    0,  763,  763,    0,    0,  765,
-      764,  765,    0,    0,  771,    0,    0,  766,  763,  771,
-
-      764,  765,    0,  767,  764,  764,  765,  766,  767,    0,
-      768,  766,  766,  771,  772,  768,  772,  765,  764,  765,
-      767,  768,  767,  771,  772,  766,  773,    0,  771,  768,
-        0,  773,  767,    0,    0,    0,    0,  767,    0,  768,
-      773,  771,    0,    0,  768,  773,  774,  772,  767,  768,
-      767,  774,  772,    0,  774,  773,    0,  768,  775,    0,
-      773,    0,  775,  775,    0,  774,  772,  776,  773,  778,
-        0,  776,  776,  773,  778,  774,  772,  775,    0,    0,
-      774,  772,    0,  774,    0,    0,  776,  775,  778,    0,
-      777,  775,  775,  774,  772,  777,  776,    0,  778,  779,
-
-      776,  776,    0,  778,  779,  775,    0,  777,    0,  777,
-      780,    0,    0,    0,  776,  780,  778,  779,  779,  777,
-        0,  780,  781,    0,  777,    0,    0,  781,  779,  780,
-        0,  782,    0,  779,    0,  777,  782,  777,    0,  780,
-        0,  781,  783,  784,  780,  779,  779,  783,  784,  780,
-      782,  781,    0,  785,    0,  785,  781,  780,    0,    0,
-      782,  783,  784,  786,    0,  782,    0,    0,  786,  781,
-        0,  783,  784,    0,  787,    0,  783,  784,  782,  787,
-        0,  786,  786,  788,    0,    0,  785,    0,  788,  783,
-      784,  785,  786,  787,  789,    0,    0,  786,  787,  789,
-
-        0,  785,  788,  787,    0,  785,    0,    0,  787,  786,
-      786,    0,  788,  789,    0,  785,    0,  788,    0,  790,
-      785,  787,    0,  789,  790,    0,  787,  791,  789,  785,
-      788,  791,  791,  785,    0,    0,  790,    0,  790,  792,
-        0,  789,    0,    0,  792,    0,  791,    0,  790,    0,
-        0,  792,    0,  790,    0,    0,  791,    0,  792,    0,
-      791,  791,  793,    0,  790,    0,  790,  793,  792,    0,
-      795,  796,    0,  792,  791,  795,  796,    0,  795,  792,
-        0,  793,  797,    0,    0,    0,  792,  797,    0,  795,
-      796,  793,    0,  798,    0,  799,  793,  799,  798,  795,
-
-      796,  797,    0,    0,  795,  796,    0,  795,    0,  793,
-        0,  797,  798,    0,    0,    0,  797,  795,  796,  800,
-      801,    0,  798,    0,  800,  801,  816,  798,  799,  797,
-      799,  816,    0,  799,    0,    0,    0,    0,  800,  801,
-      798,    0,    0,    0,    0,  816,    0,  799,  800,  801,
-        0,  817,    0,  800,  801,  816,  817,  799,    0,  799,
-      816,    0,  799,    0,  817,    0,  800,  801,    0,  818,
-      817,  818,    0,  816,  842,  799,  802,  802,  802,  802,
-      817,    0,    0,    0,    0,  817,    0,    0,    0,    0,
-      819,  842,  817,    0,    0,  819,  842,    0,  817,    0,
-
-        0,    0,  818,    0,    0,    0,    0,  818,    0,  819,
-      842,  802,  802,    0,    0,  802,    0,  802,    0,  819,
-      842,  818,    0,    0,  819,  842,    0,    0,  802,  802,
-        0,  818,    0,    0,    0,    0,  818,  819,  842,    0,
-      802,  802,    0,    0,  802,    0,  802,    0,    0,  818,
-        0,    0,    0,    0,    0,    0,  802,  802,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  828,  841,  841,
-      841,  841,  841,  841,  841,  841,  841,  841,    0,    0,
-        0,    0,    0,    0,  828,  828,  828,  828,  828,  828,
-      828,  828,  828,  828,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  843,    0,  844,    0,  847,  843,  844,
-      844,  845,  847,  845,  846,    0,  845,    0,  846,  846,
-        0,    0,  843,    0,  844,    0,  847,    0,    0,    0,
-      845,    0,  843,  846,  844,    0,  847,  843,  844,  844,
-
-      845,  847,  845,  846,  849,  845,    0,  846,  846,  849,
-      843,  848,  844,    0,  847,  848,  848,    0,  845,    0,
-      850,  846,    0,  849,    0,  850,    0,  853,    0,    0,
-      848,  854,  853,  849,  850,    0,  854,    0,  849,  850,
-      848,  853,    0,    0,  848,  848,  853,    0,  854,  850,
-      854,  849,  855,    0,  850,    0,  853,  855,  848,    0,
-      854,  853,  850,  858,    0,  854,    0,  850,  858,  853,
-        0,  855,  866,    0,  853,    0,  854,  866,  854,    0,
-      858,  855,  858,  867,    0,    0,  855,    0,  867,    0,
-        0,  866,  858,    0,  867,    0,    0,  858,    0,  855,
-
-        0,  866,  867,    0,  868,    0,  866,    0,  858,  868,
-      858,    0,  867,  869,    0,  869,    0,  867,  869,  866,
-        0,  868,  867,  868,    0,    0,    0,    0,    0,  870,
-      867,    0,  869,  868,  870,  871,    0,    0,  868,    0,
-      871,    0,  869,  870,  869,    0,    0,  869,  870,  868,
-        0,  868,    0,    0,  871,    0,    0,    0,  870,    0,
-      869,  872,    0,  870,  871,  872,  872,    0,  873,  871,
-      874,  870,  873,  873,    0,  874,  870,    0,    0,    0,
-      872,  874,  871,    0,    0,    0,    0,  873,    0,  874,
-      872,  878,    0,  877,  872,  872,  878,  873,  877,  874,
-
-        0,  873,  873,    0,  874,    0,  877,    0,  872,  874,
-      878,    0,  877,  879,  880,  873,  881,  874,  879,  880,
-      878,  881,  877,    0,    0,  878,    0,  877,    0,    0,
-        0,    0,  879,  880,  877,  881,  882,    0,  878,    0,
-      877,  882,  879,  880,  882,  881,    0,  879,  880,    0,
-      881,    0,  883,  886,    0,  882,    0,  883,  886,  885,
-      879,  880,    0,  881,  885,  882,    0,    0,    0,    0,
-      882,  883,  886,  882,    0,    0,  885,    0,  885,  887,
-        0,  883,  886,  882,  887,    0,  883,  886,  885,    0,
-      888,  890,    0,  885,    0,  888,  890,    0,  887,  883,
-
-      886,  888,  891,    0,  885,    0,  885,  891,  887,  888,
-      890,  889,    0,  887,    0,  889,  889,    0,    0,  888,
-      890,  891,  892,  897,  888,  890,  887,  892,  897,  888,
-      889,  891,    0,    0,  895,    0,  891,  888,  890,  895,
-      889,  892,  897,  906,  889,  889,    0,    0,  906,  891,
-        0,  892,  897,  895,    0,  895,  892,  897,  889,  898,
-        0,    0,  906,  895,  898,    0,  907,  898,  895,  892,
-      897,  907,  906,    0,    0,    0,    0,  906,  898,    0,
-        0,  895,    0,  895,  907,  907,    0,    0,  898,  909,
-      906,  909,    0,  898,  909,  907,  898,    0,    0,    0,
-
-      907,    0,    0,    0,    0,    0,  898,  914,  909,    0,
-        0,    0,  907,  907,    0,    0,  917,  917,  909,    0,
-      909,  917,    0,  909,  914,  914,  914,  914,  914,  914,
-      914,  914,  914,  914,    0,  917,  909,  918,    0,  919,
-        0,    0,  918,  919,  919,  917,  917,    0,  920,    0,
-      917,    0,    0,  920,    0,    0,  918,    0,  919,    0,
-        0,    0,    0,  917,    0,  920,  918,  920,  919,  921,
-      922,  918,  919,  919,  921,  922,    0,  920,  923,    0,
-        0,    0,  920,  923,  918,    0,  919,    0,  921,  922,
-        0,  923,    0,  920,    0,  920,    0,  923,  921,  922,
-
-        0,  927,    0,  921,  922,  928,  927,  923,    0,  928,
-      928,    0,  923,  927,    0,    0,  921,  922,    0,  923,
-      927,  938,    0,    0,  928,  923,  938,  930,  940,  938,
-      927,  930,  930,  940,  928,  927,    0,    0,  928,  928,
-      938,  927,    0,    0,    0,    0,  930,  940,  927,    0,
-      938,    0,  928,    0,    0,  938,  930,  940,  938,  939,
-      930,  930,  940,  939,  939,  941,  942,    0,  938,    0,
-      941,  942,    0,    0,  930,  940,    0,    0,  939,    0,
-        0,    0,  943,    0,  941,  942,  942,  943,  939,    0,
-        0,  944,  939,  939,  941,  942,  944,    0,    0,  941,
-
-      942,  943,  945,    0,  944,    0,  939,  945,    0,    0,
-      944,  943,  941,  942,  942,    0,  943,    0,  951,    0,
-      944,  945,  952,  951,    0,  944,    0,  952,    0,  943,
-        0,  945,  944,    0,    0,    0,  945,  951,  944,  955,
-        0,  952,    0,  953,  955,  953,    0,  951,  953,  945,
-        0,  952,  951,  955,    0,    0,  952,    0,  955,  956,
-        0,    0,  953,    0,  956,  951,  957,    0,  955,  952,
-      958,  957,  953,  955,  953,  958,    0,  953,  956,    0,
-        0,  955,    0,    0,    0,  957,  955,  958,  956,  958,
-      953,    0,  960,  956,    0,  957,  960,  960,    0,  958,
-
-      957,    0,    0,  963,  958,    0,  956,    0,  963,  962,
-        0,  960,    0,  957,  962,  958,  963,  958,    0,    0,
-        0,  960,  963,    0,    0,  960,  960,  962,  962,  969,
-        0,    0,  963,    0,  969,  970,    0,  963,  962,  960,
-      970,  971,    0,  962,  963,  971,  971,    0,  969,  969,
-      963,    0,  976,    0,  970,  962,  962,  976,  969,    0,
-      971,  975,    0,  969,  970,    0,  975,    0,  977,  970,
-      971,  976,  975,  977,  971,  971,  969,  969,    0,    0,
-      975,  976,  970,    0,  979,    0,  976,  977,  971,  979,
-      975,    0,    0,  985,    0,  975,    0,  977,  985,  976,
-
-      975,  978,  977,  979,  982,  978,  978,    0,  975,  982,
-        0,    0,  985,  979,    0,  977,    0,    0,  979,  982,
-      978,    0,  985,  982,  983,    0,  983,  985,    0,  983,
-      978,  979,    0,  982,  978,  978,    0,    0,  982,    0,
-      985,  993,    0,  983,  994,  992,  993,  982,  978,  994,
-      992,  982,    0,  983,    0,  983,  994,    0,  983,  992,
-      993,  995,    0,  994,  992,    0,  995,  996,    0,    0,
-      993,  983,  996,  994,  992,  993,    0,    0,  994,  992,
-      995,    0,    0,    0,  994,    0,  996,  992,  993,    0,
-      995,  994,  992, 1004,    0,  995,  996,  997, 1004,  997,
-
-     1007,  996,  997,    0, 1006, 1007, 1006,    0,  995, 1006,
-        0,    0, 1004,    0,  996,    0,  997,    0,    0, 1007,
-     1009,    0, 1004, 1006,    0, 1009,  997, 1004,  997, 1007,
-        0,  997,    0, 1006, 1007, 1006,    0, 1011, 1006, 1009,
-     1004, 1011, 1011,    0,  997,    0,    0, 1007,    0, 1009,
-        0, 1006,    0, 1012, 1009,    0, 1011, 1012, 1012,    0,
-     1020,    0,    0,    0, 1019, 1020, 1011, 1009,    0, 1019,
-     1011, 1011, 1012,    0,    0, 1019, 1025,    0,    0, 1020,
-     1025, 1025, 1012, 1019, 1011, 1026, 1012, 1012,    0, 1020,
-     1026,    0,    0, 1019, 1020, 1025,    0, 1029, 1019,    0,
-
-     1012,    0, 1029, 1019, 1026, 1025,    0, 1020, 1029, 1025,
-     1025, 1019,    0,    0, 1026,    0, 1029,    0,    0, 1026,
-     1030,    0, 1037, 1025, 1038, 1030, 1029, 1037, 1030, 1038,
-        0, 1029, 1026,    0,    0, 1037, 1029,    0,    0, 1030,
-        0, 1037,    0, 1038, 1029,    0,    0, 1039,    0, 1030,
-        0, 1037, 1039, 1038, 1030, 1039, 1037, 1030, 1038, 1047,
-        0,    0,    0, 1037, 1047,    0, 1039, 1030, 1040, 1037,
-     1044, 1038, 1040, 1040, 1044, 1044, 1039,    0, 1047,    0,
-        0, 1039,    0,    0, 1039,    0,    0, 1040, 1047, 1044,
-     1048, 1054,    0, 1047, 1039, 1048, 1054, 1040,    0, 1044,
-
-        0, 1040, 1040, 1044, 1044,    0, 1047, 1059,    0, 1048,
-     1054,    0, 1059,    0,    0, 1040, 1063, 1044,    0, 1048,
-     1054, 1063,    0, 1062, 1048, 1054, 1059, 1062, 1062,    0,
-        0,    0,    0,    0, 1063, 1063, 1059, 1048, 1054, 1067,
-        0, 1059, 1062,    0, 1067, 1063, 1068,    0, 1069,    0,
-     1063, 1068, 1062, 1069, 1059,    0, 1062, 1062, 1067, 1068,
-        0,    0, 1063, 1063,    0, 1068,    0, 1069, 1067, 1073,
-     1062, 1080, 1073, 1067, 1073, 1068, 1080, 1069,    0,    0,
-     1068,    0, 1069,    0,    0,    0, 1067, 1068, 1073,    0,
-     1080, 1087,    0, 1068, 1088, 1069, 1087,    0, 1073, 1088,
-
-     1080, 1073, 1088, 1073,    0, 1080,    0,    0,    0,    0,
-     1087,    0,    0, 1088, 1087,    0, 1073, 1091, 1080,    0,
-     1087, 1091, 1091, 1088, 1095, 1087,    0,    0, 1088, 1095,
-        0, 1088,    0,    0,    0,    0, 1091,    0, 1087,    0,
-     1105, 1088, 1087, 1095, 1095, 1105, 1091, 1106,    0, 1108,
-     1091, 1091, 1106, 1095, 1108,    0,    0,    0, 1095, 1105,
-        0, 1106,    0,    0, 1091,    0, 1106,    0, 1108, 1105,
-        0, 1095, 1095,    0, 1105,    0, 1106,    0, 1108,    0,
-        0, 1106,    0, 1108,    0,    0,    0, 1105,    0, 1106,
-        0,    0,    0,    0, 1106,    0, 1108, 1109, 1109, 1109,
-
-        0,    0, 1109, 1109,    0, 1109,    0,    0,    0, 1109,
-     1109,    0,    0, 1109,    0,    0, 1109, 1109, 1109, 1109,
-     1109, 1109, 1109, 1109, 1109, 1112, 1122,    0,    0,    0,
-     1112, 1122,    0,    0,    0,    0,    0,    0,    0, 1122,
-        0,    0, 1112,    0, 1112, 1122,    0,    0,    0,    0,
-        0,    0,    0,    0, 1112, 1122,    0,    0,    0, 1112,
-     1122,    0,    0,    0,    0,    0,    0, 1122,    0,    0,
-     1112,    0, 1112, 1122, 1126, 1126, 1126,    0,    0, 1126,
-     1126,    0, 1126,    0, 1128, 1126, 1126, 1126, 1128, 1128,
-     1126,    0,    0, 1126, 1126, 1126, 1126, 1126, 1126, 1126,
-
-     1126, 1126,    0, 1128, 1133, 1137,    0,    0,    0, 1133,
-     1137,    0,    0, 1128,    0,    0,    0, 1128, 1128,    0,
-        0,    0,    0, 1133, 1137,    0,    0,    0,    0,    0,
-        0, 1128,    0, 1133, 1137,    0,    0,    0, 1133, 1137,
-        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-        0, 1133, 1137, 1162, 1162, 1162, 1162, 1162, 1162, 1162,
-     1162, 1162, 1162, 1162, 1162, 1163, 1163, 1163, 1163, 1163,
-     1163, 1163, 1163, 1163, 1163, 1163, 1163, 1164, 1164,    0,
-     1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1165,
-     1165,    0, 1165, 1165, 1165, 1165, 1165, 1165, 1165, 1165,
-
-     1165, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166,
-     1166, 1166, 1166, 1167, 1167, 1167, 1167, 1167, 1167, 1167,
-     1167, 1167, 1167, 1167, 1167, 1168, 1168, 1169, 1169, 1169,
-     1169, 1169, 1169, 1169, 1169, 1170, 1170, 1170, 1170, 1170,
-     1170, 1170, 1170, 1170, 1170, 1170, 1170, 1171, 1171, 1171,
-     1171, 1171, 1171, 1171, 1171, 1171, 1171, 1171, 1171, 1172,
-     1172, 1172, 1172, 1172, 1172,    0, 1172, 1172, 1172,    0,
-     1172, 1173, 1173, 1173, 1173, 1173, 1173, 1173, 1173, 1173,
-     1173, 1173, 1173, 1174,    0,    0, 1174, 1175, 1175, 1175,
-        0,    0, 1175,    0, 1175, 1175,    0, 1175, 1175, 1176,
-
-     1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176,
-     1176, 1177, 1177,    0, 1177, 1177, 1177, 1177, 1177, 1177,
-     1177, 1177, 1177, 1178, 1178, 1178, 1178, 1178, 1178,    0,
-     1178, 1178, 1178,    0, 1178, 1179, 1179, 1179, 1179, 1179,
-     1179, 1179, 1179, 1179, 1179, 1179, 1179, 1180, 1180, 1180,
-     1180, 1180, 1180, 1180, 1180, 1180, 1180, 1180, 1180, 1181,
-        0,    0, 1181, 1182,    0,    0,    0, 1182,    0,    0,
-        0,    0,    0, 1182, 1183, 1183, 1183, 1183, 1183, 1183,
-     1183, 1183, 1183, 1183, 1183, 1183, 1184, 1184,    0, 1184,
-     1184, 1184, 1184, 1184, 1184, 1184, 1184, 1184, 1185, 1185,
-
-        0, 1185, 1185, 1185, 1185, 1185, 1185, 1185, 1185, 1185,
-     1186, 1186,    0, 1186, 1186, 1186, 1186, 1186, 1186, 1186,
-     1186, 1186, 1187, 1187, 1187, 1187, 1187, 1187, 1187, 1187,
-     1187, 1187, 1187, 1187, 1188, 1188, 1188, 1188, 1188, 1188,
-     1188, 1188, 1188, 1188, 1188, 1188, 1189, 1189, 1189, 1189,
-     1189, 1189, 1189, 1189, 1189, 1189, 1189, 1189, 1190, 1190,
-     1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190,
-     1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191,
-     1191, 1191, 1192, 1192,    0, 1192, 1192, 1192, 1192, 1192,
-     1192, 1192, 1192, 1192, 1193, 1193, 1193, 1193, 1193, 1193,
-
-     1193, 1193, 1193, 1193, 1193, 1193, 1194, 1194, 1194, 1194,
-     1194, 1194, 1194, 1194, 1194, 1194, 1194, 1194, 1195, 1195,
-        0, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195,
-     1196, 1196,    0, 1196, 1196, 1196, 1196, 1196, 1196, 1196,
-     1196, 1196, 1197, 1197,    0, 1197, 1197, 1197, 1197, 1197,
-     1197, 1197, 1197, 1197, 1198, 1198,    0, 1198, 1198, 1198,
-     1198, 1198, 1198, 1198, 1198, 1198, 1199, 1199,    0, 1199,
-     1199, 1199, 1199, 1199, 1199, 1199, 1199, 1199, 1200, 1200,
-     1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200,
-     1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201,
-
-     1201, 1201, 1202, 1202, 1202, 1202, 1202, 1202, 1202, 1202,
-     1202, 1202, 1202, 1202, 1203, 1203, 1203, 1203, 1203, 1203,
-     1203, 1203, 1203, 1203, 1203, 1203, 1204, 1204, 1204, 1204,
-     1204, 1204, 1204, 1204, 1204, 1204, 1204, 1204, 1205, 1205,
-     1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205,
-     1206, 1206,    0, 1206, 1206, 1206, 1206, 1206, 1206, 1206,
-     1206, 1206, 1207, 1207,    0, 1207, 1207, 1207, 1207, 1207,
-     1207, 1207, 1207, 1207, 1208, 1208, 1208, 1208, 1208, 1208,
-     1208, 1208, 1208, 1208, 1208, 1208, 1209, 1209, 1209, 1209,
-     1209, 1209, 1209, 1209, 1209, 1209, 1209, 1209, 1210, 1210,
-
-     1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210,
-     1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211,
-     1211, 1211, 1212, 1212, 1212, 1212, 1212, 1212, 1212, 1212,
-     1212, 1212, 1212, 1212, 1213, 1213, 1213, 1213, 1213, 1213,
-     1213, 1213, 1213, 1213, 1213, 1213, 1214, 1214, 1214, 1214,
-     1214, 1214, 1214, 1214, 1214, 1214, 1214, 1214, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161
-    } ;
-
-static yy_state_type yy_last_accepting_state;
-static char *yy_last_accepting_cpos;
-
-extern int fortran_flex_debug;
-int fortran_flex_debug = 0;
-
-/* The intent behind this definition is that it'll catch
- * any uses of REJECT which flex missed.
- */
-#define REJECT reject_used_but_not_detected
-#define yymore() yymore_used_but_not_detected
-#define YY_MORE_ADJ 0
-#define YY_RESTORE_YY_MORE_OFFSET
-char *fortrantext;
-#line 1 "fortran.lex"
-/******************************************************************************/
-/*                                                                            */
-/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
-/*                                                                            */
-/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
-/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
-/* This software is governed by the CeCILL-C license under French law and     */
-/* abiding by the rules of distribution of free software.  You can  use,      */
-/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
-/* license as circulated by CEA, CNRS and INRIA at the following URL          */
-/* "http://www.cecill.info".                                                  */
-/*                                                                            */
-/* As a counterpart to the access to the source code and  rights to copy,     */
-/* modify and redistribute granted by the license, users are provided only    */
-/* with a limited warranty  and the software's author,  the holder of the     */
-/* economic rights,  and the successive licensors  have only  limited         */
-/* liability.                                                                 */
-/*                                                                            */
-/* In this respect, the user's attention is drawn to the risks associated     */
-/* with loading,  using,  modifying and/or developing or reproducing the      */
-/* software by the user in light of its specific status of free software,     */
-/* that may mean  that it is complicated to manipulate,  and  that  also      */
-/* therefore means  that it is reserved for developers  and  experienced      */
-/* professionals having in-depth computer knowledge. Users are therefore      */
-/* encouraged to load and test the software's suitability as regards their    */
-/* requirements in conditions enabling the security of their systems and/or   */
-/* data to be ensured and,  more generally, to use and operate it in the      */
-/* same conditions as regards security.                                       */
-/*                                                                            */
-/* The fact that you are presently reading this means that you have had       */
-/* knowledge of the CeCILL-C license and that you accept its terms.           */
-/******************************************************************************/
-/* version 1.7                                                                */
-/******************************************************************************/
-
-
-
-
-
-#line 41 "fortran.lex"
-#include <math.h>
-#include <stdlib.h>
-#include <string.h>
-extern FILE * fortranin;
-#define MAX_INCLUDE_DEPTH 30
-#define tabsize 6
-YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
-int line_num_fortran=1;
-int line_num_fortran_common=1;
-int newlinef90 = 0;
-char *tmp;
-char tmpc;
-/******************************************************************************/
-/**************PETITS PB NON PREVUS *******************************************/
-/******************************************************************************/
-/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
-/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
-/*            de la 7eme et le debut de la ligne de commande                  */
-/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
-/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
-/******************************************************************************/
-#define YY_USER_ACTION \
-        {\
-           if (firstpass == 0) \
-           {\
-              strcat(curbuf,fortrantext); \
-              Save_Length(curbuf,38); \
-              strcpy(motparse,fortrantext);\
-              Save_Length(motparse,32); \
-              colnum = colnum + strlen(motparse);\
-              ECHO; \
-           }\
-           strcpy(motparse1,fortrantext);\
-/*           printf("fortrantext = %s\n",fortrantext);*/\
-        /*if ( firstpass == 1 ) 
-                      printf("fortrantext = %s %d\n",fortrantext,strlen(fortrantext));*/\
-        }
-#line 2979 "fortran.yy.c"
-
-#define INITIAL 0
-#define parameter 1
-#define character 2
-#define donottreat 3
-#define fortran77style 4
-#define fortran90style 5
-
-#ifndef YY_NO_UNISTD_H
-/* Special case for "unistd.h", since it is non-ANSI. We include it way
- * down here because we want the user's section 1 to have been scanned first.
- * The user has a chance to override it with an option.
- */
-#include <unistd.h>
-#endif
-
-#ifndef YY_EXTRA_TYPE
-#define YY_EXTRA_TYPE void *
-#endif
-
-static int yy_init_globals (void );
-
-/* Accessor methods to globals.
-   These are made visible to non-reentrant scanners for convenience. */
-
-int fortranlex_destroy (void );
-
-int fortranget_debug (void );
-
-void fortranset_debug (int debug_flag  );
-
-YY_EXTRA_TYPE fortranget_extra (void );
-
-void fortranset_extra (YY_EXTRA_TYPE user_defined  );
-
-FILE *fortranget_in (void );
-
-void fortranset_in  (FILE * in_str  );
-
-FILE *fortranget_out (void );
-
-void fortranset_out  (FILE * out_str  );
-
-yy_size_t fortranget_leng (void );
-
-char *fortranget_text (void );
-
-int fortranget_lineno (void );
-
-void fortranset_lineno (int line_number  );
-
-/* Macros after this point can all be overridden by user definitions in
- * section 1.
- */
-
-#ifndef YY_SKIP_YYWRAP
-#ifdef __cplusplus
-extern "C" int fortranwrap (void );
-#else
-extern int fortranwrap (void );
-#endif
-#endif
-
-    static void yyunput (int c,char *buf_ptr  );
-    
-#ifndef yytext_ptr
-static void yy_flex_strncpy (char *,yyconst char *,int );
-#endif
-
-#ifdef YY_NEED_STRLEN
-static int yy_flex_strlen (yyconst char * );
-#endif
-
-#ifndef YY_NO_INPUT
-
-#ifdef __cplusplus
-static int yyinput (void );
-#else
-static int input (void );
-#endif
-
-#endif
-
-/* Amount of stuff to slurp up with each read. */
-#ifndef YY_READ_BUF_SIZE
-#define YY_READ_BUF_SIZE 8192
-#endif
-
-/* Copy whatever the last rule matched to the standard output. */
-#ifndef ECHO
-/* This used to be an fputs(), but since the string might contain NUL's,
- * we now use fwrite().
- */
-#define ECHO fwrite( fortrantext, fortranleng, 1, fortranout )
-#endif
-
-/* Gets input and stuffs it into "buf".  number of characters read, or YY_NULL,
- * is returned in "result".
- */
-#ifndef YY_INPUT
-#define YY_INPUT(buf,result,max_size) \
-	if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
-		{ \
-		int c = '*'; \
-		yy_size_t n; \
-		for ( n = 0; n < max_size && \
-			     (c = getc( fortranin )) != EOF && c != '\n'; ++n ) \
-			buf[n] = (char) c; \
-		if ( c == '\n' ) \
-			buf[n++] = (char) c; \
-		if ( c == EOF && ferror( fortranin ) ) \
-			YY_FATAL_ERROR( "input in flex scanner failed" ); \
-		result = n; \
-		} \
-	else \
-		{ \
-		errno=0; \
-		while ( (result = fread(buf, 1, max_size, fortranin))==0 && ferror(fortranin)) \
-			{ \
-			if( errno != EINTR) \
-				{ \
-				YY_FATAL_ERROR( "input in flex scanner failed" ); \
-				break; \
-				} \
-			errno=0; \
-			clearerr(fortranin); \
-			} \
-		}\
-\
-
-#endif
-
-/* No semi-colon after return; correct usage is to write "yyterminate();" -
- * we don't want an extra ';' after the "return" because that will cause
- * some compilers to complain about unreachable statements.
- */
-#ifndef yyterminate
-#define yyterminate() return YY_NULL
-#endif
-
-/* Number of entries by which start-condition stack grows. */
-#ifndef YY_START_STACK_INCR
-#define YY_START_STACK_INCR 25
-#endif
-
-/* Report a fatal error. */
-#ifndef YY_FATAL_ERROR
-#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
-#endif
-
-/* end tables serialization structures and prototypes */
-
-/* Default declaration of generated scanner - a define so the user can
- * easily add parameters.
- */
-#ifndef YY_DECL
-#define YY_DECL_IS_OURS 1
-
-extern int fortranlex (void);
-
-#define YY_DECL int fortranlex (void)
-#endif /* !YY_DECL */
-
-/* Code executed at the beginning of each rule, after fortrantext and fortranleng
- * have been set up.
- */
-#ifndef YY_USER_ACTION
-#define YY_USER_ACTION
-#endif
-
-/* Code executed at the end of each rule. */
-#ifndef YY_BREAK
-#define YY_BREAK break;
-#endif
-
-#define YY_RULE_SETUP \
-	if ( fortranleng > 0 ) \
-		YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \
-				(fortrantext[fortranleng - 1] == '\n'); \
-	YY_USER_ACTION
-
-/** The main scanner function which does all the work.
- */
-YY_DECL
-{
-	register yy_state_type yy_current_state;
-	register char *yy_cp, *yy_bp;
-	register int yy_act;
-    
-#line 107 "fortran.lex"
-
-  if (infixed) BEGIN(fortran77style) ;
-  if (infree) BEGIN(fortran90style)  ;
-
-#line 3174 "fortran.yy.c"
-
-	if ( !(yy_init) )
-		{
-		(yy_init) = 1;
-
-#ifdef YY_USER_INIT
-		YY_USER_INIT;
-#endif
-
-		if ( ! (yy_start) )
-			(yy_start) = 1;	/* first start state */
-
-		if ( ! fortranin )
-			fortranin = stdin;
-
-		if ( ! fortranout )
-			fortranout = stdout;
-
-		if ( ! YY_CURRENT_BUFFER ) {
-			fortranensure_buffer_stack ();
-			YY_CURRENT_BUFFER_LVALUE =
-				fortran_create_buffer(fortranin,YY_BUF_SIZE );
-		}
-
-		fortran_load_buffer_state( );
-		}
-
-	while ( 1 )		/* loops until end-of-file is reached */
-		{
-		yy_cp = (yy_c_buf_p);
-
-		/* Support of fortrantext. */
-		*yy_cp = (yy_hold_char);
-
-		/* yy_bp points to the position in yy_ch_buf of the start of
-		 * the current run.
-		 */
-		yy_bp = yy_cp;
-
-		yy_current_state = (yy_start);
-		yy_current_state += YY_AT_BOL();
-yy_match:
-		do
-			{
-			register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
-			if ( yy_accept[yy_current_state] )
-				{
-				(yy_last_accepting_state) = yy_current_state;
-				(yy_last_accepting_cpos) = yy_cp;
-				}
-			while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
-				{
-				yy_current_state = (int) yy_def[yy_current_state];
-				if ( yy_current_state >= 1162 )
-					yy_c = yy_meta[(unsigned int) yy_c];
-				}
-			yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
-			++yy_cp;
-			}
-		while ( yy_base[yy_current_state] != 9159 );
-
-yy_find_action:
-		yy_act = yy_accept[yy_current_state];
-		if ( yy_act == 0 )
-			{ /* have to back up */
-			yy_cp = (yy_last_accepting_cpos);
-			yy_current_state = (yy_last_accepting_state);
-			yy_act = yy_accept[yy_current_state];
-			}
-
-		YY_DO_BEFORE_ACTION;
-
-do_action:	/* This label is used only to access EOF actions. */
-
-		switch ( yy_act )
-	{ /* beginning of action switch */
-			case 0: /* must back up */
-			/* undo the effects of YY_DO_BEFORE_ACTION */
-			*yy_cp = (yy_hold_char);
-			yy_cp = (yy_last_accepting_cpos);
-			yy_current_state = (yy_last_accepting_state);
-			goto yy_find_action;
-
-case 1:
-YY_RULE_SETUP
-#line 111 "fortran.lex"
-return TOK_DEBUT;
-	YY_BREAK
-case 2:
-YY_RULE_SETUP
-#line 112 "fortran.lex"
-return TOK_FIN;
-	YY_BREAK
-case 3:
-YY_RULE_SETUP
-#line 113 "fortran.lex"
-return TOK_OMP;
-	YY_BREAK
-case 4:
-YY_RULE_SETUP
-#line 114 "fortran.lex"
-return TOK_DOLLAR;
-	YY_BREAK
-case 5:
-YY_RULE_SETUP
-#line 116 "fortran.lex"
-{return TOK_REAL8;}
-	YY_BREAK
-case 6:
-YY_RULE_SETUP
-#line 117 "fortran.lex"
-{return TOK_SUBROUTINE;}
-	YY_BREAK
-case 7:
-YY_RULE_SETUP
-#line 118 "fortran.lex"
-{return TOK_PROGRAM;}
-	YY_BREAK
-case 8:
-YY_RULE_SETUP
-#line 119 "fortran.lex"
-{inallocate = 1; return TOK_ALLOCATE;}
-	YY_BREAK
-case 9:
-YY_RULE_SETUP
-#line 120 "fortran.lex"
-{return TOK_NULLIFY;}
-	YY_BREAK
-case 10:
-YY_RULE_SETUP
-#line 121 "fortran.lex"
-{inallocate = 1; return TOK_DEALLOCATE;}
-	YY_BREAK
-case 11:
-YY_RULE_SETUP
-#line 122 "fortran.lex"
-{return TOK_RESULT;}
-	YY_BREAK
-case 12:
-YY_RULE_SETUP
-#line 123 "fortran.lex"
-{return TOK_FUNCTION;}
-	YY_BREAK
-case 13:
-YY_RULE_SETUP
-#line 124 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDSUBROUTINE;}
-	YY_BREAK
-case 14:
-YY_RULE_SETUP
-#line 125 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDPROGRAM;}
-	YY_BREAK
-case 15:
-YY_RULE_SETUP
-#line 126 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDFUNCTION;}
-	YY_BREAK
-case 16:
-YY_RULE_SETUP
-#line 127 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDUNIT;}
-	YY_BREAK
-case 17:
-YY_RULE_SETUP
-#line 128 "fortran.lex"
-return TOK_INCLUDE;
-	YY_BREAK
-case 18:
-YY_RULE_SETUP
-#line 129 "fortran.lex"
-{
-                            strcpy(yylval.na,fortrantext);
-                            tmpc = input();
-                            unput(tmpc);
-                            if ( (
-                               tmpc >= 'a' && tmpc <= 'z'
-                                  ) || (
-                               tmpc >= 'A' && tmpc <= 'Z'
-                               )  )
-                               {
-                                  return TOK_USE;
-                               }
-                               else
-                               {
-                                  return TOK_NAME;
-                               }
-                         }
-	YY_BREAK
-case 19:
-YY_RULE_SETUP
-#line 146 "fortran.lex"
-{return TOK_REWIND;}
-	YY_BREAK
-case 20:
-YY_RULE_SETUP
-#line 147 "fortran.lex"
-return TOK_IMPLICIT;
-	YY_BREAK
-case 21:
-YY_RULE_SETUP
-#line 148 "fortran.lex"
-return TOK_NONE;
-	YY_BREAK
-case 22:
-YY_RULE_SETUP
-#line 149 "fortran.lex"
-return TOK_CALL;
-	YY_BREAK
-case 23:
-YY_RULE_SETUP
-#line 150 "fortran.lex"
-return TOK_TRUE;
-	YY_BREAK
-case 24:
-YY_RULE_SETUP
-#line 151 "fortran.lex"
-return TOK_FALSE;
-	YY_BREAK
-case 25:
-YY_RULE_SETUP
-#line 152 "fortran.lex"
-{return TOK_POINT_TO;}
-	YY_BREAK
-case 26:
-YY_RULE_SETUP
-#line 153 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DASTER;}
-	YY_BREAK
-case 27:
-YY_RULE_SETUP
-#line 154 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_EQV;}
-	YY_BREAK
-case 28:
-YY_RULE_SETUP
-#line 155 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_EQ;}
-	YY_BREAK
-case 29:
-YY_RULE_SETUP
-#line 156 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_GT;}
-	YY_BREAK
-case 30:
-YY_RULE_SETUP
-#line 157 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_GE;}
-	YY_BREAK
-case 31:
-YY_RULE_SETUP
-#line 158 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_LT;}
-	YY_BREAK
-case 32:
-YY_RULE_SETUP
-#line 159 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_LE;}
-	YY_BREAK
-case 33:
-YY_RULE_SETUP
-#line 160 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NEQV;}
-	YY_BREAK
-case 34:
-YY_RULE_SETUP
-#line 161 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NE;}
-	YY_BREAK
-case 35:
-YY_RULE_SETUP
-#line 162 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NOT;}
-	YY_BREAK
-case 36:
-YY_RULE_SETUP
-#line 163 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_OR;}
-	YY_BREAK
-case 37:
-YY_RULE_SETUP
-#line 164 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_XOR;}
-	YY_BREAK
-case 38:
-YY_RULE_SETUP
-#line 165 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_AND;}
-	YY_BREAK
-case 39:
-YY_RULE_SETUP
-#line 166 "fortran.lex"
-{return TOK_MODULE;}
-	YY_BREAK
-case 40:
-YY_RULE_SETUP
-#line 167 "fortran.lex"
-{return TOK_DOWHILE;}
-	YY_BREAK
-case 41:
-YY_RULE_SETUP
-#line 168 "fortran.lex"
-return TOK_ENDMODULE;
-	YY_BREAK
-case 42:
-YY_RULE_SETUP
-#line 169 "fortran.lex"
-return TOK_ENDDO;
-	YY_BREAK
-case 43:
-YY_RULE_SETUP
-#line 170 "fortran.lex"
-{return TOK_PLAINDO;}
-	YY_BREAK
-case 44:
-YY_RULE_SETUP
-#line 171 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_REAL;}
-	YY_BREAK
-case 45:
-YY_RULE_SETUP
-#line 172 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_INTEGER;}
-	YY_BREAK
-case 46:
-YY_RULE_SETUP
-#line 173 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_LOGICAL;}
-	YY_BREAK
-case 47:
-YY_RULE_SETUP
-#line 174 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHARACTER;}
-	YY_BREAK
-case 48:
-YY_RULE_SETUP
-#line 175 "fortran.lex"
-{return TOK_ALLOCATABLE;}
-	YY_BREAK
-case 49:
-YY_RULE_SETUP
-#line 176 "fortran.lex"
-return TOK_CLOSE;
-	YY_BREAK
-case 50:
-YY_RULE_SETUP
-#line 177 "fortran.lex"
-return TOK_INQUIRE;
-	YY_BREAK
-case 51:
-YY_RULE_SETUP
-#line 178 "fortran.lex"
-{return TOK_DIMENSION;}
-	YY_BREAK
-case 52:
-YY_RULE_SETUP
-#line 179 "fortran.lex"
-return TOK_PAUSE;
-	YY_BREAK
-case 53:
-YY_RULE_SETUP
-#line 180 "fortran.lex"
-return TOK_EQUIVALENCE;
-	YY_BREAK
-case 54:
-YY_RULE_SETUP
-#line 181 "fortran.lex"
-return TOK_STOP;
-	YY_BREAK
-case 55:
-YY_RULE_SETUP
-#line 182 "fortran.lex"
-return TOK_WHERE;
-	YY_BREAK
-case 56:
-YY_RULE_SETUP
-#line 183 "fortran.lex"
-return TOK_ENDWHERE;
-	YY_BREAK
-case 57:
-YY_RULE_SETUP
-#line 184 "fortran.lex"
-return TOK_ELSEWHERE;
-	YY_BREAK
-case 58:
-YY_RULE_SETUP
-#line 185 "fortran.lex"
-{return TOK_COMPLEX;}
-	YY_BREAK
-case 59:
-YY_RULE_SETUP
-#line 186 "fortran.lex"
-{return TOK_CONTAINS;}
-	YY_BREAK
-case 60:
-YY_RULE_SETUP
-#line 187 "fortran.lex"
-{return TOK_ONLY;}
-	YY_BREAK
-case 61:
-YY_RULE_SETUP
-#line 188 "fortran.lex"
-{return TOK_PARAMETER;}
-	YY_BREAK
-case 62:
-YY_RULE_SETUP
-#line 189 "fortran.lex"
-{return TOK_RECURSIVE;}
-	YY_BREAK
-case 63:
-YY_RULE_SETUP
-#line 190 "fortran.lex"
-{return TOK_COMMON;}
-	YY_BREAK
-case 64:
-YY_RULE_SETUP
-#line 191 "fortran.lex"
-{return TOK_GLOBAL;}
-	YY_BREAK
-case 65:
-YY_RULE_SETUP
-#line 192 "fortran.lex"
-{return TOK_EXTERNAL;}
-	YY_BREAK
-case 66:
-YY_RULE_SETUP
-#line 193 "fortran.lex"
-{return TOK_INTENT;}
-	YY_BREAK
-case 67:
-YY_RULE_SETUP
-#line 194 "fortran.lex"
-{return TOK_POINTER;}
-	YY_BREAK
-case 68:
-YY_RULE_SETUP
-#line 195 "fortran.lex"
-{return TOK_OPTIONAL;}
-	YY_BREAK
-case 69:
-YY_RULE_SETUP
-#line 196 "fortran.lex"
-{return TOK_SAVE;}
-	YY_BREAK
-case 70:
-YY_RULE_SETUP
-#line 197 "fortran.lex"
-{return TOK_TYPE;}
-	YY_BREAK
-case 71:
-YY_RULE_SETUP
-#line 198 "fortran.lex"
-{return TOK_TYPEPAR;}
-	YY_BREAK
-case 72:
-YY_RULE_SETUP
-#line 199 "fortran.lex"
-{if (inallocate == 1) return TOK_STAT; else {strcpy(yylval.na,fortrantext);return TOK_NAME;}}
-	YY_BREAK
-case 73:
-YY_RULE_SETUP
-#line 200 "fortran.lex"
-{return TOK_ENDTYPE;}
-	YY_BREAK
-case 74:
-YY_RULE_SETUP
-#line 201 "fortran.lex"
-return TOK_OPEN;
-	YY_BREAK
-case 75:
-YY_RULE_SETUP
-#line 202 "fortran.lex"
-return TOK_RETURN;
-	YY_BREAK
-case 76:
-/* rule 76 can match eol */
-YY_RULE_SETUP
-#line 203 "fortran.lex"
-return TOK_EXIT;
-	YY_BREAK
-case 77:
-YY_RULE_SETUP
-#line 204 "fortran.lex"
-return TOK_PRINT;
-	YY_BREAK
-case 78:
-YY_RULE_SETUP
-#line 205 "fortran.lex"
-{return TOK_PROCEDURE;}
-	YY_BREAK
-case 79:
-YY_RULE_SETUP
-#line 206 "fortran.lex"
-{return TOK_READ;}
-	YY_BREAK
-case 80:
-YY_RULE_SETUP
-#line 207 "fortran.lex"
-{return TOK_NAMELIST;}
-	YY_BREAK
-case 81:
-YY_RULE_SETUP
-#line 208 "fortran.lex"
-{return TOK_WRITE;}
-	YY_BREAK
-case 82:
-YY_RULE_SETUP
-#line 209 "fortran.lex"
-{return TOK_TARGET;}
-	YY_BREAK
-case 83:
-YY_RULE_SETUP
-#line 210 "fortran.lex"
-{return TOK_PUBLIC;}
-	YY_BREAK
-case 84:
-YY_RULE_SETUP
-#line 211 "fortran.lex"
-{return TOK_PRIVATE;}
-	YY_BREAK
-case 85:
-YY_RULE_SETUP
-#line 212 "fortran.lex"
-{strcpy(yylval.nac,fortrantext);return TOK_IN;}
-	YY_BREAK
-case 86:
-YY_RULE_SETUP
-#line 213 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DATA;}
-	YY_BREAK
-case 87:
-YY_RULE_SETUP
-#line 214 "fortran.lex"
-return TOK_CONTINUE;
-	YY_BREAK
-case 88:
-YY_RULE_SETUP
-#line 215 "fortran.lex"
-{return TOK_PLAINGOTO;}
-	YY_BREAK
-case 89:
-YY_RULE_SETUP
-#line 216 "fortran.lex"
-{strcpy(yylval.nac,fortrantext);return TOK_OUT;}
-	YY_BREAK
-case 90:
-YY_RULE_SETUP
-#line 217 "fortran.lex"
-{strcpy(yylval.nac,fortrantext);return TOK_INOUT;}
-	YY_BREAK
-case 91:
-YY_RULE_SETUP
-#line 218 "fortran.lex"
-{return TOK_INTRINSIC;}
-	YY_BREAK
-case 92:
-YY_RULE_SETUP
-#line 219 "fortran.lex"
-{return TOK_THEN;}
-	YY_BREAK
-case 93:
-YY_RULE_SETUP
-#line 220 "fortran.lex"
-{return TOK_ELSEIF;}
-	YY_BREAK
-case 94:
-YY_RULE_SETUP
-#line 221 "fortran.lex"
-{return TOK_ELSE;}
-	YY_BREAK
-case 95:
-YY_RULE_SETUP
-#line 222 "fortran.lex"
-{return TOK_ENDIF;}
-	YY_BREAK
-case 96:
-YY_RULE_SETUP
-#line 223 "fortran.lex"
-{return TOK_LOGICALIF;}
-	YY_BREAK
-case 97:
-YY_RULE_SETUP
-#line 224 "fortran.lex"
-{return TOK_SUM;}
-	YY_BREAK
-case 98:
-YY_RULE_SETUP
-#line 225 "fortran.lex"
-{return TOK_MAX;}
-	YY_BREAK
-case 99:
-YY_RULE_SETUP
-#line 226 "fortran.lex"
-{return TOK_TANH;}
-	YY_BREAK
-case 100:
-YY_RULE_SETUP
-#line 227 "fortran.lex"
-{return TOK_MAXVAL;}
-	YY_BREAK
-case 101:
-YY_RULE_SETUP
-#line 228 "fortran.lex"
-{return TOK_TRIM;}
-	YY_BREAK
-case 102:
-YY_RULE_SETUP
-#line 229 "fortran.lex"
-{return TOK_SQRT;}
-	YY_BREAK
-case 103:
-YY_RULE_SETUP
-#line 230 "fortran.lex"
-{return TOK_SELECTCASE;}
-	YY_BREAK
-case 104:
-YY_RULE_SETUP
-#line 231 "fortran.lex"
-{return TOK_CASE;}
-	YY_BREAK
-case 105:
-YY_RULE_SETUP
-#line 232 "fortran.lex"
-{return TOK_CASEDEFAULT;}
-	YY_BREAK
-case 106:
-YY_RULE_SETUP
-#line 233 "fortran.lex"
-{return TOK_ENDSELECT;}
-	YY_BREAK
-case 107:
-YY_RULE_SETUP
-#line 234 "fortran.lex"
-{return TOK_FILE;}
-	YY_BREAK
-case 108:
-YY_RULE_SETUP
-#line 235 "fortran.lex"
-{return TOK_END;}
-	YY_BREAK
-case 109:
-YY_RULE_SETUP
-#line 236 "fortran.lex"
-{return TOK_ERR;}
-	YY_BREAK
-case 110:
-YY_RULE_SETUP
-#line 237 "fortran.lex"
-{return TOK_EXIST;}
-	YY_BREAK
-case 111:
-YY_RULE_SETUP
-#line 238 "fortran.lex"
-{return TOK_MIN;}
-	YY_BREAK
-case 112:
-YY_RULE_SETUP
-#line 239 "fortran.lex"
-{return TOK_NINT;}
-	YY_BREAK
-case 113:
-YY_RULE_SETUP
-#line 240 "fortran.lex"
-{return TOK_FLOAT;}
-	YY_BREAK
-case 114:
-YY_RULE_SETUP
-#line 241 "fortran.lex"
-{return TOK_EXP;}
-	YY_BREAK
-case 115:
-YY_RULE_SETUP
-#line 242 "fortran.lex"
-{return TOK_COS;}
-	YY_BREAK
-case 116:
-YY_RULE_SETUP
-#line 243 "fortran.lex"
-{return TOK_COSH;}
-	YY_BREAK
-case 117:
-YY_RULE_SETUP
-#line 244 "fortran.lex"
-{return TOK_ACOS;}
-	YY_BREAK
-case 118:
-YY_RULE_SETUP
-#line 245 "fortran.lex"
-{return TOK_SIN;}
-	YY_BREAK
-case 119:
-YY_RULE_SETUP
-#line 246 "fortran.lex"
-{return TOK_SINH;}
-	YY_BREAK
-case 120:
-YY_RULE_SETUP
-#line 247 "fortran.lex"
-{return TOK_ASIN;}
-	YY_BREAK
-case 121:
-YY_RULE_SETUP
-#line 248 "fortran.lex"
-{return TOK_LOG;}
-	YY_BREAK
-case 122:
-YY_RULE_SETUP
-#line 249 "fortran.lex"
-{return TOK_TAN;}
-	YY_BREAK
-case 123:
-YY_RULE_SETUP
-#line 250 "fortran.lex"
-{return TOK_ATAN;}
-	YY_BREAK
-case 124:
-YY_RULE_SETUP
-#line 251 "fortran.lex"
-{return TOK_CYCLE;}
-	YY_BREAK
-case 125:
-YY_RULE_SETUP
-#line 252 "fortran.lex"
-{return TOK_ABS;}
-	YY_BREAK
-case 126:
-YY_RULE_SETUP
-#line 253 "fortran.lex"
-{return TOK_MOD;}
-	YY_BREAK
-case 127:
-YY_RULE_SETUP
-#line 254 "fortran.lex"
-{return TOK_SIGN;}
-	YY_BREAK
-case 128:
-YY_RULE_SETUP
-#line 255 "fortran.lex"
-{return TOK_MINLOC;}
-	YY_BREAK
-case 129:
-YY_RULE_SETUP
-#line 256 "fortran.lex"
-{return TOK_MAXLOC;}
-	YY_BREAK
-case 130:
-YY_RULE_SETUP
-#line 257 "fortran.lex"
-{return TOK_MINVAL;}
-	YY_BREAK
-case 131:
-YY_RULE_SETUP
-#line 258 "fortran.lex"
-{return TOK_BACKSPACE;}
-	YY_BREAK
-case 132:
-YY_RULE_SETUP
-#line 259 "fortran.lex"
-{return TOK_LEFTAB;}
-	YY_BREAK
-case 133:
-YY_RULE_SETUP
-#line 260 "fortran.lex"
-{return TOK_RIGHTAB;}
-	YY_BREAK
-case 134:
-/* rule 134 can match eol */
-YY_RULE_SETUP
-#line 261 "fortran.lex"
-{return TOK_FORMAT;}
-	YY_BREAK
-case 135:
-YY_RULE_SETUP
-#line 262 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DOUBLEPRECISION;}
-	YY_BREAK
-case 136:
-YY_RULE_SETUP
-#line 263 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DOUBLECOMPLEX;}
-	YY_BREAK
-case 137:
-YY_RULE_SETUP
-#line 264 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_SLASH;}
-	YY_BREAK
-case 138:
-YY_RULE_SETUP
-#line 265 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DSLASH;}
-	YY_BREAK
-case 139:
-/* rule 139 can match eol */
-YY_RULE_SETUP
-#line 266 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_CUT;}
-	YY_BREAK
-case 140:
-YY_RULE_SETUP
-#line 267 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_CONSTANT;}
-	YY_BREAK
-case 141:
-YY_RULE_SETUP
-#line 268 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_MESSAGE;}
-	YY_BREAK
-case 142:
-YY_RULE_SETUP
-#line 269 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_INT;}
-	YY_BREAK
-case 143:
-YY_RULE_SETUP
-#line 270 "fortran.lex"
-{printf("debug interfacer\n");BEGIN(donottreat);}
-	YY_BREAK
-case 144:
-/* rule 144 can match eol */
-YY_RULE_SETUP
-#line 271 "fortran.lex"
-{
-						BEGIN(INITIAL);
-                        if (infixed) BEGIN(fortran77style) ;
-                        if (infree) BEGIN(fortran90style)  ;
-                        line_num_fortran++;line_num_fortran_common++;
-                        return '\n';
-						}
-	YY_BREAK
-case 145:
-YY_RULE_SETUP
-#line 278 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NAME;}
-	YY_BREAK
-case 146:
-YY_RULE_SETUP
-#line 279 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREAL;}
-	YY_BREAK
-case 147:
-YY_RULE_SETUP
-#line 280 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREALDP;}
-	YY_BREAK
-case 148:
-YY_RULE_SETUP
-#line 281 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREALQP;}
-	YY_BREAK
-case 149:
-/* rule 149 can match eol */
-*yy_cp = (yy_hold_char); /* undo effects of setting up fortrantext */
-(yy_c_buf_p) = yy_cp -= 1;
-YY_DO_BEFORE_ACTION; /* set up fortrantext again */
-YY_RULE_SETUP
-#line 282 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREAL;}
-	YY_BREAK
-case 150:
-YY_RULE_SETUP
-#line 283 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTINT;}
-	YY_BREAK
-case 151:
-YY_RULE_SETUP
-#line 284 "fortran.lex"
-{}
-	YY_BREAK
-case 152:
-YY_RULE_SETUP
-#line 285 "fortran.lex"
-{return TOK_QUOTE;}
-	YY_BREAK
-case 153:
-YY_RULE_SETUP
-#line 286 "fortran.lex"
-{}
-	YY_BREAK
-case 154:
-YY_RULE_SETUP
-#line 287 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return (int) *fortrantext;}
-	YY_BREAK
-case 155:
-YY_RULE_SETUP
-#line 288 "fortran.lex"
-{afterpercent = 1; strcpy(yylval.na,fortrantext);return (int) *fortrantext;}
-	YY_BREAK
-case 156:
-YY_RULE_SETUP
-#line 289 "fortran.lex"
-{return TOK_SEMICOLON;}
-	YY_BREAK
-case 157:
-YY_RULE_SETUP
-#line 290 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 158:
-YY_RULE_SETUP
-#line 291 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 159:
-YY_RULE_SETUP
-#line 292 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 160:
-YY_RULE_SETUP
-#line 293 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 161:
-/* rule 161 can match eol */
-YY_RULE_SETUP
-#line 294 "fortran.lex"
-{colnum=0;line_num_fortran++;line_num_fortran_common++; return (int) *fortrantext;}
-	YY_BREAK
-case 162:
-*yy_cp = (yy_hold_char); /* undo effects of setting up fortrantext */
-(yy_c_buf_p) = yy_cp -= 1;
-YY_DO_BEFORE_ACTION; /* set up fortrantext again */
-YY_RULE_SETUP
-#line 295 "fortran.lex"
-
-	YY_BREAK
-case 163:
-YY_RULE_SETUP
-#line 296 "fortran.lex"
-{if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0;}
-	YY_BREAK
-case 164:
-YY_RULE_SETUP
-#line 297 "fortran.lex"
-
-	YY_BREAK
-case 165:
-YY_RULE_SETUP
-#line 298 "fortran.lex"
-{colnum=colnum-1+tabsize;}
-	YY_BREAK
-case 166:
-YY_RULE_SETUP
-#line 299 "fortran.lex"
-;
-	YY_BREAK
-case 167:
-/* rule 167 can match eol */
-YY_RULE_SETUP
-#line 300 "fortran.lex"
-{line_num_fortran++;line_num_fortran_common++;newlinef90=1;colnum=0;}
-	YY_BREAK
-case 168:
-/* rule 168 can match eol */
-YY_RULE_SETUP
-#line 301 "fortran.lex"
-{line_num_fortran++;line_num_fortran_common++;colnum=0;}
-	YY_BREAK
-case 169:
-/* rule 169 can match eol */
-YY_RULE_SETUP
-#line 302 "fortran.lex"
-{
-                           convert2lower(motparse1);
-                           if ( strncasecmp(motparse1,"contains",8) == 0 )
-                           {
-                              return TOK_CONTAINS;
-                           }
-                           else
-                           {
-                            /*  colnum=0;line_num_fortran++;line_num_fortran_common++;*/
-                             if ( !strcasecmp(motparse1,"C$AGRIF_DO_NOT_TREAT\n")) 
-                             return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                             unput('\n');
-                           }
-                         }
-	YY_BREAK
-case 170:
-/* rule 170 can match eol */
-YY_RULE_SETUP
-#line 317 "fortran.lex"
-{
-                           convert2lower(&motparse1[1]);
-                           if ( strncasecmp(&motparse1[1],"contains",8) == 0 )
-                           {
-                              return TOK_CONTAINS;
-                           }
-                           else
-                           {
-                             /* colnum=0;line_num_fortran++;line_num_fortran_common++;*/
-                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_DO_NOT_TREAT\n")) 
-                             return TOK_DONOTTREAT;
-                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                             unput('\n');
-                           }
-                         }                            
-	YY_BREAK
-case 171:
-/* rule 171 can match eol */
-YY_RULE_SETUP
-#line 332 "fortran.lex"
-{
-						BEGIN(donottreat);
-						}
-	YY_BREAK
-case 172:
-/* rule 172 can match eol */
-YY_RULE_SETUP
-#line 335 "fortran.lex"
-{
-						BEGIN(INITIAL);
-                        if (infixed) BEGIN(fortran77style) ;
-                        if (infree) BEGIN(fortran90style)  ;
-                        line_num_fortran++;line_num_fortran_common++;
-                        return '\n';
-						}
-	YY_BREAK
-case 173:
-/* rule 173 can match eol */
-YY_RULE_SETUP
-#line 342 "fortran.lex"
-{line_num_fortran++;line_num_fortran_common++;}
-	YY_BREAK
-case 174:
-/* rule 174 can match eol */
-YY_RULE_SETUP
-#line 343 "fortran.lex"
-{
-                             colnum = 0;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                          }
-	YY_BREAK
-case 175:
-YY_RULE_SETUP
-#line 348 "fortran.lex"
-{
-                             colnum = 0;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                          }
-	YY_BREAK
-case 176:
-YY_RULE_SETUP
-#line 353 "fortran.lex"
-ECHO;
-	YY_BREAK
-#line 4224 "fortran.yy.c"
-case YY_STATE_EOF(INITIAL):
-case YY_STATE_EOF(parameter):
-case YY_STATE_EOF(character):
-case YY_STATE_EOF(donottreat):
-case YY_STATE_EOF(fortran77style):
-case YY_STATE_EOF(fortran90style):
-	yyterminate();
-
-	case YY_END_OF_BUFFER:
-		{
-		/* Amount of text matched not including the EOB char. */
-		int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
-
-		/* Undo the effects of YY_DO_BEFORE_ACTION. */
-		*yy_cp = (yy_hold_char);
-		YY_RESTORE_YY_MORE_OFFSET
-
-		if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
-			{
-			/* We're scanning a new file or input source.  It's
-			 * possible that this happened because the user
-			 * just pointed fortranin at a new source and called
-			 * fortranlex().  If so, then we have to assure
-			 * consistency between YY_CURRENT_BUFFER and our
-			 * globals.  Here is the right place to do so, because
-			 * this is the first action (other than possibly a
-			 * back-up) that will match for the new input source.
-			 */
-			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
-			YY_CURRENT_BUFFER_LVALUE->yy_input_file = fortranin;
-			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
-			}
-
-		/* Note that here we test for yy_c_buf_p "<=" to the position
-		 * of the first EOB in the buffer, since yy_c_buf_p will
-		 * already have been incremented past the NUL character
-		 * (since all states make transitions on EOB to the
-		 * end-of-buffer state).  Contrast this with the test
-		 * in input().
-		 */
-		if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
-			{ /* This was really a NUL. */
-			yy_state_type yy_next_state;
-
-			(yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
-
-			yy_current_state = yy_get_previous_state(  );
-
-			/* Okay, we're now positioned to make the NUL
-			 * transition.  We couldn't have
-			 * yy_get_previous_state() go ahead and do it
-			 * for us because it doesn't know how to deal
-			 * with the possibility of jamming (and we don't
-			 * want to build jamming into it because then it
-			 * will run more slowly).
-			 */
-
-			yy_next_state = yy_try_NUL_trans( yy_current_state );
-
-			yy_bp = (yytext_ptr) + YY_MORE_ADJ;
-
-			if ( yy_next_state )
-				{
-				/* Consume the NUL. */
-				yy_cp = ++(yy_c_buf_p);
-				yy_current_state = yy_next_state;
-				goto yy_match;
-				}
-
-			else
-				{
-				yy_cp = (yy_c_buf_p);
-				goto yy_find_action;
-				}
-			}
-
-		else switch ( yy_get_next_buffer(  ) )
-			{
-			case EOB_ACT_END_OF_FILE:
-				{
-				(yy_did_buffer_switch_on_eof) = 0;
-
-				if ( fortranwrap( ) )
-					{
-					/* Note: because we've taken care in
-					 * yy_get_next_buffer() to have set up
-					 * fortrantext, we can now set up
-					 * yy_c_buf_p so that if some total
-					 * hoser (like flex itself) wants to
-					 * call the scanner after we return the
-					 * YY_NULL, it'll still work - another
-					 * YY_NULL will get returned.
-					 */
-					(yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
-
-					yy_act = YY_STATE_EOF(YY_START);
-					goto do_action;
-					}
-
-				else
-					{
-					if ( ! (yy_did_buffer_switch_on_eof) )
-						YY_NEW_FILE;
-					}
-				break;
-				}
-
-			case EOB_ACT_CONTINUE_SCAN:
-				(yy_c_buf_p) =
-					(yytext_ptr) + yy_amount_of_matched_text;
-
-				yy_current_state = yy_get_previous_state(  );
-
-				yy_cp = (yy_c_buf_p);
-				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
-				goto yy_match;
-
-			case EOB_ACT_LAST_MATCH:
-				(yy_c_buf_p) =
-				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
-
-				yy_current_state = yy_get_previous_state(  );
-
-				yy_cp = (yy_c_buf_p);
-				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
-				goto yy_find_action;
-			}
-		break;
-		}
-
-	default:
-		YY_FATAL_ERROR(
-			"fatal flex scanner internal error--no action found" );
-	} /* end of action switch */
-		} /* end of scanning one token */
-} /* end of fortranlex */
-
-/* yy_get_next_buffer - try to read in a new buffer
- *
- * Returns a code representing an action:
- *	EOB_ACT_LAST_MATCH -
- *	EOB_ACT_CONTINUE_SCAN - continue scanning from current position
- *	EOB_ACT_END_OF_FILE - end of file
- */
-static int yy_get_next_buffer (void)
-{
-    	register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
-	register char *source = (yytext_ptr);
-	register int number_to_move, i;
-	int ret_val;
-
-	if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
-		YY_FATAL_ERROR(
-		"fatal flex scanner internal error--end of buffer missed" );
-
-	if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
-		{ /* Don't try to fill the buffer, so this is an EOF. */
-		if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
-			{
-			/* We matched a single character, the EOB, so
-			 * treat this as a final EOF.
-			 */
-			return EOB_ACT_END_OF_FILE;
-			}
-
-		else
-			{
-			/* We matched some text prior to the EOB, first
-			 * process it.
-			 */
-			return EOB_ACT_LAST_MATCH;
-			}
-		}
-
-	/* Try to read more data. */
-
-	/* First move last chars to start of buffer. */
-	number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
-
-	for ( i = 0; i < number_to_move; ++i )
-		*(dest++) = *(source++);
-
-	if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
-		/* don't do the read, it's not guaranteed to return an EOF,
-		 * just force an EOF
-		 */
-		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
-
-	else
-		{
-			yy_size_t num_to_read =
-			YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
-
-		while ( num_to_read <= 0 )
-			{ /* Not enough room in the buffer - grow it. */
-
-			/* just a shorter name for the current buffer */
-			YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
-
-			int yy_c_buf_p_offset =
-				(int) ((yy_c_buf_p) - b->yy_ch_buf);
-
-			if ( b->yy_is_our_buffer )
-				{
-				yy_size_t new_size = b->yy_buf_size * 2;
-
-				if ( new_size <= 0 )
-					b->yy_buf_size += b->yy_buf_size / 8;
-				else
-					b->yy_buf_size *= 2;
-
-				b->yy_ch_buf = (char *)
-					/* Include room in for 2 EOB chars. */
-					fortranrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
-				}
-			else
-				/* Can't grow it, we don't own it. */
-				b->yy_ch_buf = 0;
-
-			if ( ! b->yy_ch_buf )
-				YY_FATAL_ERROR(
-				"fatal error - scanner input buffer overflow" );
-
-			(yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];
-
-			num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -
-						number_to_move - 1;
-
-			}
-
-		if ( num_to_read > YY_READ_BUF_SIZE )
-			num_to_read = YY_READ_BUF_SIZE;
-
-		/* Read in more data. */
-		YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
-			(yy_n_chars), num_to_read );
-
-		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
-		}
-
-	if ( (yy_n_chars) == 0 )
-		{
-		if ( number_to_move == YY_MORE_ADJ )
-			{
-			ret_val = EOB_ACT_END_OF_FILE;
-			fortranrestart(fortranin  );
-			}
-
-		else
-			{
-			ret_val = EOB_ACT_LAST_MATCH;
-			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
-				YY_BUFFER_EOF_PENDING;
-			}
-		}
-
-	else
-		ret_val = EOB_ACT_CONTINUE_SCAN;
-
-	if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) {
-		/* Extend the array by 50%, plus the number we really need. */
-		yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
-		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) fortranrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
-		if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
-			YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
-	}
-
-	(yy_n_chars) += number_to_move;
-	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
-	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
-
-	(yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
-
-	return ret_val;
-}
-
-/* yy_get_previous_state - get the state just before the EOB char was reached */
-
-    static yy_state_type yy_get_previous_state (void)
-{
-	register yy_state_type yy_current_state;
-	register char *yy_cp;
-    
-	yy_current_state = (yy_start);
-	yy_current_state += YY_AT_BOL();
-
-	for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
-		{
-		register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
-		if ( yy_accept[yy_current_state] )
-			{
-			(yy_last_accepting_state) = yy_current_state;
-			(yy_last_accepting_cpos) = yy_cp;
-			}
-		while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
-			{
-			yy_current_state = (int) yy_def[yy_current_state];
-			if ( yy_current_state >= 1162 )
-				yy_c = yy_meta[(unsigned int) yy_c];
-			}
-		yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
-		}
-
-	return yy_current_state;
-}
-
-/* yy_try_NUL_trans - try to make a transition on the NUL character
- *
- * synopsis
- *	next_state = yy_try_NUL_trans( current_state );
- */
-    static yy_state_type yy_try_NUL_trans  (yy_state_type yy_current_state )
-{
-	register int yy_is_jam;
-    	register char *yy_cp = (yy_c_buf_p);
-
-	register YY_CHAR yy_c = 1;
-	if ( yy_accept[yy_current_state] )
-		{
-		(yy_last_accepting_state) = yy_current_state;
-		(yy_last_accepting_cpos) = yy_cp;
-		}
-	while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
-		{
-		yy_current_state = (int) yy_def[yy_current_state];
-		if ( yy_current_state >= 1162 )
-			yy_c = yy_meta[(unsigned int) yy_c];
-		}
-	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
-	yy_is_jam = (yy_current_state == 1161);
-
-	return yy_is_jam ? 0 : yy_current_state;
-}
-
-    static void yyunput (int c, register char * yy_bp )
-{
-	register char *yy_cp;
-    
-    yy_cp = (yy_c_buf_p);
-
-	/* undo effects of setting up fortrantext */
-	*yy_cp = (yy_hold_char);
-
-	if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
-		{ /* need to shift things up to make room */
-		/* +2 for EOB chars. */
-		register yy_size_t number_to_move = (yy_n_chars) + 2;
-		register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
-					YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
-		register char *source =
-				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
-
-		while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
-			*--dest = *--source;
-
-		yy_cp += (int) (dest - source);
-		yy_bp += (int) (dest - source);
-		YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
-			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
-
-		if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
-			YY_FATAL_ERROR( "flex scanner push-back overflow" );
-		}
-
-	*--yy_cp = (char) c;
-
-	(yytext_ptr) = yy_bp;
-	(yy_hold_char) = *yy_cp;
-	(yy_c_buf_p) = yy_cp;
-}
-
-#ifndef YY_NO_INPUT
-#ifdef __cplusplus
-    static int yyinput (void)
-#else
-    static int input  (void)
-#endif
-
-{
-	int c;
-    
-	*(yy_c_buf_p) = (yy_hold_char);
-
-	if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
-		{
-		/* yy_c_buf_p now points to the character we want to return.
-		 * If this occurs *before* the EOB characters, then it's a
-		 * valid NUL; if not, then we've hit the end of the buffer.
-		 */
-		if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
-			/* This was really a NUL. */
-			*(yy_c_buf_p) = '\0';
-
-		else
-			{ /* need more input */
-			yy_size_t offset = (yy_c_buf_p) - (yytext_ptr);
-			++(yy_c_buf_p);
-
-			switch ( yy_get_next_buffer(  ) )
-				{
-				case EOB_ACT_LAST_MATCH:
-					/* This happens because yy_g_n_b()
-					 * sees that we've accumulated a
-					 * token and flags that we need to
-					 * try matching the token before
-					 * proceeding.  But for input(),
-					 * there's no matching to consider.
-					 * So convert the EOB_ACT_LAST_MATCH
-					 * to EOB_ACT_END_OF_FILE.
-					 */
-
-					/* Reset buffer status. */
-					fortranrestart(fortranin );
-
-					/*FALLTHROUGH*/
-
-				case EOB_ACT_END_OF_FILE:
-					{
-					if ( fortranwrap( ) )
-						return 0;
-
-					if ( ! (yy_did_buffer_switch_on_eof) )
-						YY_NEW_FILE;
-#ifdef __cplusplus
-					return yyinput();
-#else
-					return input();
-#endif
-					}
-
-				case EOB_ACT_CONTINUE_SCAN:
-					(yy_c_buf_p) = (yytext_ptr) + offset;
-					break;
-				}
-			}
-		}
-
-	c = *(unsigned char *) (yy_c_buf_p);	/* cast for 8-bit char's */
-	*(yy_c_buf_p) = '\0';	/* preserve fortrantext */
-	(yy_hold_char) = *++(yy_c_buf_p);
-
-	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n');
-
-	return c;
-}
-#endif	/* ifndef YY_NO_INPUT */
-
-/** Immediately switch to a different input stream.
- * @param input_file A readable stream.
- * 
- * @note This function does not reset the start condition to @c INITIAL .
- */
-    void fortranrestart  (FILE * input_file )
-{
-    
-	if ( ! YY_CURRENT_BUFFER ){
-        fortranensure_buffer_stack ();
-		YY_CURRENT_BUFFER_LVALUE =
-            fortran_create_buffer(fortranin,YY_BUF_SIZE );
-	}
-
-	fortran_init_buffer(YY_CURRENT_BUFFER,input_file );
-	fortran_load_buffer_state( );
-}
-
-/** Switch to a different input buffer.
- * @param new_buffer The new input buffer.
- * 
- */
-    void fortran_switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
-{
-    
-	/* TODO. We should be able to replace this entire function body
-	 * with
-	 *		fortranpop_buffer_state();
-	 *		fortranpush_buffer_state(new_buffer);
-     */
-	fortranensure_buffer_stack ();
-	if ( YY_CURRENT_BUFFER == new_buffer )
-		return;
-
-	if ( YY_CURRENT_BUFFER )
-		{
-		/* Flush out information for old buffer. */
-		*(yy_c_buf_p) = (yy_hold_char);
-		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
-		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
-		}
-
-	YY_CURRENT_BUFFER_LVALUE = new_buffer;
-	fortran_load_buffer_state( );
-
-	/* We don't actually know whether we did this switch during
-	 * EOF (fortranwrap()) processing, but the only time this flag
-	 * is looked at is after fortranwrap() is called, so it's safe
-	 * to go ahead and always set it.
-	 */
-	(yy_did_buffer_switch_on_eof) = 1;
-}
-
-static void fortran_load_buffer_state  (void)
-{
-    	(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
-	(yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
-	fortranin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
-	(yy_hold_char) = *(yy_c_buf_p);
-}
-
-/** Allocate and initialize an input buffer state.
- * @param file A readable stream.
- * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
- * 
- * @return the allocated buffer state.
- */
-    YY_BUFFER_STATE fortran_create_buffer  (FILE * file, int  size )
-{
-	YY_BUFFER_STATE b;
-    
-	b = (YY_BUFFER_STATE) fortranalloc(sizeof( struct yy_buffer_state )  );
-	if ( ! b )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_create_buffer()" );
-
-	b->yy_buf_size = size;
-
-	/* yy_ch_buf has to be 2 characters longer than the size given because
-	 * we need to put in 2 end-of-buffer characters.
-	 */
-	b->yy_ch_buf = (char *) fortranalloc(b->yy_buf_size + 2  );
-	if ( ! b->yy_ch_buf )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_create_buffer()" );
-
-	b->yy_is_our_buffer = 1;
-
-	fortran_init_buffer(b,file );
-
-	return b;
-}
-
-/** Destroy the buffer.
- * @param b a buffer created with fortran_create_buffer()
- * 
- */
-    void fortran_delete_buffer (YY_BUFFER_STATE  b )
-{
-    
-	if ( ! b )
-		return;
-
-	if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
-		YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
-
-	if ( b->yy_is_our_buffer )
-		fortranfree((void *) b->yy_ch_buf  );
-
-	fortranfree((void *) b  );
-}
-
-#ifndef __cplusplus
-extern int isatty (int );
-#endif /* __cplusplus */
-    
-/* Initializes or reinitializes a buffer.
- * This function is sometimes called more than once on the same buffer,
- * such as during a fortranrestart() or at EOF.
- */
-    static void fortran_init_buffer  (YY_BUFFER_STATE  b, FILE * file )
-
-{
-	int oerrno = errno;
-    
-	fortran_flush_buffer(b );
-
-	b->yy_input_file = file;
-	b->yy_fill_buffer = 1;
-
-    /* If b is the current buffer, then fortran_init_buffer was _probably_
-     * called from fortranrestart() or through yy_get_next_buffer.
-     * In that case, we don't want to reset the lineno or column.
-     */
-    if (b != YY_CURRENT_BUFFER){
-        b->yy_bs_lineno = 1;
-        b->yy_bs_column = 0;
-    }
-
-        b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
-    
-	errno = oerrno;
-}
-
-/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
- * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
- * 
- */
-    void fortran_flush_buffer (YY_BUFFER_STATE  b )
-{
-    	if ( ! b )
-		return;
-
-	b->yy_n_chars = 0;
-
-	/* We always need two end-of-buffer characters.  The first causes
-	 * a transition to the end-of-buffer state.  The second causes
-	 * a jam in that state.
-	 */
-	b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
-	b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
-
-	b->yy_buf_pos = &b->yy_ch_buf[0];
-
-	b->yy_at_bol = 1;
-	b->yy_buffer_status = YY_BUFFER_NEW;
-
-	if ( b == YY_CURRENT_BUFFER )
-		fortran_load_buffer_state( );
-}
-
-/** Pushes the new state onto the stack. The new state becomes
- *  the current state. This function will allocate the stack
- *  if necessary.
- *  @param new_buffer The new state.
- *  
- */
-void fortranpush_buffer_state (YY_BUFFER_STATE new_buffer )
-{
-    	if (new_buffer == NULL)
-		return;
-
-	fortranensure_buffer_stack();
-
-	/* This block is copied from fortran_switch_to_buffer. */
-	if ( YY_CURRENT_BUFFER )
-		{
-		/* Flush out information for old buffer. */
-		*(yy_c_buf_p) = (yy_hold_char);
-		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
-		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
-		}
-
-	/* Only push if top exists. Otherwise, replace top. */
-	if (YY_CURRENT_BUFFER)
-		(yy_buffer_stack_top)++;
-	YY_CURRENT_BUFFER_LVALUE = new_buffer;
-
-	/* copied from fortran_switch_to_buffer. */
-	fortran_load_buffer_state( );
-	(yy_did_buffer_switch_on_eof) = 1;
-}
-
-/** Removes and deletes the top of the stack, if present.
- *  The next element becomes the new top.
- *  
- */
-void fortranpop_buffer_state (void)
-{
-    	if (!YY_CURRENT_BUFFER)
-		return;
-
-	fortran_delete_buffer(YY_CURRENT_BUFFER );
-	YY_CURRENT_BUFFER_LVALUE = NULL;
-	if ((yy_buffer_stack_top) > 0)
-		--(yy_buffer_stack_top);
-
-	if (YY_CURRENT_BUFFER) {
-		fortran_load_buffer_state( );
-		(yy_did_buffer_switch_on_eof) = 1;
-	}
-}
-
-/* Allocates the stack if it does not exist.
- *  Guarantees space for at least one push.
- */
-static void fortranensure_buffer_stack (void)
-{
-	yy_size_t num_to_alloc;
-    
-	if (!(yy_buffer_stack)) {
-
-		/* First allocation is just for 2 elements, since we don't know if this
-		 * scanner will even need a stack. We use 2 instead of 1 to avoid an
-		 * immediate realloc on the next call.
-         */
-		num_to_alloc = 1;
-		(yy_buffer_stack) = (struct yy_buffer_state**)fortranalloc
-								(num_to_alloc * sizeof(struct yy_buffer_state*)
-								);
-		if ( ! (yy_buffer_stack) )
-			YY_FATAL_ERROR( "out of dynamic memory in fortranensure_buffer_stack()" );
-								  
-		memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
-				
-		(yy_buffer_stack_max) = num_to_alloc;
-		(yy_buffer_stack_top) = 0;
-		return;
-	}
-
-	if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
-
-		/* Increase the buffer to prepare for a possible push. */
-		int grow_size = 8 /* arbitrary grow size */;
-
-		num_to_alloc = (yy_buffer_stack_max) + grow_size;
-		(yy_buffer_stack) = (struct yy_buffer_state**)fortranrealloc
-								((yy_buffer_stack),
-								num_to_alloc * sizeof(struct yy_buffer_state*)
-								);
-		if ( ! (yy_buffer_stack) )
-			YY_FATAL_ERROR( "out of dynamic memory in fortranensure_buffer_stack()" );
-
-		/* zero only the new slots.*/
-		memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
-		(yy_buffer_stack_max) = num_to_alloc;
-	}
-}
-
-/** Setup the input buffer state to scan directly from a user-specified character buffer.
- * @param base the character buffer
- * @param size the size in bytes of the character buffer
- * 
- * @return the newly allocated buffer state object. 
- */
-YY_BUFFER_STATE fortran_scan_buffer  (char * base, yy_size_t  size )
-{
-	YY_BUFFER_STATE b;
-    
-	if ( size < 2 ||
-	     base[size-2] != YY_END_OF_BUFFER_CHAR ||
-	     base[size-1] != YY_END_OF_BUFFER_CHAR )
-		/* They forgot to leave room for the EOB's. */
-		return 0;
-
-	b = (YY_BUFFER_STATE) fortranalloc(sizeof( struct yy_buffer_state )  );
-	if ( ! b )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_scan_buffer()" );
-
-	b->yy_buf_size = size - 2;	/* "- 2" to take care of EOB's */
-	b->yy_buf_pos = b->yy_ch_buf = base;
-	b->yy_is_our_buffer = 0;
-	b->yy_input_file = 0;
-	b->yy_n_chars = b->yy_buf_size;
-	b->yy_is_interactive = 0;
-	b->yy_at_bol = 1;
-	b->yy_fill_buffer = 0;
-	b->yy_buffer_status = YY_BUFFER_NEW;
-
-	fortran_switch_to_buffer(b  );
-
-	return b;
-}
-
-/** Setup the input buffer state to scan a string. The next call to fortranlex() will
- * scan from a @e copy of @a str.
- * @param yystr a NUL-terminated string to scan
- * 
- * @return the newly allocated buffer state object.
- * @note If you want to scan bytes that may contain NUL values, then use
- *       fortran_scan_bytes() instead.
- */
-YY_BUFFER_STATE fortran_scan_string (yyconst char * yystr )
-{
-    
-	return fortran_scan_bytes(yystr,strlen(yystr) );
-}
-
-/** Setup the input buffer state to scan the given bytes. The next call to fortranlex() will
- * scan from a @e copy of @a bytes.
- * @param bytes the byte buffer to scan
- * @param len the number of bytes in the buffer pointed to by @a bytes.
- * 
- * @return the newly allocated buffer state object.
- */
-YY_BUFFER_STATE fortran_scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
-{
-	YY_BUFFER_STATE b;
-	char *buf;
-	yy_size_t n, i;
-    
-	/* Get memory for full buffer, including space for trailing EOB's. */
-	n = _yybytes_len + 2;
-	buf = (char *) fortranalloc(n  );
-	if ( ! buf )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_scan_bytes()" );
-
-	for ( i = 0; i < _yybytes_len; ++i )
-		buf[i] = yybytes[i];
-
-	buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
-
-	b = fortran_scan_buffer(buf,n );
-	if ( ! b )
-		YY_FATAL_ERROR( "bad buffer in fortran_scan_bytes()" );
-
-	/* It's okay to grow etc. this buffer, and we should throw it
-	 * away when we're done.
-	 */
-	b->yy_is_our_buffer = 1;
-
-	return b;
-}
-
-#ifndef YY_EXIT_FAILURE
-#define YY_EXIT_FAILURE 2
-#endif
-
-static void yy_fatal_error (yyconst char* msg )
-{
-    	(void) fprintf( stderr, "%s\n", msg );
-	exit( YY_EXIT_FAILURE );
-}
-
-/* Redefine yyless() so it works in section 3 code. */
-
-#undef yyless
-#define yyless(n) \
-	do \
-		{ \
-		/* Undo effects of setting up fortrantext. */ \
-        int yyless_macro_arg = (n); \
-        YY_LESS_LINENO(yyless_macro_arg);\
-		fortrantext[fortranleng] = (yy_hold_char); \
-		(yy_c_buf_p) = fortrantext + yyless_macro_arg; \
-		(yy_hold_char) = *(yy_c_buf_p); \
-		*(yy_c_buf_p) = '\0'; \
-		fortranleng = yyless_macro_arg; \
-		} \
-	while ( 0 )
-
-/* Accessor  methods (get/set functions) to struct members. */
-
-/** Get the current line number.
- * 
- */
-int fortranget_lineno  (void)
-{
-        
-    return fortranlineno;
-}
-
-/** Get the input stream.
- * 
- */
-FILE *fortranget_in  (void)
-{
-        return fortranin;
-}
-
-/** Get the output stream.
- * 
- */
-FILE *fortranget_out  (void)
-{
-        return fortranout;
-}
-
-/** Get the length of the current token.
- * 
- */
-yy_size_t fortranget_leng  (void)
-{
-        return fortranleng;
-}
-
-/** Get the current token.
- * 
- */
-
-char *fortranget_text  (void)
-{
-        return fortrantext;
-}
-
-/** Set the current line number.
- * @param line_number
- * 
- */
-void fortranset_lineno (int  line_number )
-{
-    
-    fortranlineno = line_number;
-}
-
-/** Set the input stream. This does not discard the current
- * input buffer.
- * @param in_str A readable stream.
- * 
- * @see fortran_switch_to_buffer
- */
-void fortranset_in (FILE *  in_str )
-{
-        fortranin = in_str ;
-}
-
-void fortranset_out (FILE *  out_str )
-{
-        fortranout = out_str ;
-}
-
-int fortranget_debug  (void)
-{
-        return fortran_flex_debug;
-}
-
-void fortranset_debug (int  bdebug )
-{
-        fortran_flex_debug = bdebug ;
-}
-
-static int yy_init_globals (void)
-{
-        /* Initialization is the same as for the non-reentrant scanner.
-     * This function is called from fortranlex_destroy(), so don't allocate here.
-     */
-
-    (yy_buffer_stack) = 0;
-    (yy_buffer_stack_top) = 0;
-    (yy_buffer_stack_max) = 0;
-    (yy_c_buf_p) = (char *) 0;
-    (yy_init) = 0;
-    (yy_start) = 0;
-
-/* Defined in main.c */
-#ifdef YY_STDINIT
-    fortranin = stdin;
-    fortranout = stdout;
-#else
-    fortranin = (FILE *) 0;
-    fortranout = (FILE *) 0;
-#endif
-
-    /* For future reference: Set errno on error, since we are called by
-     * fortranlex_init()
-     */
-    return 0;
-}
-
-/* fortranlex_destroy is for both reentrant and non-reentrant scanners. */
-int fortranlex_destroy  (void)
-{
-    
-    /* Pop the buffer stack, destroying each element. */
-	while(YY_CURRENT_BUFFER){
-		fortran_delete_buffer(YY_CURRENT_BUFFER  );
-		YY_CURRENT_BUFFER_LVALUE = NULL;
-		fortranpop_buffer_state();
-	}
-
-	/* Destroy the stack itself. */
-	fortranfree((yy_buffer_stack) );
-	(yy_buffer_stack) = NULL;
-
-    /* Reset the globals. This is important in a non-reentrant scanner so the next time
-     * fortranlex() is called, initialization will occur. */
-    yy_init_globals( );
-
-    return 0;
-}
-
-/*
- * Internal utility routines.
- */
-
-#ifndef yytext_ptr
-static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
-{
-	register int i;
-	for ( i = 0; i < n; ++i )
-		s1[i] = s2[i];
-}
-#endif
-
-#ifdef YY_NEED_STRLEN
-static int yy_flex_strlen (yyconst char * s )
-{
-	register int n;
-	for ( n = 0; s[n]; ++n )
-		;
-
-	return n;
-}
-#endif
-
-void *fortranalloc (yy_size_t  size )
-{
-	return (void *) malloc( size );
-}
-
-void *fortranrealloc  (void * ptr, yy_size_t  size )
-{
-	/* The cast to (char *) in the following accommodates both
-	 * implementations that use char* generic pointers, and those
-	 * that use void* generic pointers.  It works with the latter
-	 * because both ANSI C and C++ allow castless assignment from
-	 * any pointer type to void*, and deal with argument conversions
-	 * as though doing an assignment.
-	 */
-	return (void *) realloc( (char *) ptr, size );
-}
-
-void fortranfree (void * ptr )
-{
-	free( (char *) ptr );	/* see fortranrealloc() for (char *) cast */
-}
-
-#define YYTABLES_NAME "yytables"
-
-#line 353 "fortran.lex"
-
-
-
-fortranerror(char *s)
-{
-   if (!strcasecmp(curfile,mainfile))
-   {
-      printf("%s line %d, file %s motclef = %s\n",s,line_num_fortran,curfile,fortrantext);
-   }
-   else
-   {
-      printf("%s line %d, file %s motclef = %s curbuf = %s\n",s,line_num_fortran_common,curfile,fortrantext,curbuf);
-   }
-/*   exit(0);*/
-}
-
-int fortranwrap()
-{
-}
-
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c	(revision 6808)
@@ -1,20 +1,23 @@
-/* A Bison parser, made by GNU Bison 2.7.12-4996.  */
-
-/* Bison implementation for Yacc-like parsers in C
-   
-      Copyright (C) 1984, 1989-1990, 2000-2013 Free Software Foundation, Inc.
-   
-   This program is free software: you can redistribute it and/or modify
+/* A Bison parser, made by GNU Bison 2.3.  */
+
+/* Skeleton implementation for Bison's Yacc-like parsers in C
+
+   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
+
+   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 3 of the License, or
-   (at your option) any later version.
-   
+   the Free Software Foundation; either version 2, 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, see <http://www.gnu.org/licenses/>.  */
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.  */
 
 /* As a special exception, you may create a larger work that contains
@@ -27,5 +30,5 @@
    Bison output files to be licensed under the GNU General Public
    License without this special exception.
-   
+
    This special exception was added by the Free Software Foundation in
    version 2.2 of Bison.  */
@@ -45,5 +48,5 @@
 
 /* Bison version.  */
-#define YYBISON_VERSION "2.7.12-4996"
+#define YYBISON_VERSION "2.3"
 
 /* Skeleton name.  */
@@ -53,49 +56,16 @@
 #define YYPURE 0
 
-/* Push parsers.  */
-#define YYPUSH 0
-
-/* Pull parsers.  */
-#define YYPULL 1
-
-
-
-
-/* Copy the first part of user declarations.  */
-/* Line 371 of yacc.c  */
-#line 35 "convert.y"
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include "decl.h"
-
-/* Line 371 of yacc.c  */
-#line 75 "convert.tab.c"
-
-# ifndef YY_NULL
-#  if defined __cplusplus && 201103L <= __cplusplus
-#   define YY_NULL nullptr
-#  else
-#   define YY_NULL 0
-#  endif
-# endif
-
-/* Enabling verbose error messages.  */
-#ifdef YYERROR_VERBOSE
-# undef YYERROR_VERBOSE
-# define YYERROR_VERBOSE 1
-#else
-# define YYERROR_VERBOSE 0
-#endif
-
-
-/* Enabling traces.  */
-#ifndef YYDEBUG
-# define YYDEBUG 0
-#endif
-#if YYDEBUG
-extern int yydebug;
-#endif
+/* Using locations.  */
+#define YYLSP_NEEDED 0
+
+/* Substitute the variable and function names.  */
+#define yyparse convert_parse
+#define yylex   convert_lex
+#define yyerror convert_error
+#define yylval  convert_lval
+#define yychar  convert_char
+#define yydebug convert_debug
+#define yynerrs convert_nerrs
+
 
 /* Tokens.  */
@@ -106,48 +76,80 @@
    enum yytokentype {
      TOK_SEP = 258,
-     TOK_USE = 259,
-     TOK_MODULEMAIN = 260,
-     TOK_NOTGRIDDEP = 261,
-     TOK_USEITEM = 262,
-     TOK_NAME = 263,
-     TOK_PROBTYPE = 264
+     TOK_KIND = 259,
+     TOK_EQUAL = 260,
+     TOK_USE = 261,
+     TOK_MODULEMAIN = 262,
+     TOK_NOTGRIDDEP = 263,
+     TOK_USEITEM = 264,
+     TOK_NAME = 265,
+     TOK_CSTINT = 266,
+     TOK_PROBTYPE = 267
    };
 #endif
-
+/* Tokens.  */
+#define TOK_SEP 258
+#define TOK_KIND 259
+#define TOK_EQUAL 260
+#define TOK_USE 261
+#define TOK_MODULEMAIN 262
+#define TOK_NOTGRIDDEP 263
+#define TOK_USEITEM 264
+#define TOK_NAME 265
+#define TOK_CSTINT 266
+#define TOK_PROBTYPE 267
+
+
+
+
+/* Copy the first part of user declarations.  */
+#line 35 "convert.y"
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+int line_num=1;
+extern FILE * convert_in;
+
+int convert_error(const char *s)
+{
+    printf("##\n## ERROR in conv: '%s' (line %d, file: %s)\n##\n", s, line_num, config_file);
+    exit(0);
+}
+
+
+
+/* Enabling traces.  */
+#ifndef YYDEBUG
+# define YYDEBUG 1
+#endif
+
+/* Enabling verbose error messages.  */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+/* Enabling the token table.  */
+#ifndef YYTOKEN_TABLE
+# define YYTOKEN_TABLE 0
+#endif
 
 #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
 typedef union YYSTYPE
-{
-/* Line 387 of yacc.c  */
-#line 42 "convert.y"
-
-       int ival;
-       char na[LONG_C];
-       listnom * ln;
-       
-
-/* Line 387 of yacc.c  */
-#line 131 "convert.tab.c"
-} YYSTYPE;
-# define YYSTYPE_IS_TRIVIAL 1
+#line 52 "convert.y"
+{
+    char na[LONG_M];
+}
+/* Line 193 of yacc.c.  */
+#line 149 "convert.tab.c"
+	YYSTYPE;
 # define yystype YYSTYPE /* obsolescent; will be withdrawn */
 # define YYSTYPE_IS_DECLARED 1
-#endif
-
-extern YYSTYPE yylval;
-
-#ifdef YYPARSE_PARAM
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void *YYPARSE_PARAM);
-#else
-int yyparse ();
-#endif
-#else /* ! YYPARSE_PARAM */
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void);
-#else
-int yyparse ();
-#endif
-#endif /* ! YYPARSE_PARAM */
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
 
 
@@ -155,6 +157,7 @@
 /* Copy the second part of user declarations.  */
 
-/* Line 390 of yacc.c  */
-#line 159 "convert.tab.c"
+
+/* Line 216 of yacc.c.  */
+#line 162 "convert.tab.c"
 
 #ifdef short
@@ -209,17 +212,9 @@
 #  if ENABLE_NLS
 #   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
-#   define YY_(Msgid) dgettext ("bison-runtime", Msgid)
+#   define YY_(msgid) dgettext ("bison-runtime", msgid)
 #  endif
 # endif
 # ifndef YY_
-#  define YY_(Msgid) Msgid
-# endif
-#endif
-
-#ifndef __attribute__
-/* This feature is available in gcc versions 2.5 and later.  */
-# if (! defined __GNUC__ || __GNUC__ < 2 \
-      || (__GNUC__ == 2 && __GNUC_MINOR__ < 5))
-#  define __attribute__(Spec) /* empty */
+#  define YY_(msgid) msgid
 # endif
 #endif
@@ -227,25 +222,24 @@
 /* Suppress unused-variable warnings by "using" E.  */
 #if ! defined lint || defined __GNUC__
-# define YYUSE(E) ((void) (E))
+# define YYUSE(e) ((void) (e))
 #else
-# define YYUSE(E) /* empty */
-#endif
-
+# define YYUSE(e) /* empty */
+#endif
 
 /* Identity function, used to suppress warnings about constant conditions.  */
 #ifndef lint
-# define YYID(N) (N)
+# define YYID(n) (n)
 #else
 #if (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 static int
-YYID (int yyi)
+YYID (int i)
 #else
 static int
-YYID (yyi)
-    int yyi;
-#endif
-{
-  return yyi;
+YYID (i)
+    int i;
+#endif
+{
+  return i;
 }
 #endif
@@ -268,10 +262,9 @@
 #   else
 #    define YYSTACK_ALLOC alloca
-#    if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
+#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 #     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-      /* Use EXIT_SUCCESS as a witness for stdlib.h.  */
-#     ifndef EXIT_SUCCESS
-#      define EXIT_SUCCESS 0
+#     ifndef _STDLIB_H
+#      define _STDLIB_H 1
 #     endif
 #    endif
@@ -296,15 +289,15 @@
 #   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
 #  endif
-#  if (defined __cplusplus && ! defined EXIT_SUCCESS \
+#  if (defined __cplusplus && ! defined _STDLIB_H \
        && ! ((defined YYMALLOC || defined malloc) \
 	     && (defined YYFREE || defined free)))
 #   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-#   ifndef EXIT_SUCCESS
-#    define EXIT_SUCCESS 0
+#   ifndef _STDLIB_H
+#    define _STDLIB_H 1
 #   endif
 #  endif
 #  ifndef YYMALLOC
 #   define YYMALLOC malloc
-#   if ! defined malloc && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
+#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
@@ -313,5 +306,5 @@
 #  ifndef YYFREE
 #   define YYFREE free
-#   if ! defined free && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
+#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 void free (void *); /* INFRINGES ON USER NAME SPACE */
@@ -329,7 +322,7 @@
 union yyalloc
 {
-  yytype_int16 yyss_alloc;
-  YYSTYPE yyvs_alloc;
-};
+  yytype_int16 yyss;
+  YYSTYPE yyvs;
+  };
 
 /* The size of the maximum gap between one aligned stack and the next.  */
@@ -342,5 +335,21 @@
       + YYSTACK_GAP_MAXIMUM)
 
-# define YYCOPY_NEEDED 1
+/* Copy COUNT objects from FROM to TO.  The source and destination do
+   not overlap.  */
+# ifndef YYCOPY
+#  if defined __GNUC__ && 1 < __GNUC__
+#   define YYCOPY(To, From, Count) \
+      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
+#  else
+#   define YYCOPY(To, From, Count)		\
+      do					\
+	{					\
+	  YYSIZE_T yyi;				\
+	  for (yyi = 0; yyi < (Count); yyi++)	\
+	    (To)[yyi] = (From)[yyi];		\
+	}					\
+      while (YYID (0))
+#  endif
+# endif
 
 /* Relocate STACK from its old location to the new one.  The
@@ -349,10 +358,10 @@
    stack.  Advance YYPTR to a properly aligned location for the next
    stack.  */
-# define YYSTACK_RELOCATE(Stack_alloc, Stack)				\
+# define YYSTACK_RELOCATE(Stack)					\
     do									\
       {									\
 	YYSIZE_T yynewbytes;						\
-	YYCOPY (&yyptr->Stack_alloc, Stack, yysize);			\
-	Stack = &yyptr->Stack_alloc;					\
+	YYCOPY (&yyptr->Stack, Stack, yysize);				\
+	Stack = &yyptr->Stack;						\
 	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
 	yyptr += yynewbytes / sizeof (*yyptr);				\
@@ -362,41 +371,21 @@
 #endif
 
-#if defined YYCOPY_NEEDED && YYCOPY_NEEDED
-/* Copy COUNT objects from SRC to DST.  The source and destination do
-   not overlap.  */
-# ifndef YYCOPY
-#  if defined __GNUC__ && 1 < __GNUC__
-#   define YYCOPY(Dst, Src, Count) \
-      __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src)))
-#  else
-#   define YYCOPY(Dst, Src, Count)              \
-      do                                        \
-        {                                       \
-          YYSIZE_T yyi;                         \
-          for (yyi = 0; yyi < (Count); yyi++)   \
-            (Dst)[yyi] = (Src)[yyi];            \
-        }                                       \
-      while (YYID (0))
-#  endif
-# endif
-#endif /* !YYCOPY_NEEDED */
-
 /* YYFINAL -- State number of the termination state.  */
 #define YYFINAL  2
 /* YYLAST -- Last index in YYTABLE.  */
-#define YYLAST   23
+#define YYLAST   29
 
 /* YYNTOKENS -- Number of terminals.  */
-#define YYNTOKENS  18
+#define YYNTOKENS  16
 /* YYNNTS -- Number of nonterminals.  */
 #define YYNNTS  3
 /* YYNRULES -- Number of rules.  */
-#define YYNRULES  10
+#define YYNRULES  11
 /* YYNRULES -- Number of states.  */
-#define YYNSTATES  24
+#define YYNSTATES  29
 
 /* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
 #define YYUNDEFTOK  2
-#define YYMAXUTOK   264
+#define YYMAXUTOK   267
 
 #define YYTRANSLATE(YYX)						\
@@ -407,13 +396,13 @@
 {
        0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-      17,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+      15,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-      13,    14,     2,     2,    10,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,    12,    11,
+       2,     2,     2,     2,    13,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,    14,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,    15,     2,    16,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
@@ -432,5 +421,5 @@
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     1,     2,     3,     4,
-       5,     6,     7,     8,     9
+       5,     6,     7,     8,     9,    10,    11,    12
 };
 
@@ -441,5 +430,5 @@
 {
        0,     0,     3,     4,     7,     9,    13,    19,    27,    31,
-      36
+      37,    42
 };
 
@@ -447,8 +436,9 @@
 static const yytype_int8 yyrhs[] =
 {
-      19,     0,    -1,    -1,    19,    20,    -1,    17,    -1,     9,
-       8,    11,    -1,     9,     8,    10,     8,    11,    -1,     9,
-       8,    10,     8,    10,     8,    11,    -1,     5,     8,    11,
-      -1,     6,     3,     8,    11,    -1,     4,     7,    11,    -1
+      17,     0,    -1,    -1,    17,    18,    -1,    15,    -1,    12,
+      10,    14,    -1,    12,    10,    13,    10,    14,    -1,    12,
+      10,    13,    10,    13,    10,    14,    -1,     7,    10,    14,
+      -1,     4,    10,     5,    11,    14,    -1,     8,     3,    10,
+      14,    -1,     6,     9,    14,    -1
 };
 
@@ -456,18 +446,18 @@
 static const yytype_uint8 yyrline[] =
 {
-       0,    63,    63,    64,    66,    67,    68,    69,    71,    74,
-      75
+       0,    71,    71,    72,    75,    76,    77,    78,    79,    84,
+     100,   104
 };
 #endif
 
-#if YYDEBUG || YYERROR_VERBOSE || 0
+#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
 /* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
    First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
 static const char *const yytname[] =
 {
-  "$end", "error", "$undefined", "TOK_SEP", "TOK_USE", "TOK_MODULEMAIN",
-  "TOK_NOTGRIDDEP", "TOK_USEITEM", "TOK_NAME", "TOK_PROBTYPE", "','",
-  "';'", "':'", "'('", "')'", "'['", "']'", "'\\n'", "$accept", "input",
-  "line", YY_NULL
+  "$end", "error", "$undefined", "TOK_SEP", "TOK_KIND", "TOK_EQUAL",
+  "TOK_USE", "TOK_MODULEMAIN", "TOK_NOTGRIDDEP", "TOK_USEITEM", "TOK_NAME",
+  "TOK_CSTINT", "TOK_PROBTYPE", "','", "';'", "'\\n'", "$accept", "input",
+  "line", 0
 };
 #endif
@@ -479,5 +469,5 @@
 {
        0,   256,   257,   258,   259,   260,   261,   262,   263,   264,
-      44,    59,    58,    40,    41,    91,    93,    10
+     265,   266,   267,    44,    59,    10
 };
 # endif
@@ -486,6 +476,6 @@
 static const yytype_uint8 yyr1[] =
 {
-       0,    18,    19,    19,    20,    20,    20,    20,    20,    20,
-      20
+       0,    16,    17,    17,    18,    18,    18,    18,    18,    18,
+      18,    18
 };
 
@@ -493,16 +483,16 @@
 static const yytype_uint8 yyr2[] =
 {
-       0,     2,     0,     2,     1,     3,     5,     7,     3,     4,
-       3
+       0,     2,     0,     2,     1,     3,     5,     7,     3,     5,
+       4,     3
 };
 
-/* YYDEFACT[STATE-NAME] -- Default reduction number in state STATE-NUM.
-   Performed when YYTABLE doesn't specify something else to do.  Zero
+/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
+   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
    means the default is an error.  */
 static const yytype_uint8 yydefact[] =
 {
-       2,     0,     1,     0,     0,     0,     0,     4,     3,     0,
-       0,     0,     0,    10,     8,     0,     0,     5,     9,     0,
-       0,     6,     0,     7
+       2,     0,     1,     0,     0,     0,     0,     0,     4,     3,
+       0,     0,     0,     0,     0,     0,    11,     8,     0,     0,
+       5,     0,    10,     0,     9,     0,     6,     0,     7
 };
 
@@ -510,15 +500,15 @@
 static const yytype_int8 yydefgoto[] =
 {
-      -1,     1,     8
+      -1,     1,     9
 };
 
 /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
    STATE-NUM.  */
-#define YYPACT_NINF -10
+#define YYPACT_NINF -13
 static const yytype_int8 yypact[] =
 {
-     -10,     0,   -10,    -4,     2,     8,     4,   -10,   -10,     3,
-       5,     7,    -9,   -10,   -10,     9,    10,   -10,   -10,    -3,
-      11,   -10,    12,   -10
+     -13,     0,   -13,    -7,     2,    -5,    10,     4,   -13,   -13,
+      11,     3,     5,     8,   -12,     9,   -13,   -13,     7,    12,
+     -13,    13,   -13,    -4,   -13,    14,   -13,    15,   -13
 };
 
@@ -526,29 +516,24 @@
 static const yytype_int8 yypgoto[] =
 {
-     -10,   -10,   -10
+     -13,   -13,   -13
 };
 
 /* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
    positive, shift that token.  If negative, reduce the rule which
-   number is the opposite.  If YYTABLE_NINF, syntax error.  */
+   number is the opposite.  If zero, do what YYDEFACT says.
+   If YYTABLE_NINF, syntax error.  */
 #define YYTABLE_NINF -1
 static const yytype_uint8 yytable[] =
 {
-       2,    16,    17,     9,     3,     4,     5,    20,    21,     6,
-      10,    11,    12,     0,    13,    15,    14,     7,    19,    22,
-      18,     0,     0,    23
+       2,    19,    20,    10,     3,    12,     4,     5,     6,    25,
+      26,    11,     7,    13,    14,     8,    15,    16,    18,    17,
+      21,    22,    23,     0,    27,     0,     0,    24,     0,    28
 };
 
-#define yypact_value_is_default(Yystate) \
-  (!!((Yystate) == (-10)))
-
-#define yytable_value_is_error(Yytable_value) \
-  YYID (0)
-
 static const yytype_int8 yycheck[] =
 {
-       0,    10,    11,     7,     4,     5,     6,    10,    11,     9,
-       8,     3,     8,    -1,    11,     8,    11,    17,     8,     8,
-      11,    -1,    -1,    11
+       0,    13,    14,    10,     4,    10,     6,     7,     8,    13,
+      14,     9,    12,     3,    10,    15,     5,    14,    10,    14,
+      11,    14,    10,    -1,    10,    -1,    -1,    14,    -1,    14
 };
 
@@ -557,7 +542,7 @@
 static const yytype_uint8 yystos[] =
 {
-       0,    19,     0,     4,     5,     6,     9,    17,    20,     7,
-       8,     3,     8,    11,    11,     8,    10,    11,    11,     8,
-      10,    11,     8,    11
+       0,    17,     0,     4,     6,     7,     8,    12,    15,    18,
+      10,     9,    10,     3,    10,     5,    14,    14,    10,    13,
+      14,    11,    14,    10,    14,    13,    14,    10,    14
 };
 
@@ -574,31 +559,22 @@
 /* Like YYERROR except do call yyerror.  This remains here temporarily
    to ease the transition to the new meaning of YYERROR, for GCC.
-   Once GCC version 2 has supplanted version 1, this can go.  However,
-   YYFAIL appears to be in use.  Nevertheless, it is formally deprecated
-   in Bison 2.4.2's NEWS entry, where a plan to phase it out is
-   discussed.  */
+   Once GCC version 2 has supplanted version 1, this can go.  */
 
 #define YYFAIL		goto yyerrlab
-#if defined YYFAIL
-  /* This is here to suppress warnings from the GCC cpp's
-     -Wunused-macros.  Normally we don't worry about that warning, but
-     some users do, and we want to make it easy for users to remove
-     YYFAIL uses, which will produce warnings from Bison 2.5.  */
-#endif
 
 #define YYRECOVERING()  (!!yyerrstatus)
 
-#define YYBACKUP(Token, Value)                                  \
-do                                                              \
-  if (yychar == YYEMPTY)                                        \
-    {                                                           \
-      yychar = (Token);                                         \
-      yylval = (Value);                                         \
-      YYPOPSTACK (yylen);                                       \
-      yystate = *yyssp;                                         \
-      goto yybackup;                                            \
-    }                                                           \
-  else                                                          \
-    {                                                           \
+#define YYBACKUP(Token, Value)					\
+do								\
+  if (yychar == YYEMPTY && yylen == 1)				\
+    {								\
+      yychar = (Token);						\
+      yylval = (Value);						\
+      yytoken = YYTRANSLATE (yychar);				\
+      YYPOPSTACK (1);						\
+      goto yybackup;						\
+    }								\
+  else								\
+    {								\
       yyerror (YY_("syntax error: cannot back up")); \
       YYERROR;							\
@@ -606,16 +582,53 @@
 while (YYID (0))
 
-/* Error token number */
+
 #define YYTERROR	1
 #define YYERRCODE	256
 
 
-/* This macro is provided for backward compatibility. */
+/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
+   If N is 0, then set CURRENT to the empty location which ends
+   the previous symbol: RHS[0] (always defined).  */
+
+#define YYRHSLOC(Rhs, K) ((Rhs)[K])
+#ifndef YYLLOC_DEFAULT
+# define YYLLOC_DEFAULT(Current, Rhs, N)				\
+    do									\
+      if (YYID (N))                                                    \
+	{								\
+	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
+	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
+	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
+	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
+	}								\
+      else								\
+	{								\
+	  (Current).first_line   = (Current).last_line   =		\
+	    YYRHSLOC (Rhs, 0).last_line;				\
+	  (Current).first_column = (Current).last_column =		\
+	    YYRHSLOC (Rhs, 0).last_column;				\
+	}								\
+    while (YYID (0))
+#endif
+
+
+/* YY_LOCATION_PRINT -- Print the location on the stream.
+   This macro was not mandated originally: define only if we know
+   we won't break user code: when these are the locations we know.  */
+
 #ifndef YY_LOCATION_PRINT
-# define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
+#  define YY_LOCATION_PRINT(File, Loc)			\
+     fprintf (File, "%d.%d-%d.%d",			\
+	      (Loc).first_line, (Loc).first_column,	\
+	      (Loc).last_line,  (Loc).last_column)
+# else
+#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+# endif
 #endif
 
 
 /* YYLEX -- calling `yylex' with the right arguments.  */
+
 #ifdef YYLEX_PARAM
 # define YYLEX yylex (YYLEX_PARAM)
@@ -667,6 +680,4 @@
 #endif
 {
-  FILE *yyo = yyoutput;
-  YYUSE (yyo);
   if (!yyvaluep)
     return;
@@ -677,5 +688,9 @@
   YYUSE (yyoutput);
 # endif
-  YYUSE (yytype);
+  switch (yytype)
+    {
+      default:
+	break;
+    }
 }
 
@@ -714,18 +729,15 @@
      || defined __cplusplus || defined _MSC_VER)
 static void
-yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop)
+yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
 #else
 static void
-yy_stack_print (yybottom, yytop)
-    yytype_int16 *yybottom;
-    yytype_int16 *yytop;
+yy_stack_print (bottom, top)
+    yytype_int16 *bottom;
+    yytype_int16 *top;
 #endif
 {
   YYFPRINTF (stderr, "Stack now");
-  for (; yybottom <= yytop; yybottom++)
-    {
-      int yybot = *yybottom;
-      YYFPRINTF (stderr, " %d", yybot);
-    }
+  for (; bottom <= top; ++bottom)
+    YYFPRINTF (stderr, " %d", *bottom);
   YYFPRINTF (stderr, "\n");
 }
@@ -761,9 +773,9 @@
   for (yyi = 0; yyi < yynrhs; yyi++)
     {
-      YYFPRINTF (stderr, "   $%d = ", yyi + 1);
+      fprintf (stderr, "   $%d = ", yyi + 1);
       yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
 		       &(yyvsp[(yyi + 1) - (yynrhs)])
 		       		       );
-      YYFPRINTF (stderr, "\n");
+      fprintf (stderr, "\n");
     }
 }
@@ -801,4 +813,6 @@
 # define YYMAXDEPTH 10000
 #endif
+
+
 
 
@@ -904,143 +918,114 @@
 # endif
 
-/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message
-   about the unexpected token YYTOKEN for the state stack whose top is
-   YYSSP.
-
-   Return 0 if *YYMSG was successfully written.  Return 1 if *YYMSG is
-   not large enough to hold the message.  In that case, also set
-   *YYMSG_ALLOC to the required number of bytes.  Return 2 if the
-   required number of bytes is too large to store.  */
-static int
-yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg,
-                yytype_int16 *yyssp, int yytoken)
-{
-  YYSIZE_T yysize0 = yytnamerr (YY_NULL, yytname[yytoken]);
-  YYSIZE_T yysize = yysize0;
-  enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
-  /* Internationalized format string. */
-  const char *yyformat = YY_NULL;
-  /* Arguments of yyformat. */
-  char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
-  /* Number of reported tokens (one for the "unexpected", one per
-     "expected"). */
-  int yycount = 0;
-
-  /* There are many possibilities here to consider:
-     - Assume YYFAIL is not used.  It's too flawed to consider.  See
-       <http://lists.gnu.org/archive/html/bison-patches/2009-12/msg00024.html>
-       for details.  YYERROR is fine as it does not invoke this
-       function.
-     - If this state is a consistent state with a default action, then
-       the only way this function was invoked is if the default action
-       is an error action.  In that case, don't check for expected
-       tokens because there are none.
-     - The only way there can be no lookahead present (in yychar) is if
-       this state is a consistent state with a default action.  Thus,
-       detecting the absence of a lookahead is sufficient to determine
-       that there is no unexpected or expected token to report.  In that
-       case, just report a simple "syntax error".
-     - Don't assume there isn't a lookahead just because this state is a
-       consistent state with a default action.  There might have been a
-       previous inconsistent state, consistent state with a non-default
-       action, or user semantic action that manipulated yychar.
-     - Of course, the expected token list depends on states to have
-       correct lookahead information, and it depends on the parser not
-       to perform extra reductions after fetching a lookahead from the
-       scanner and before detecting a syntax error.  Thus, state merging
-       (from LALR or IELR) and default reductions corrupt the expected
-       token list.  However, the list is correct for canonical LR with
-       one exception: it will still contain any token that will not be
-       accepted due to an error action in a later state.
-  */
-  if (yytoken != YYEMPTY)
+/* Copy into YYRESULT an error message about the unexpected token
+   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
+   including the terminating null byte.  If YYRESULT is null, do not
+   copy anything; just return the number of bytes that would be
+   copied.  As a special case, return 0 if an ordinary "syntax error"
+   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
+   size calculation.  */
+static YYSIZE_T
+yysyntax_error (char *yyresult, int yystate, int yychar)
+{
+  int yyn = yypact[yystate];
+
+  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
+    return 0;
+  else
     {
-      int yyn = yypact[*yyssp];
-      yyarg[yycount++] = yytname[yytoken];
-      if (!yypact_value_is_default (yyn))
-        {
-          /* Start YYX at -YYN if negative to avoid negative indexes in
-             YYCHECK.  In other words, skip the first -YYN actions for
-             this state because they are default actions.  */
-          int yyxbegin = yyn < 0 ? -yyn : 0;
-          /* Stay within bounds of both yycheck and yytname.  */
-          int yychecklim = YYLAST - yyn + 1;
-          int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
-          int yyx;
-
-          for (yyx = yyxbegin; yyx < yyxend; ++yyx)
-            if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR
-                && !yytable_value_is_error (yytable[yyx + yyn]))
-              {
-                if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
-                  {
-                    yycount = 1;
-                    yysize = yysize0;
-                    break;
-                  }
-                yyarg[yycount++] = yytname[yyx];
-                {
-                  YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULL, yytname[yyx]);
-                  if (! (yysize <= yysize1
-                         && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
-                    return 2;
-                  yysize = yysize1;
-                }
-              }
-        }
+      int yytype = YYTRANSLATE (yychar);
+      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
+      YYSIZE_T yysize = yysize0;
+      YYSIZE_T yysize1;
+      int yysize_overflow = 0;
+      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+      int yyx;
+
+# if 0
+      /* This is so xgettext sees the translatable formats that are
+	 constructed on the fly.  */
+      YY_("syntax error, unexpected %s");
+      YY_("syntax error, unexpected %s, expecting %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
+# endif
+      char *yyfmt;
+      char const *yyf;
+      static char const yyunexpected[] = "syntax error, unexpected %s";
+      static char const yyexpecting[] = ", expecting %s";
+      static char const yyor[] = " or %s";
+      char yyformat[sizeof yyunexpected
+		    + sizeof yyexpecting - 1
+		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
+		       * (sizeof yyor - 1))];
+      char const *yyprefix = yyexpecting;
+
+      /* Start YYX at -YYN if negative to avoid negative indexes in
+	 YYCHECK.  */
+      int yyxbegin = yyn < 0 ? -yyn : 0;
+
+      /* Stay within bounds of both yycheck and yytname.  */
+      int yychecklim = YYLAST - yyn + 1;
+      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+      int yycount = 1;
+
+      yyarg[0] = yytname[yytype];
+      yyfmt = yystpcpy (yyformat, yyunexpected);
+
+      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+	  {
+	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+	      {
+		yycount = 1;
+		yysize = yysize0;
+		yyformat[sizeof yyunexpected - 1] = '\0';
+		break;
+	      }
+	    yyarg[yycount++] = yytname[yyx];
+	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
+	    yysize_overflow |= (yysize1 < yysize);
+	    yysize = yysize1;
+	    yyfmt = yystpcpy (yyfmt, yyprefix);
+	    yyprefix = yyor;
+	  }
+
+      yyf = YY_(yyformat);
+      yysize1 = yysize + yystrlen (yyf);
+      yysize_overflow |= (yysize1 < yysize);
+      yysize = yysize1;
+
+      if (yysize_overflow)
+	return YYSIZE_MAXIMUM;
+
+      if (yyresult)
+	{
+	  /* Avoid sprintf, as that infringes on the user's name space.
+	     Don't have undefined behavior even if the translation
+	     produced a string with the wrong number of "%s"s.  */
+	  char *yyp = yyresult;
+	  int yyi = 0;
+	  while ((*yyp = *yyf) != '\0')
+	    {
+	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
+		{
+		  yyp += yytnamerr (yyp, yyarg[yyi++]);
+		  yyf += 2;
+		}
+	      else
+		{
+		  yyp++;
+		  yyf++;
+		}
+	    }
+	}
+      return yysize;
     }
-
-  switch (yycount)
-    {
-# define YYCASE_(N, S)                      \
-      case N:                               \
-        yyformat = S;                       \
-      break
-      YYCASE_(0, YY_("syntax error"));
-      YYCASE_(1, YY_("syntax error, unexpected %s"));
-      YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s"));
-      YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s"));
-      YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s"));
-      YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"));
-# undef YYCASE_
-    }
-
-  {
-    YYSIZE_T yysize1 = yysize + yystrlen (yyformat);
-    if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
-      return 2;
-    yysize = yysize1;
-  }
-
-  if (*yymsg_alloc < yysize)
-    {
-      *yymsg_alloc = 2 * yysize;
-      if (! (yysize <= *yymsg_alloc
-             && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM))
-        *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM;
-      return 1;
-    }
-
-  /* Avoid sprintf, as that infringes on the user's name space.
-     Don't have undefined behavior even if the translation
-     produced a string with the wrong number of "%s"s.  */
-  {
-    char *yyp = *yymsg;
-    int yyi = 0;
-    while ((*yyp = *yyformat) != '\0')
-      if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount)
-        {
-          yyp += yytnamerr (yyp, yyarg[yyi++]);
-          yyformat += 2;
-        }
-      else
-        {
-          yyp++;
-          yyformat++;
-        }
-  }
-  return 0;
 }
 #endif /* YYERROR_VERBOSE */
+
+
 
 /*-----------------------------------------------.
@@ -1067,27 +1052,41 @@
   YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
 
-  YYUSE (yytype);
-}
-
-
-
-
-/* The lookahead symbol.  */
+  switch (yytype)
+    {
+
+      default:
+	break;
+    }
+}
+
+
+
+/* Prevent warnings from -Wmissing-prototypes.  */
+
+#ifdef YYPARSE_PARAM
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void *YYPARSE_PARAM);
+#else
+int yyparse ();
+#endif
+#else /* ! YYPARSE_PARAM */
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void);
+#else
+int yyparse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+/* The look-ahead symbol.  */
 int yychar;
 
-
-#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
-# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
-# define YY_IGNORE_MAYBE_UNINITIALIZED_END
-#endif
-#ifndef YY_INITIAL_VALUE
-# define YY_INITIAL_VALUE(Value) /* Nothing. */
-#endif
-
-/* The semantic value of the lookahead symbol.  */
-YYSTYPE yylval YY_INITIAL_VALUE(yyval_default);
+/* The semantic value of the look-ahead symbol.  */
+YYSTYPE yylval;
 
 /* Number of syntax errors so far.  */
 int yynerrs;
+
 
 
@@ -1118,35 +1117,12 @@
 #endif
 {
-    int yystate;
-    /* Number of tokens to shift before error messages enabled.  */
-    int yyerrstatus;
-
-    /* The stacks and their tools:
-       `yyss': related to states.
-       `yyvs': related to semantic values.
-
-       Refer to the stacks through separate pointers, to allow yyoverflow
-       to reallocate them elsewhere.  */
-
-    /* The state stack.  */
-    yytype_int16 yyssa[YYINITDEPTH];
-    yytype_int16 *yyss;
-    yytype_int16 *yyssp;
-
-    /* The semantic value stack.  */
-    YYSTYPE yyvsa[YYINITDEPTH];
-    YYSTYPE *yyvs;
-    YYSTYPE *yyvsp;
-
-    YYSIZE_T yystacksize;
-
+  
+  int yystate;
   int yyn;
   int yyresult;
-  /* Lookahead token as an internal (translated) token number.  */
+  /* Number of tokens to shift before error messages enabled.  */
+  int yyerrstatus;
+  /* Look-ahead token as an internal (translated) token number.  */
   int yytoken = 0;
-  /* The variables used to return semantic value and location from the
-     action routines.  */
-  YYSTYPE yyval;
-
 #if YYERROR_VERBOSE
   /* Buffer for error messages, and its allocated size.  */
@@ -1156,5 +1132,32 @@
 #endif
 
+  /* Three stacks and their tools:
+     `yyss': related to states,
+     `yyvs': related to semantic values,
+     `yyls': related to locations.
+
+     Refer to the stacks thru separate pointers, to allow yyoverflow
+     to reallocate them elsewhere.  */
+
+  /* The state stack.  */
+  yytype_int16 yyssa[YYINITDEPTH];
+  yytype_int16 *yyss = yyssa;
+  yytype_int16 *yyssp;
+
+  /* The semantic value stack.  */
+  YYSTYPE yyvsa[YYINITDEPTH];
+  YYSTYPE *yyvs = yyvsa;
+  YYSTYPE *yyvsp;
+
+
+
 #define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N))
+
+  YYSIZE_T yystacksize = YYINITDEPTH;
+
+  /* The variables used to return semantic value and location from the
+     action routines.  */
+  YYSTYPE yyval;
+
 
   /* The number of symbols on the RHS of the reduced rule.
@@ -1162,8 +1165,4 @@
   int yylen = 0;
 
-  yyssp = yyss = yyssa;
-  yyvsp = yyvs = yyvsa;
-  yystacksize = YYINITDEPTH;
-
   YYDPRINTF ((stderr, "Starting parse\n"));
 
@@ -1171,5 +1170,14 @@
   yyerrstatus = 0;
   yynerrs = 0;
-  yychar = YYEMPTY; /* Cause a token to be read.  */
+  yychar = YYEMPTY;		/* Cause a token to be read.  */
+
+  /* Initialize stack pointers.
+     Waste one element of value and location stack
+     so that they stay on the same level as the state stack.
+     The wasted elements are never initialized.  */
+
+  yyssp = yyss;
+  yyvsp = yyvs;
+
   goto yysetstate;
 
@@ -1198,4 +1206,5 @@
 	yytype_int16 *yyss1 = yyss;
 
+
 	/* Each stack pointer address is followed by the size of the
 	   data in use in that stack, in bytes.  This used to be a
@@ -1205,4 +1214,5 @@
 		    &yyss1, yysize * sizeof (*yyssp),
 		    &yyvs1, yysize * sizeof (*yyvsp),
+
 		    &yystacksize);
 
@@ -1227,6 +1237,7 @@
 	if (! yyptr)
 	  goto yyexhaustedlab;
-	YYSTACK_RELOCATE (yyss_alloc, yyss);
-	YYSTACK_RELOCATE (yyvs_alloc, yyvs);
+	YYSTACK_RELOCATE (yyss);
+	YYSTACK_RELOCATE (yyvs);
+
 #  undef YYSTACK_RELOCATE
 	if (yyss1 != yyssa)
@@ -1239,4 +1250,5 @@
       yyvsp = yyvs + yysize - 1;
 
+
       YYDPRINTF ((stderr, "Stack size increased to %lu\n",
 		  (unsigned long int) yystacksize));
@@ -1247,7 +1259,4 @@
 
   YYDPRINTF ((stderr, "Entering state %d\n", yystate));
-
-  if (yystate == YYFINAL)
-    YYACCEPT;
 
   goto yybackup;
@@ -1259,14 +1268,14 @@
 
   /* Do appropriate processing given the current state.  Read a
-     lookahead token if we need one and don't already have one.  */
-
-  /* First try to decide what to do without reference to lookahead token.  */
+     look-ahead token if we need one and don't already have one.  */
+
+  /* First try to decide what to do without reference to look-ahead token.  */
   yyn = yypact[yystate];
-  if (yypact_value_is_default (yyn))
+  if (yyn == YYPACT_NINF)
     goto yydefault;
 
-  /* Not known => get a lookahead token if don't already have one.  */
-
-  /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
+  /* Not known => get a look-ahead token if don't already have one.  */
+
+  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
   if (yychar == YYEMPTY)
     {
@@ -1294,9 +1303,12 @@
   if (yyn <= 0)
     {
-      if (yytable_value_is_error (yyn))
-        goto yyerrlab;
+      if (yyn == 0 || yyn == YYTABLE_NINF)
+	goto yyerrlab;
       yyn = -yyn;
       goto yyreduce;
     }
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
 
   /* Count tokens shifted since error; after three, turn off error
@@ -1305,14 +1317,13 @@
     yyerrstatus--;
 
-  /* Shift the lookahead token.  */
+  /* Shift the look-ahead token.  */
   YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
 
-  /* Discard the shifted token.  */
-  yychar = YYEMPTY;
+  /* Discard the shifted token unless it is eof.  */
+  if (yychar != YYEOF)
+    yychar = YYEMPTY;
 
   yystate = yyn;
-  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
   *++yyvsp = yylval;
-  YY_IGNORE_MAYBE_UNINITIALIZED_END
 
   goto yynewstate;
@@ -1351,61 +1362,65 @@
     {
         case 5:
-/* Line 1787 of yacc.c  */
-#line 67 "convert.y"
-    {initdimprob(1,(yyvsp[(2) - (3)].na),"0","0");}
+#line 76 "convert.y"
+    { initdimprob(1,(yyvsp[(2) - (3)].na),"0","0"); ;}
     break;
 
   case 6:
-/* Line 1787 of yacc.c  */
-#line 68 "convert.y"
-    {initdimprob(2,(yyvsp[(2) - (5)].na), (yyvsp[(4) - (5)].na),"0");}
+#line 77 "convert.y"
+    { initdimprob(2,(yyvsp[(2) - (5)].na), (yyvsp[(4) - (5)].na),"0"); ;}
     break;
 
   case 7:
-/* Line 1787 of yacc.c  */
-#line 70 "convert.y"
-    {initdimprob(3,(yyvsp[(2) - (7)].na), (yyvsp[(4) - (7)].na), (yyvsp[(6) - (7)].na));}
+#line 78 "convert.y"
+    { initdimprob(3,(yyvsp[(2) - (7)].na), (yyvsp[(4) - (7)].na), (yyvsp[(6) - (7)].na)); ;}
     break;
 
   case 8:
-/* Line 1787 of yacc.c  */
-#line 72 "convert.y"
-    {listofmodules = Addtolistnom((yyvsp[(2) - (3)].na),listofmodules,0);
-                                                        Addmoduletothelist((yyvsp[(2) - (3)].na));}
+#line 80 "convert.y"
+    {
+            listofmodules = Addtolistnom((yyvsp[(2) - (3)].na),listofmodules,0);
+            Addmoduletothelist((yyvsp[(2) - (3)].na));
+        ;}
     break;
 
   case 9:
-/* Line 1787 of yacc.c  */
-#line 74 "convert.y"
-    {Add_NotGridDepend_Var_1((yyvsp[(3) - (4)].na));}
+#line 85 "convert.y"
+    {
+            if (!strcasecmp((yyvsp[(4) - (5)].na),"4"))
+            {
+                listofkind = Addtolistnom((yyvsp[(2) - (5)].na),listofkind,4);
+            }
+            else if (!strcasecmp((yyvsp[(4) - (5)].na),"8"))
+            {
+                listofkind = Addtolistnom((yyvsp[(2) - (5)].na),listofkind,8);
+            }
+            else
+            {
+                printf("##\n## Unknown kind type : %s (must be 4 or 8)\n##",(yyvsp[(4) - (5)].na));
+                exit(0);
+            }
+        ;}
     break;
 
   case 10:
-/* Line 1787 of yacc.c  */
-#line 75 "convert.y"
+#line 101 "convert.y"
     {
-                                    if (!strcasecmp((yyvsp[(2) - (3)].na),"FIXED_GRIDS"))
-                                                                 fixedgrids=1;
-                                    if (!strcasecmp((yyvsp[(2) - (3)].na),"ONLY_FIXED_GRIDS"))
-                                                             onlyfixedgrids=1;
-                                 }
+            Add_NotGridDepend_Var_1((yyvsp[(3) - (4)].na));
+        ;}
     break;
 
-
-/* Line 1787 of yacc.c  */
-#line 1397 "convert.tab.c"
+  case 11:
+#line 105 "convert.y"
+    {
+            if (!strcasecmp((yyvsp[(2) - (3)].na),"FIXED_GRIDS"))      fixedgrids = 1;
+            if (!strcasecmp((yyvsp[(2) - (3)].na),"ONLY_FIXED_GRIDS")) onlyfixedgrids = 1;
+        ;}
+    break;
+
+
+/* Line 1267 of yacc.c.  */
+#line 1420 "convert.tab.c"
       default: break;
     }
-  /* User semantic actions sometimes alter yychar, and that requires
-     that yytoken be updated with the new translation.  We take the
-     approach of translating immediately before every use of yytoken.
-     One alternative is translating here after every semantic action,
-     but that translation would be missed if the semantic action invokes
-     YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or
-     if it invokes YYBACKUP.  In the case of YYABORT or YYACCEPT, an
-     incorrect destructor might then be invoked immediately.  In the
-     case of YYERROR or YYBACKUP, subsequent parser actions might lead
-     to an incorrect destructor call or verbose syntax error message
-     before the lookahead is translated.  */
   YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
 
@@ -1415,4 +1430,5 @@
 
   *++yyvsp = yyval;
+
 
   /* Now `shift' the result of the reduction.  Determine what state
@@ -1435,8 +1451,4 @@
 `------------------------------------*/
 yyerrlab:
-  /* Make sure we have latest lookahead translation.  See comments at
-     user semantic actions for why this is necessary.  */
-  yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar);
-
   /* If not already recovering from an error, report this error.  */
   if (!yyerrstatus)
@@ -1446,34 +1458,35 @@
       yyerror (YY_("syntax error"));
 #else
-# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \
-                                        yyssp, yytoken)
       {
-        char const *yymsgp = YY_("syntax error");
-        int yysyntax_error_status;
-        yysyntax_error_status = YYSYNTAX_ERROR;
-        if (yysyntax_error_status == 0)
-          yymsgp = yymsg;
-        else if (yysyntax_error_status == 1)
-          {
-            if (yymsg != yymsgbuf)
-              YYSTACK_FREE (yymsg);
-            yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc);
-            if (!yymsg)
-              {
-                yymsg = yymsgbuf;
-                yymsg_alloc = sizeof yymsgbuf;
-                yysyntax_error_status = 2;
-              }
-            else
-              {
-                yysyntax_error_status = YYSYNTAX_ERROR;
-                yymsgp = yymsg;
-              }
-          }
-        yyerror (yymsgp);
-        if (yysyntax_error_status == 2)
-          goto yyexhaustedlab;
+	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
+	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
+	  {
+	    YYSIZE_T yyalloc = 2 * yysize;
+	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
+	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
+	    if (yymsg != yymsgbuf)
+	      YYSTACK_FREE (yymsg);
+	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
+	    if (yymsg)
+	      yymsg_alloc = yyalloc;
+	    else
+	      {
+		yymsg = yymsgbuf;
+		yymsg_alloc = sizeof yymsgbuf;
+	      }
+	  }
+
+	if (0 < yysize && yysize <= yymsg_alloc)
+	  {
+	    (void) yysyntax_error (yymsg, yystate, yychar);
+	    yyerror (yymsg);
+	  }
+	else
+	  {
+	    yyerror (YY_("syntax error"));
+	    if (yysize != 0)
+	      goto yyexhaustedlab;
+	  }
       }
-# undef YYSYNTAX_ERROR
 #endif
     }
@@ -1483,5 +1496,5 @@
   if (yyerrstatus == 3)
     {
-      /* If just tried and failed to reuse lookahead token after an
+      /* If just tried and failed to reuse look-ahead token after an
 	 error, discard it.  */
 
@@ -1500,5 +1513,5 @@
     }
 
-  /* Else will try to reuse lookahead token after shifting the error
+  /* Else will try to reuse look-ahead token after shifting the error
      token.  */
   goto yyerrlab1;
@@ -1534,5 +1547,5 @@
     {
       yyn = yypact[yystate];
-      if (!yypact_value_is_default (yyn))
+      if (yyn != YYPACT_NINF)
 	{
 	  yyn += YYTERROR;
@@ -1557,7 +1570,8 @@
     }
 
-  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
   *++yyvsp = yylval;
-  YY_IGNORE_MAYBE_UNINITIALIZED_END
 
 
@@ -1583,5 +1597,5 @@
   goto yyreturn;
 
-#if !defined yyoverflow || YYERROR_VERBOSE
+#ifndef yyoverflow
 /*-------------------------------------------------.
 | yyexhaustedlab -- memory exhaustion comes here.  |
@@ -1594,12 +1608,7 @@
 
 yyreturn:
-  if (yychar != YYEMPTY)
-    {
-      /* Make sure we have latest lookahead translation.  See comments at
-         user semantic actions for why this is necessary.  */
-      yytoken = YYTRANSLATE (yychar);
-      yydestruct ("Cleanup: discarding lookahead",
-                  yytoken, &yylval);
-    }
+  if (yychar != YYEOF && yychar != YYEMPTY)
+     yydestruct ("Cleanup: discarding lookahead",
+		 yytoken, &yylval);
   /* Do not reclaim the symbols of the rule which action triggered
      this YYABORT or YYACCEPT.  */
@@ -1625,375 +1634,360 @@
 
 
-/* Line 2050 of yacc.c  */
-#line 82 "convert.y"
-
+#line 110 "convert.y"
+
+
+void print_usage()
+{
+    printf("usage : conv <config_file> -convfile  <FILENAME>\n");
+    printf(" [-workdir <directory>] [-incdir <directory>]\n");
+    printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
+    printf(" [-convfile  <FILENAME>] [-SubloopScalar] [-SubloopScalar1] \n");
+    printf(" [-free|-fixed]\n");
+    exit(0);
+}
 
 int main(int argc,char *argv[])
 {
-   extern FILE * yyin ;
-   FILE *dependglobaloutput;
-   int i;
-   listnom *parcours;
-   listvar *newvar;
-   int stylegiven = 0;
-   int infreegiven ;
-   int infixedgiven ;
-   int lengthmainfile;
-
-   if (argc < 2)
-   {
-       printf("usage : conv <file> [-rm] [-incdir <directory>] \n");
-       printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
-       printf(" [-convfile  <FILENAME >] -SubloopScalar -SubloopScalar1 \n");
-       printf(" [-free|-fixed]\n");
-       exit(0);
-   }
+    extern FILE * convert_in ;
+    FILE *dependglobaloutput;
+    int i;
+    listnom *parcours;
+    listvar *newvar;
+    int stylegiven = 0;
+    int infreegiven ;
+    int infixedgiven ;
+    int lengthmainfile;
+
+    char filetoparse[LONG_FNAME];
+
 /******************************************************************************/
 /*  1-  Variables initialization                                              */
 /******************************************************************************/
-   List_Global_Var=(listvar *)NULL;
-   List_GlobalParameter_Var=(listvar *)NULL;
-   List_Allocate_Var=(listallocate *)NULL;
-   List_Common_Var=(listvar *)NULL;
-   List_SubroutineWhereAgrifUsed=(listnom *)NULL;
-   List_Subroutine_For_Alloc=(listnom *)NULL;
-   List_Include=(listusemodule *)NULL;
-   List_NameOfModuleUsed=(listusemodule *)NULL;
-   listofmoduletmp=(listusemodule *)NULL;
-   List_SubroutineDeclaration_Var=(listvar *)NULL;
-   List_UsedInSubroutine_Var=(listvar *)NULL;
-   List_NotGridDepend_Var=(listvar *)NULL;
-   Listofavailableindices=(listindice *)NULL;
-   List_CouplePointed_Var=(listvarpointtovar *)NULL;
-   List_ModuleUsed_Var = (listvar *)NULL;
-   List_ModuleUsedInModuleUsed_Var = (listvar *)NULL;
-   List_GlobParamModuleUsed_Var = (listparameter *)NULL;
-   List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *)NULL;
-   List_SubroutineArgument_Var = (listvar *)NULL;
-   List_FunctionType_Var = (listvar *)NULL;
-   tmpuselocallist = (listusemodule *)NULL;
-   List_ContainsSubroutine = (listnom *)NULL;
-   oldfortranout = (FILE *)NULL;
-
-   strcpy(mainfile,argv[1]);
-   strcpy(nomdir,"AGRIF_INC");
-   strcpy(commondirin,".");
-   strcpy(commondirout,".");
-   strcpy(filetoparse," ");
-   strcpy(subofagrifinitgrids,"");
-   strcpy(meetagrifinitgrids,"");
-   strcpy(mpiinitvar,"");
-
-   length_last = 0 ;
-   length_first = 0 ;
-   length_v_typevar = 0 ;
-   length_v_nomvar = 0 ;
-   length_v_dimchar = 0 ;
-   length_v_modulename = 0 ;
-   length_v_commonname = 0 ;
-   length_v_vallengspec = 0 ;
-   length_v_nameinttypename = 0 ;
-   length_v_commoninfile = 0 ;
-   length_v_subroutinename = 0 ;
-   length_v_precision = 0 ;
-   length_v_IntentSpec = 0 ;
-   length_v_initialvalue = 0 ;
-   length_v_readedlistdimension = 0 ;
-   length_u_usemodule = 0 ;
-   length_u_charusemodule = 0 ;
-   length_u_cursubroutine = 0 ;
-   length_u_modulename = 0 ;
-   length_n_name = 0 ;
-   length_c_namevar = 0 ;
-   length_c_namepointedvar = 0 ;
-   length_o_nom = 0 ;
-   length_o_module = 0 ;
-   length_a_nomvar = 0 ;
-   length_a_subroutine = 0 ;
-   length_a_module = 0 ;
-   length_t_usemodule = 0 ;
-   length_t_cursubroutine = 0 ;
-   length_curfilename = 0 ;
-   length_nomfileoutput = 0 ;
-   length_motparse = 0 ;
-   length_mainfile = 0 ;
-   length_nomdir = 0 ;
-   length_commondirout = 0 ;
-   length_commondirin = 0 ;
-   length_filetoparse = 0 ;
-   length_curbuf = 0 ;
-   length_toprintglob = 0 ;
-   length_tmpvargridname = 0 ;
-   length_ligne_Subloop = 0 ;
-   length_lvargridname_toamr = 0 ;
-   length_toprint_utilagrif = 0 ;
-   length_toprinttmp_utilchar = 0 ;
-   length_ligne_writedecl = 0 ;
-   length_newname_toamr = 0 ;
-   length_newname_writedecl = 0 ;
-   length_ligne_toamr = 0 ;
-   length_tmpligne_writedecl = 0 ;
-   value_char_size = 0 ;
-   value_char_size1 = 0 ;
-   value_char_size2 = 0 ;
-   value_char_size3 = 0 ;
-   inallocate = 0;
-   infixed = 1;
-   infree  = 0;
-
-   checkexistcommon=1;
-   todebug=0;
-   onlyfixedgrids=0;
-   fixedgrids=0;
-   InAgrifParentDef = 0;
-   IndicenbmaillesX=0;
-   IndicenbmaillesY=0;
-   IndicenbmaillesZ=0;
-   created_dimensionlist = 1;
-   indicemaxtabvars = 0;   /* current indice in the table tabvars             */
-   SubloopScalar = 0;
-   todebug = 0;
-   todebugfree = 0;
-   retour77 = 1 ;
-   mark = 0 ;
-   shouldincludempif = 0 ;
-   Read_val_max();
+    List_Global_Var = (listvar *) NULL;
+    List_GlobalParameter_Var = (listvar *) NULL;
+    List_Common_Var = (listvar *) NULL;
+    List_Allocate_Var = (listallocate *) NULL;
+    List_SubroutineWhereAgrifUsed = (listnom *) NULL;
+    List_Subroutine_For_Alloc = (listnom *) NULL;
+    List_Include = (listusemodule *) NULL;
+    List_NameOfModuleUsed = (listusemodule *) NULL;
+    listofmoduletmp = (listusemodule *) NULL;
+    List_SubroutineDeclaration_Var = (listvar *) NULL;
+    List_UsedInSubroutine_Var = (listvar *) NULL;
+    List_NotGridDepend_Var = (listvar *) NULL;
+    Listofavailableindices = (listindice *) NULL;
+    Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+    List_CouplePointed_Var = (listvarpointtovar *) NULL;
+    List_ModuleUsed_Var = (listvar *) NULL;
+    List_ModuleUsedInModuleUsed_Var = (listvar *) NULL;
+    List_GlobParamModuleUsed_Var = (listparameter *) NULL;
+    List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *) NULL;
+    List_SubroutineArgument_Var = (listvar *) NULL;
+    List_FunctionType_Var = (listvar *) NULL;
+    tmpuselocallist = (listusemodule *) NULL;
+    List_ContainsSubroutine = (listnom *) NULL;
+    oldfortran_out = (FILE *) NULL;
+
+    if (argc < 2) print_usage();
+    
+    strcpy(config_file, argv[1]);
+    strcpy(work_dir, ".");
+    strcpy(input_dir, ".");
+    strcpy(output_dir, "AGRIF_MODELFILES");
+    strcpy(include_dir, "AGRIF_INC");
+    strcpy(filetoparse, "");
+    strcpy(subofagrifinitgrids, "");
+    strcpy(meetagrifinitgrids, "");
+    strcpy(mpiinitvar, "");
+
+    length_last = 0 ;
+    length_first = 0 ;
+    length_v_vallengspec = 0 ;
+    length_v_commoninfile = 0 ;
+    length_v_precision = 0 ;
+    length_v_IntentSpec = 0 ;
+    length_v_initialvalue = 0 ;
+    length_v_readedlistdimension = 0 ;
+    length_a_nomvar = 0 ;
+    length_toprintglob = 0 ;
+    length_tmpvargridname = 0 ;
+    length_ligne_Subloop = 0 ;
+    length_toprint_utilagrif = 0 ;
+    length_toprinttmp_utilchar = 0 ;
+    length_ligne_writedecl = 0 ;
+    length_newname_toamr = 0 ;
+    length_newname_writedecl = 0 ;
+    length_ligne_toamr = 0 ;
+    length_tmpligne_writedecl = 0 ;
+    value_char_size = 0 ;
+    value_char_size1 = 0 ;
+    value_char_size2 = 0 ;
+    value_char_size3 = 0 ;
+    inallocate = 0;
+    infixed = 1;
+    infree  = 0;
+
+    onlyfixedgrids=0;
+    fixedgrids=0;
+    InAgrifParentDef = 0;
+    IndicenbmaillesX=0;
+    IndicenbmaillesY=0;
+    IndicenbmaillesZ=0;
+    created_dimensionlist = 1;
+    /* current indice in the table tabvars             */
+    for ( i=0 ; i<NB_CAT_VARIABLES ; i++)
+    {
+        indicemaxtabvars[i] = 0;
+    }
+    SubloopScalar = 0;
+    todebug = 0;
+    retour77 = 1 ;
+    shouldincludempif = 0 ;
+
+    Read_val_max();
+
 /******************************************************************************/
 /*  2-  Program arguments                                                     */
 /******************************************************************************/
 
-   if ((yyin=fopen(argv[1],"r"))==NULL)
-   {
-      printf("the file %s doesn't exist \n",argv[1]);
-      exit(0);
-   }
-
-   i=2;
-   while (i<argc)
-   {
-      if (!strcasecmp(argv[i],"-incdir"))
-      {
-         strcpy(nomdir,argv[i+1]);
-         i++;
-      }
-      else if (!strcasecmp(argv[i],"-comdirin")) /* input directory           */
-      {
-         strcpy(commondirin,argv[i+1]);
-         i++;
-      }
-      else if (!strcasecmp(argv[i],"-comdirout")) /* output directory         */
-      {
-         strcpy(commondirout,argv[i+1]);
-         i++;
-      }
-      else if (!strcasecmp(argv[i],"-convfile")) /* file to parse             */
-      {
-         strcpy(filetoparse,argv[i+1]);
-         i++;
-         lengthmainfile = strlen(filetoparse);
-         if (!strcasecmp(&filetoparse[lengthmainfile-4],".f90"))
-         {
-         infixed = 0;
-         infree = 1;
-         }
-         else
-         {
-         infixed = 1;
-         infree = 0;
-         }
-      }
-      else if (!strcasecmp(argv[i],"-free")) /* file to parse        */
-      {
-         stylegiven = 1;
-         infreegiven  = 1 ;
-         infixedgiven = 0;
-      }   
-      else if (!strcasecmp(argv[i],"-fixed")) /* file to parse        */
-      {
-         stylegiven = 1;
-         infreegiven  = 0;
-         infixedgiven = 1;
-      }         
-      else if (!strcasecmp(argv[i],"-SubloopScalar")) /* file to parse        */
-      {
-         SubloopScalar = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-SubloopScalar1")) /* file to parse       */
-      {
-         SubloopScalar = 2 ;
-      }
-      else if (!strcasecmp(argv[i],"-todebug")) /* file to parse       */
-      {
-         todebug = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-mark")) /* file to parse       */
-      {
-         mark = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-todebugfree")) /* file to parse       */
-      {
-         todebugfree = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-rm"))
-      {
-         checkexistcommon=0;
-      }
-      else
-      {
-         printf("Unkwon option : %s\n",argv[i]);
-         exit(0);
-      }
-      i++;
-   }
-
-   if (stylegiven == 1) 
-   {
-   infree = infreegiven;
-   infixed = infixedgiven;   
-   }
-   Save_Length(nomdir,34);
-   Save_Length(commondirout,35);
-   Save_Length(commondirin,36);
-   Save_Length(filetoparse,37);
+    if ( (convert_in=fopen(config_file,"r")) == NULL )
+    {
+        printf("##\n## ERROR: the configuration file '%s' doesn't exist.\n##\n", config_file);
+        print_usage();
+    }
+
+    i=2;
+    while ( i < argc )
+    {
+        if (!strcasecmp(argv[i], "-workdir"))
+        {
+            strcpy(work_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-incdir"))
+        {
+            strcpy(include_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirin")) /* input directory           */
+        {
+            strcpy(input_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirout")) /* output directory         */
+        {
+            strcpy(output_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-convfile")) /* file to parse             */
+        {
+            strcpy(filetoparse, argv[i+1]);
+            i++;
+            lengthmainfile = strlen(filetoparse);
+            if (!strcasecmp(&filetoparse[lengthmainfile-4], ".f90"))
+            {
+                infixed = 0;
+                infree = 1;
+            }
+            else
+            {
+                infixed = 1;
+                infree = 0;
+            }
+        }
+        else if (!strcasecmp(argv[i], "-free"))
+        {
+            stylegiven = 1;
+            infreegiven  = 1 ;
+            infixedgiven = 0;
+        }
+        else if (!strcasecmp(argv[i], "-fixed"))
+        {
+            stylegiven = 1;
+            infreegiven  = 0;
+            infixedgiven = 1;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar"))
+        {
+            SubloopScalar = 1 ;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar1"))
+        {
+            SubloopScalar = 2 ;
+        }
+        else if (!strcasecmp(argv[i], "-todebug"))
+        {
+            todebug = 1 ;
+        }
+        else if (!strcasecmp(argv[i],"-rm")) { }
+        else
+        {
+            printf("##\n## Unkwon option : %s\n##\n", argv[i]);
+            exit(0);
+        }
+        i++;
+    }
+    // Check input file
+    if ( strlen(filetoparse) == 0 )         // -convfile has not been specified
+    {
+        printf("##\n## ERROR: please provide a file to parse with -convfile.\n##\n");
+        print_usage();
+    }
+    // Setup input & output directories
+    if ( strcasecmp(work_dir, ".") != 0 )   // -workdir has been changed...
+    {
+        if ( strcasecmp(input_dir,  ".") == 0 )                 // ...and -comdirin  has NOT been changed
+        {
+            strcpy(input_dir, work_dir);
+        }
+        if ( strcasecmp(output_dir, "AGRIF_MODELFILES") == 0 )  // ...and -comdirout has NOT been changed
+        {
+            sprintf(output_dir, "%s/%s", work_dir, "AGRIF_MODELFILES");
+        }
+        if ( strcasecmp(include_dir, "AGRIF_INC") == 0 )        // ...and -incdir    has NOT been changed
+        {
+            sprintf(include_dir, "%s/%s", work_dir, "AGRIF_INC");
+        }
+    }
+    if (stylegiven == 1)
+    {
+        infree  = infreegiven;
+        infixed = infixedgiven;
+    }
 
 /******************************************************************************/
-/*  3-  Parsing of the  conv file <name>.in                                   */
+/*  3-  Parsing of the conv file <name>.in                                    */
 /******************************************************************************/
 
-   if ((yyin=fopen(argv[1],"r"))==NULL)
-   {
-       printf("the file %s doesn't exist \n",argv[1]);
-       exit(0);
-   }
-   strcpy(mainfile,argv[1]);
-   Save_Length(mainfile,33);
-
-   if ( strstr(filetoparse,".f90") ||
-        strstr(filetoparse,".F90") ) retour77 = 0;
-
-   yyparse();
+    if ( strstr(filetoparse, ".f90") || strstr(filetoparse, ".F90") ) retour77 = 0;
+
+    convert_parse();
 
 /******************************************************************************/
 /*  4-  Preparation of the file parsing                                       */
 /******************************************************************************/
-   if ((yyin=fopen(filetoparse,"r"))==NULL) /* Is the file to parse exist ?   */
-   {
-      printf("the file %s doesn't exist \n",filetoparse);
-      exit(0);
-   }
-   /* mainfile : the name of the file to parse                                */
-   strcpy(mainfile,filetoparse);
-   /*                                                                         */
-   if ((dependglobaloutput=fopen(".dependglobal_agrif","r"))!=NULL)
-   {
-      fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars);
-      fclose(dependglobaloutput);
-   }
-   Readthedependavailablefile();
-   /* Read the .dependnbxnby file which contains indices of nbmaillsX,        */
-   /*    nbmailleY and nbmailleZ                                              */
-   Readthedependnbxnbyfile();
-   Read_Subroutine_For_Alloc();
+
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    /*                                                                         */
+    if ( (dependglobaloutput=fopen(dependfilename, "r")) != NULL )
+    {
+        for (i=0;i<NB_CAT_VARIABLES;i++)
+        {
+            fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars[i]);
+        }
+        fclose(dependglobaloutput);
+    }
+    Readthedependavailablefile();
+    /* Read the .dependnbxnby file which contains indices of nbmaillsX, nbmailleY and nbmailleZ */
+    Readthedependnbxnbyfile();
+    Read_Subroutine_For_Alloc();
+
 /******************************************************************************/
 /*  5-  Parsing of the input file (2 times)                                   */
 /******************************************************************************/
-   /* Record all variable in list                                             */
-   firstpass = 1;
-   processfortran(filetoparse);
-   /*                                                                         */
-   CompleteThelistvarindoloop();
-   /* Read list of module used                                                */
-   RecordUseModulesVariables();
-   /* Read list of module used in module used                                 */
-   RecordUseModulesUseModulesVariables();
-   /* Save variables are considered as globals ones                           */
-   Update_List_Global_Var_From_List_Save_Var();
-   /* Update all lists                                                        */
-   ListUpdate();
-   /*                                                                         */
-   Clean_List_Global_Var();
-   /* Indice tabvars identification                                           */
-   IndiceTabvarsIdentification();
-   /* Update all lists                                                        */
-   ListUpdate();
-   /* The allocation subroutine is necessary ????                             */
-   New_Allocate_Subroutine_Is_Necessary();
-   /* The allocation subroutine is necessary for common list                  */
-   New_Allocate_Subroutine_For_Common_Is_Necessary();
-   /* Sort List_SubroutineArgument_Var                                        */
-   Sort_List_SubroutineArgument_Var();
-   /* Clean all lists                                                         */
-   ListClean();
-   /* Update Indice of List_UsedInSubroutine_Var from module used             */
-   List_UsedInSubroutine_Var_Update_From_Module_Used();
-   /* Update List_SubroutineWhereAgrifUsed                                    */
-   UpdateList_SubroutineWhereAgrifUsed();
-   /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
-   UpdateList_UsedInSubroutine_With_dimension();;
-   /*                                                                         */
-   ModifyThelistvarindoloop();
-   /*                                                                         */
-   UpdateListDeclarationWithDimensionList();
-   /*                                                                         */
-   GiveTypeOfVariables();
-   Affiche();
-   /* Build new subroutines                                                   */
-   firstpass = 0;
-   processfortran(filetoparse);
-
-   newvar = (listvar *)NULL;
-/*newvar = List_Global_Var; */
-   while ( newvar )
-   {
-      printf("++++ %s %d %s %s %s\n",
-      newvar->var->v_nomvar,
-      newvar->var->v_nbdim,
-      newvar->var->v_subroutinename,
-      newvar->var->v_modulename,
-      newvar->var->v_typevar
-             );
-      newvar = newvar->suiv;
-   }
+
+    /* Record all variables in list                                            */
+    firstpass = 1;
+    process_fortran(filetoparse);
+
+    CompleteThelistvarindoloop();
+    /* Read list of module used                                                */
+    RecordUseModulesVariables();
+    /* Read list of module used in module used                                 */
+    RecordUseModulesUseModulesVariables();
+    /* Save variables are considered as globals ones                           */
+    Update_List_Global_Var_From_List_Save_Var();
+    /* Update all lists                                                        */
+    ListUpdate();
+
+    Clean_List_Global_Var();
+    /* Indice tabvars identification                                           */
+    IndiceTabvarsIdentification();
+    /* Update all lists                                                        */
+    ListUpdate();
+    /* The allocation subroutine is necessary ????                             */
+    New_Allocate_Subroutine_Is_Necessary();
+    /* The allocation subroutine is necessary for common list                  */
+    New_Allocate_Subroutine_For_Common_Is_Necessary();
+    /* Sort List_SubroutineArgument_Var                                        */
+    Sort_List_SubroutineArgument_Var();
+    /* Clean all lists                                                         */
+    ListClean();
+    /* Update Indice of List_UsedInSubroutine_Var from module used             */
+    List_UsedInSubroutine_Var_Update_From_Module_Used();
+    /* Update List_SubroutineWhereAgrifUsed                                    */
+    UpdateList_SubroutineWhereAgrifUsed();
+    /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
+    UpdateList_UsedInSubroutine_With_dimension();
+
+    ModifyThelistvarindoloop();
+    UpdateListDeclarationWithDimensionList();
+    GiveTypeOfVariables();
+
+    /* Build new subroutines                                                   */
+    firstpass = 0;
+    process_fortran(filetoparse);
+
+    newvar = (listvar *) NULL;
+
+    while ( newvar )
+    {
+        printf("++++ %s %d %s %s %s\n",
+            newvar->var->v_nomvar,
+            newvar->var->v_nbdim,
+            newvar->var->v_subroutinename,
+            newvar->var->v_modulename,
+            newvar->var->v_typevar);
+        newvar = newvar->suiv;
+    }
+
 /******************************************************************************/
 /*  6-  Write informations in output files                                    */
 /******************************************************************************/
 
-   /* Write the .dependglobal_agrif file which contain the max indice         */
-   /*    of the tabvars table                                                 */
-   dependglobaloutput = fopen(".dependglobal_agrif","w");
-   fprintf(dependglobaloutput,"%d\n",indicemaxtabvars);
-   fclose(dependglobaloutput);
-   /* Write the list of available indice                                      */
-   Writethedependavailablefile();
-   /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
-   /*    nbmailleY and nbmailleZ                                              */
-   Writethedependnbxnbyfile();
-   /* Write the .depend<namefile> file which contain general informations     */
-   /*    about variable of this file                                          */
-   parcours = List_NameOfModule;
-   while( parcours )
-   {
-      Writethedependlistofmoduleused(parcours->o_nom);
-      WritedependParameterList(parcours->o_nom);
-      Writethedependfile(parcours->o_nom,List_Global_Var);
-      parcours=parcours->suiv;
-   }
-   parcours = List_NameOfCommon;
-   while( parcours )
-   {
-      Writethedependfile(parcours->o_nom,List_Common_Var);
-      parcours=parcours->suiv;
-   }
-   Write_Subroutine_For_Alloc();
+    /* Write the .dependglobal_agrif file which contain the max indice         */
+    /*    of the tabvars table                                                 */
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    dependglobaloutput = fopen(dependfilename, "w");
+    for (i=0;i<NB_CAT_VARIABLES;i++)
+    {
+        fprintf(dependglobaloutput,"%d\n",indicemaxtabvars[i]);
+    }
+    fclose(dependglobaloutput);
+    /* Write the list of available indice                                      */
+    Writethedependavailablefile();
+    /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
+    /*    nbmailleY and nbmailleZ                                              */
+    Writethedependnbxnbyfile();
+    /* Write the .depend<namefile> file which contain general informations     */
+    /*    about variable of this file                                          */
+    parcours = List_NameOfModule;
+    while( parcours )
+    {
+        Writethedependlistofmoduleused(parcours->o_nom);
+        WritedependParameterList(parcours->o_nom);
+        Writethedependfile(parcours->o_nom,List_Global_Var);
+        parcours=parcours->suiv;
+    }
+    parcours = List_NameOfCommon;
+    while( parcours )
+    {
+        Writethedependfile(parcours->o_nom,List_Common_Var);
+        parcours=parcours->suiv;
+    }
+    Write_Subroutine_For_Alloc();
+
 /******************************************************************************/
 /*  7-  Create files in AGRIF_INC directory                                   */
 /******************************************************************************/
-   creefichieramr(NameTamponfile);
-
-   Write_val_max();
-
-   if ( todebug == 1 ) printf("Out of CONV \n");
-   return 0;
-}
+
+    creefichieramr();
+
+    Write_val_max();
+
+    if ( todebug == 1 ) printf("Out of CONV \n");
+    return 0;
+}
+
 #line 2 "convert.yy.c"
 
@@ -2003,9 +1997,28 @@
 
 /* A lexical scanner generated by flex */
+
+#define yy_create_buffer convert__create_buffer
+#define yy_delete_buffer convert__delete_buffer
+#define yy_flex_debug convert__flex_debug
+#define yy_init_buffer convert__init_buffer
+#define yy_flush_buffer convert__flush_buffer
+#define yy_load_buffer_state convert__load_buffer_state
+#define yy_switch_to_buffer convert__switch_to_buffer
+#define yyin convert_in
+#define yyleng convert_leng
+#define yylex convert_lex
+#define yylineno convert_lineno
+#define yyout convert_out
+#define yyrestart convert_restart
+#define yytext convert_text
+#define yywrap convert_wrap
+#define yyalloc convert_alloc
+#define yyrealloc convert_realloc
+#define yyfree convert_free
 
 #define FLEX_SCANNER
 #define YY_FLEX_MAJOR_VERSION 2
 #define YY_FLEX_MINOR_VERSION 5
-#define YY_FLEX_SUBMINOR_VERSION 37
+#define YY_FLEX_SUBMINOR_VERSION 35
 #if YY_FLEX_SUBMINOR_VERSION > 0
 #define FLEX_BETA
@@ -2045,4 +2058,5 @@
 typedef int32_t flex_int32_t;
 typedef uint32_t flex_uint32_t;
+typedef uint64_t flex_uint64_t;
 #else
 typedef signed char flex_int8_t;
@@ -2052,4 +2066,5 @@
 typedef unsigned short int flex_uint16_t;
 typedef unsigned int flex_uint32_t;
+#endif /* ! C99 */
 
 /* Limits of integral types. */
@@ -2081,6 +2096,4 @@
 #define UINT32_MAX             (4294967295U)
 #endif
-
-#endif /* ! C99 */
 
 #endif /* ! FLEXINT_H */
@@ -2134,5 +2147,5 @@
 
 /* Special action meaning "start processing a new file". */
-#define YY_NEW_FILE yyrestart(yyin  )
+#define YY_NEW_FILE convert_restart(convert_in  )
 
 #define YY_END_OF_BUFFER_CHAR 0
@@ -2157,7 +2170,7 @@
 #endif
 
-extern yy_size_t yyleng;
-
-extern FILE *yyin, *yyout;
+extern yy_size_t convert_leng;
+
+extern FILE *convert_in, *convert_out;
 
 #define EOB_ACT_CONTINUE_SCAN 0
@@ -2171,5 +2184,5 @@
 	do \
 		{ \
-		/* Undo effects of setting up yytext. */ \
+		/* Undo effects of setting up convert_text. */ \
         int yyless_macro_arg = (n); \
         YY_LESS_LINENO(yyless_macro_arg);\
@@ -2177,5 +2190,5 @@
 		YY_RESTORE_YY_MORE_OFFSET \
 		(yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
-		YY_DO_BEFORE_ACTION; /* set up yytext again */ \
+		YY_DO_BEFORE_ACTION; /* set up convert_text again */ \
 		} \
 	while ( 0 )
@@ -2240,6 +2253,6 @@
 	 *
 	 * When we actually see the EOF, we change the status to "new"
-	 * (via yyrestart()), so that the user can continue scanning by
-	 * just pointing yyin at a new input file.
+	 * (via convert_restart()), so that the user can continue scanning by
+	 * just pointing convert_in at a new input file.
 	 */
 #define YY_BUFFER_EOF_PENDING 2
@@ -2268,8 +2281,8 @@
 #define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
 
-/* yy_hold_char holds the character lost when yytext is formed. */
+/* yy_hold_char holds the character lost when convert_text is formed. */
 static char yy_hold_char;
 static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
-yy_size_t yyleng;
+yy_size_t convert_leng;
 
 /* Points to current character in buffer. */
@@ -2278,39 +2291,39 @@
 static int yy_start = 0;	/* start state number */
 
-/* Flag which is used to allow yywrap()'s to do buffer switches
- * instead of setting up a fresh yyin.  A bit of a hack ...
+/* Flag which is used to allow convert_wrap()'s to do buffer switches
+ * instead of setting up a fresh convert_in.  A bit of a hack ...
  */
 static int yy_did_buffer_switch_on_eof;
 
-void yyrestart (FILE *input_file  );
-void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer  );
-YY_BUFFER_STATE yy_create_buffer (FILE *file,int size  );
-void yy_delete_buffer (YY_BUFFER_STATE b  );
-void yy_flush_buffer (YY_BUFFER_STATE b  );
-void yypush_buffer_state (YY_BUFFER_STATE new_buffer  );
-void yypop_buffer_state (void );
-
-static void yyensure_buffer_stack (void );
-static void yy_load_buffer_state (void );
-static void yy_init_buffer (YY_BUFFER_STATE b,FILE *file  );
-
-#define YY_FLUSH_BUFFER yy_flush_buffer(YY_CURRENT_BUFFER )
-
-YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size  );
-YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str  );
-YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,yy_size_t len  );
-
-void *yyalloc (yy_size_t  );
-void *yyrealloc (void *,yy_size_t  );
-void yyfree (void *  );
-
-#define yy_new_buffer yy_create_buffer
+void convert_restart (FILE *input_file  );
+void convert__switch_to_buffer (YY_BUFFER_STATE new_buffer  );
+YY_BUFFER_STATE convert__create_buffer (FILE *file,int size  );
+void convert__delete_buffer (YY_BUFFER_STATE b  );
+void convert__flush_buffer (YY_BUFFER_STATE b  );
+void convert_push_buffer_state (YY_BUFFER_STATE new_buffer  );
+void convert_pop_buffer_state (void );
+
+static void convert_ensure_buffer_stack (void );
+static void convert__load_buffer_state (void );
+static void convert__init_buffer (YY_BUFFER_STATE b,FILE *file  );
+
+#define YY_FLUSH_BUFFER convert__flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE convert__scan_buffer (char *base,yy_size_t size  );
+YY_BUFFER_STATE convert__scan_string (yyconst char *yy_str  );
+YY_BUFFER_STATE convert__scan_bytes (yyconst char *bytes,yy_size_t len  );
+
+void *convert_alloc (yy_size_t  );
+void *convert_realloc (void *,yy_size_t  );
+void convert_free (void *  );
+
+#define yy_new_buffer convert__create_buffer
 
 #define yy_set_interactive(is_interactive) \
 	{ \
 	if ( ! YY_CURRENT_BUFFER ){ \
-        yyensure_buffer_stack (); \
+        convert_ensure_buffer_stack (); \
 		YY_CURRENT_BUFFER_LVALUE =    \
-            yy_create_buffer(yyin,YY_BUF_SIZE ); \
+            convert__create_buffer(convert_in,YY_BUF_SIZE ); \
 	} \
 	YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
@@ -2320,7 +2333,7 @@
 	{ \
 	if ( ! YY_CURRENT_BUFFER ){\
-        yyensure_buffer_stack (); \
+        convert_ensure_buffer_stack (); \
 		YY_CURRENT_BUFFER_LVALUE =    \
-            yy_create_buffer(yyin,YY_BUF_SIZE ); \
+            convert__create_buffer(convert_in,YY_BUF_SIZE ); \
 	} \
 	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
@@ -2331,16 +2344,19 @@
 /* Begin user sect3 */
 
+#define convert_wrap(n) 1
+#define YY_SKIP_YYWRAP
+
 typedef unsigned char YY_CHAR;
 
-FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0;
+FILE *convert_in = (FILE *) 0, *convert_out = (FILE *) 0;
 
 typedef int yy_state_type;
 
-extern int yylineno;
-
-int yylineno = 1;
-
-extern char *yytext;
-#define yytext_ptr yytext
+extern int convert_lineno;
+
+int convert_lineno = 1;
+
+extern char *convert_text;
+#define yytext_ptr convert_text
 
 static yy_state_type yy_get_previous_state (void );
@@ -2350,15 +2366,15 @@
 
 /* Done after the current pattern has been matched and before the
- * corresponding action - sets up yytext.
+ * corresponding action - sets up convert_text.
  */
 #define YY_DO_BEFORE_ACTION \
 	(yytext_ptr) = yy_bp; \
-	yyleng = (size_t) (yy_cp - yy_bp); \
+	convert_leng = (yy_size_t) (yy_cp - yy_bp); \
 	(yy_hold_char) = *yy_cp; \
 	*yy_cp = '\0'; \
 	(yy_c_buf_p) = yy_cp;
 
-#define YY_NUM_RULES 12
-#define YY_END_OF_BUFFER 13
+#define YY_NUM_RULES 15
+#define YY_END_OF_BUFFER 16
 /* This struct is not used in this scanner,
    but its presence is necessary. */
@@ -2368,14 +2384,15 @@
 	flex_int32_t yy_nxt;
 	};
-static yyconst flex_int16_t yy_accept[77] =
+static yyconst flex_int16_t yy_accept[84] =
     {   0,
-        0,    0,    0,    0,   13,   12,   11,   10,   12,    9,
-       12,   12,   12,    9,    8,    8,    8,    8,    8,    8,
-       11,    0,    4,    7,    7,    7,    5,    8,    8,    8,
-        8,    8,    8,    8,    6,    8,    8,    8,    8,    3,
-        8,    8,    8,    8,    8,    8,    8,    8,    8,    8,
-        8,    8,    8,    8,    8,    8,    8,    8,    8,    8,
-        8,    8,    8,    8,    8,    2,    8,    8,    8,    1,
-        8,    8,    8,    8,    6,    0
+        0,    0,    0,    0,   16,   15,   14,   13,   15,   12,
+       11,   11,   11,   11,   12,    7,   10,   10,   10,   10,
+       10,   10,   10,   14,    0,    4,   11,    9,    9,    9,
+        5,   10,   10,   10,   10,   10,   10,   10,   10,    8,
+       10,   10,   10,   10,   10,    3,   10,    6,   10,   10,
+       10,   10,   10,   10,   10,   10,   10,   10,   10,   10,
+       10,   10,   10,   10,   10,   10,   10,   10,   10,   10,
+       10,   10,    2,   10,   10,   10,    1,   10,   10,   10,
+       10,    8,    0
     } ;
 
@@ -2388,12 +2405,12 @@
         6,    1,    1,    7,    1,    1,    1,    8,    9,   10,
        11,    8,    8,    8,   12,    8,    8,   13,   14,    1,
-        1,    1,    1,    1,   15,   16,   16,   17,   18,   19,
-       20,   16,   21,   16,   16,   22,   23,   24,   25,   26,
-       16,   27,   28,   29,   30,   16,   16,   31,   32,   16,
-       33,    1,   34,    1,   35,    1,   36,   16,   16,   37,
-
-       38,   39,   40,   16,   41,   16,   16,   42,   43,   44,
-       45,   46,   16,   47,   48,   49,   50,   16,   16,   51,
-       52,   16,    1,    1,    1,    1,    1,    1,    1,    1,
+       15,    1,    1,    1,   16,   17,   17,   18,   19,   20,
+       21,   17,   22,   17,   23,   24,   25,   26,   27,   28,
+       17,   29,   30,   31,   32,   17,   17,   33,   34,   17,
+       35,    1,   36,    1,   37,    1,   38,   17,   17,   39,
+
+       40,   41,   42,   17,   43,   17,   44,   45,   46,   47,
+       48,   49,   17,   50,   51,   52,   53,   17,   17,   54,
+       55,   17,    1,    1,    1,    1,    1,    1,    1,    1,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
@@ -2412,67 +2429,72 @@
     } ;
 
-static yyconst flex_int32_t yy_meta[53] =
+static yyconst flex_int32_t yy_meta[56] =
     {   0,
         1,    1,    2,    1,    1,    1,    1,    3,    3,    3,
-        3,    3,    1,    1,    3,    3,    3,    3,    3,    3,
+        3,    3,    1,    1,    1,    3,    3,    3,    3,    3,
         3,    3,    3,    3,    3,    3,    3,    3,    3,    3,
-        3,    3,    1,    1,    3,    3,    3,    3,    3,    3,
+        3,    3,    3,    3,    1,    1,    3,    3,    3,    3,
         3,    3,    3,    3,    3,    3,    3,    3,    3,    3,
-        3,    3
+        3,    3,    3,    3,    3
     } ;
 
-static yyconst flex_int16_t yy_base[79] =
+static yyconst flex_int16_t yy_base[86] =
     {   0,
-        0,    0,    0,    0,  150,  164,  147,  164,  144,  164,
-       36,   37,   38,  134,    0,   44,   32,   34,   44,   33,
-      144,  141,  140,  164,  164,  164,  164,    0,  131,   31,
-       34,   42,   39,   49,    0,   50,   49,   38,   56,    0,
-       59,   52,  107,   68,  106,   72,   75,   72,   77,   81,
-       79,   76,   75,   86,   73,   88,   85,   89,   90,   79,
-       93,   86,   99,   97,  103,    0,   37,  115,  114,    0,
-      108,  116,  121,  112,    0,  164,  160,   57
+        0,    0,    0,    0,  192,  194,  186,  194,  176,  194,
+       48,   53,   58,   69,  164,  194,    0,   60,   51,   47,
+       49,   67,   55,  173,  170,  169,   90,  194,  194,  194,
+      194,    0,  160,   53,   62,   58,   66,   62,   74,    0,
+       85,   95,   94,   82,  101,    0,  101,    0,   91,  134,
+       96,  133,  100,  103,   99,  105,  109,  106,  102,  101,
+      113,   99,  115,  113,  119,  127,  123,  139,  130,  142,
+      137,  132,    0,   81,  144,  143,    0,  136,  144,  150,
+      139,    0,  194,  190,   81
     } ;
 
-static yyconst flex_int16_t yy_def[79] =
+static yyconst flex_int16_t yy_def[86] =
     {   0,
-       76,    1,    1,    1,   76,   76,   76,   76,   77,   76,
-       76,   76,   76,   76,   78,   78,   78,   78,   78,   78,
-       76,   77,   77,   76,   76,   76,   76,   78,   78,   78,
-       78,   78,   78,   78,   78,   78,   78,   78,   78,   78,
-       78,   78,   78,   78,   78,   78,   78,   78,   78,   78,
-       78,   78,   78,   78,   78,   78,   78,   78,   78,   78,
-       78,   78,   78,   78,   78,   78,   78,   78,   78,   78,
-       78,   78,   78,   78,   78,    0,   76,   76
+       83,    1,    1,    1,   83,   83,   83,   83,   84,   83,
+       83,   83,   83,   83,   83,   83,   85,   85,   85,   85,
+       85,   85,   85,   83,   84,   84,   83,   83,   83,   83,
+       83,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,    0,   83,   83
     } ;
 
-static yyconst flex_int16_t yy_nxt[217] =
+static yyconst flex_int16_t yy_nxt[250] =
     {   0,
-        6,    7,    8,    9,   10,   10,   10,    6,   11,   12,
-       13,    6,   14,   10,   15,   15,   15,   15,   16,   15,
-       15,   15,   15,   17,   18,   19,   15,   15,   15,   20,
-       15,   15,   10,   10,   15,   15,   15,   15,   16,   15,
-       15,   15,   15,   17,   18,   19,   15,   15,   15,   20,
-       15,   15,   24,   25,   26,   29,   31,   32,   33,   28,
-       34,   36,   37,   38,   30,   39,   40,   41,   42,   43,
-       44,   69,   24,   25,   26,   45,   31,   32,   46,   33,
-       34,   36,   37,   38,   30,   39,   40,   41,   42,   43,
-       48,   44,   50,   51,   52,   45,   53,   54,   46,   55,
-
-       56,   57,   58,   59,   60,   61,   62,   63,   64,   65,
-       48,   66,   50,   51,   52,   67,   53,   54,   68,   55,
-       56,   57,   58,   59,   60,   61,   62,   63,   64,   65,
-       35,   66,   70,   71,   72,   67,   73,   74,   68,   75,
-       49,   47,   35,   23,   23,   21,   27,   23,   21,   76,
-       35,   76,   70,   71,   72,   76,   73,   74,   76,   75,
-       22,   76,   22,    5,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76
+        6,    7,    8,    9,   10,   10,   10,   11,   12,   13,
+       14,   11,   15,   10,   16,   17,   17,   17,   17,   18,
+       17,   17,   19,   17,   17,   20,   21,   22,   17,   17,
+       17,   23,   17,   17,   10,   10,   17,   17,   17,   17,
+       18,   17,   17,   19,   17,   17,   20,   21,   22,   17,
+       17,   17,   23,   17,   17,   27,   27,   27,   27,   27,
+       27,   27,   27,   27,   27,   27,   27,   27,   27,   27,
+       28,   33,   35,   36,   37,   29,   27,   27,   27,   27,
+       27,   34,   38,   32,   39,   41,   30,   42,   43,   44,
+       45,   28,   46,   35,   36,   37,   29,   27,   27,   27,
+
+       27,   27,   34,   47,   38,   39,   41,   30,   42,   43,
+       44,   45,   48,   46,   49,   50,   51,   76,   52,   53,
+       55,   57,   58,   59,   47,   60,   61,   62,   63,   64,
+       65,   66,   67,   48,   68,   49,   50,   69,   51,   52,
+       53,   55,   57,   58,   59,   70,   60,   61,   62,   63,
+       64,   65,   66,   67,   71,   68,   72,   73,   69,   74,
+       75,   40,   77,   78,   79,   80,   70,   81,   82,   56,
+       54,   40,   26,   26,   24,   71,   31,   72,   73,   26,
+       74,   75,   40,   77,   78,   79,   80,   24,   81,   82,
+       25,   83,   25,    5,   83,   83,   83,   83,   83,   83,
+
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83
     } ;
 
-static yyconst flex_int16_t yy_chk[217] =
+static yyconst flex_int16_t yy_chk[250] =
     {   0,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
@@ -2481,23 +2503,26 @@
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,   11,   12,   13,   16,   17,   18,   19,   78,
-       20,   30,   31,   32,   16,   33,   34,   36,   37,   38,
-       39,   67,   11,   12,   13,   41,   17,   18,   42,   19,
-       20,   30,   31,   32,   16,   33,   34,   36,   37,   38,
-       44,   39,   46,   47,   48,   41,   49,   50,   42,   51,
-
-       52,   53,   54,   55,   56,   57,   58,   59,   60,   61,
-       44,   62,   46,   47,   48,   63,   49,   50,   64,   51,
-       52,   53,   54,   55,   56,   57,   58,   59,   60,   61,
-       65,   62,   68,   69,   71,   63,   72,   73,   64,   74,
-       45,   43,   29,   23,   22,   21,   14,    9,    7,    5,
-       65,    0,   68,   69,   71,    0,   72,   73,    0,   74,
-       77,    0,   77,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76
+        1,    1,    1,    1,    1,   11,   11,   11,   11,   11,
+       12,   12,   12,   12,   12,   13,   13,   13,   13,   13,
+       12,   18,   19,   20,   21,   13,   14,   14,   14,   14,
+       14,   18,   22,   85,   23,   34,   14,   35,   36,   37,
+       38,   12,   39,   19,   20,   21,   13,   27,   27,   27,
+
+       27,   27,   18,   41,   22,   23,   34,   14,   35,   36,
+       37,   38,   42,   39,   43,   44,   45,   74,   47,   49,
+       51,   53,   54,   55,   41,   56,   57,   58,   59,   60,
+       61,   62,   63,   42,   64,   43,   44,   65,   45,   47,
+       49,   51,   53,   54,   55,   66,   56,   57,   58,   59,
+       60,   61,   62,   63,   67,   64,   68,   69,   65,   70,
+       71,   72,   75,   76,   78,   79,   66,   80,   81,   52,
+       50,   33,   26,   25,   24,   67,   15,   68,   69,    9,
+       70,   71,   72,   75,   76,   78,   79,    7,   80,   81,
+       84,    5,   84,   83,   83,   83,   83,   83,   83,   83,
+
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83
     } ;
 
@@ -2505,6 +2530,6 @@
 static char *yy_last_accepting_cpos;
 
-extern int yy_flex_debug;
-int yy_flex_debug = 0;
+extern int convert__flex_debug;
+int convert__flex_debug = 0;
 
 /* The intent behind this definition is that it'll catch
@@ -2515,5 +2540,5 @@
 #define YY_MORE_ADJ 0
 #define YY_RESTORE_YY_MORE_OFFSET
-char *yytext;
+char *convert_text;
 #line 1 "convert.lex"
 /******************************************************************************/
@@ -2552,13 +2577,11 @@
 /******************************************************************************/
 
-#line 37 "convert.lex"
+#line 40 "convert.lex"
 #include <math.h>
 #include <stdlib.h>
 #include <string.h>
-int line_num=1;
-extern FILE * yyin;
-#define MAX_INCLUDE_DEPTH 30
-YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
-#line 566 "convert.yy.c"
+
+#define YY_NO_INPUT
+#line 595 "convert.yy.c"
 
 #define INITIAL 0
@@ -2582,29 +2605,29 @@
    These are made visible to non-reentrant scanners for convenience. */
 
-int yylex_destroy (void );
-
-int yyget_debug (void );
-
-void yyset_debug (int debug_flag  );
-
-YY_EXTRA_TYPE yyget_extra (void );
-
-void yyset_extra (YY_EXTRA_TYPE user_defined  );
-
-FILE *yyget_in (void );
-
-void yyset_in  (FILE * in_str  );
-
-FILE *yyget_out (void );
-
-void yyset_out  (FILE * out_str  );
-
-yy_size_t yyget_leng (void );
-
-char *yyget_text (void );
-
-int yyget_lineno (void );
-
-void yyset_lineno (int line_number  );
+int convert_lex_destroy (void );
+
+int convert_get_debug (void );
+
+void convert_set_debug (int debug_flag  );
+
+YY_EXTRA_TYPE convert_get_extra (void );
+
+void convert_set_extra (YY_EXTRA_TYPE user_defined  );
+
+FILE *convert_get_in (void );
+
+void convert_set_in  (FILE * in_str  );
+
+FILE *convert_get_out (void );
+
+void convert_set_out  (FILE * out_str  );
+
+yy_size_t convert_get_leng (void );
+
+char *convert_get_text (void );
+
+int convert_get_lineno (void );
+
+void convert_set_lineno (int line_number  );
 
 /* Macros after this point can all be overridden by user definitions in
@@ -2614,7 +2637,7 @@
 #ifndef YY_SKIP_YYWRAP
 #ifdef __cplusplus
-extern "C" int yywrap (void );
+extern "C" int convert_wrap (void );
 #else
-extern int yywrap (void );
+extern int convert_wrap (void );
 #endif
 #endif
@@ -2650,5 +2673,5 @@
  * we now use fwrite().
  */
-#define ECHO do { if (fwrite( yytext, yyleng, 1, yyout )) {} } while (0)
+#define ECHO fwrite( convert_text, convert_leng, 1, convert_out )
 #endif
 
@@ -2661,11 +2684,11 @@
 		{ \
 		int c = '*'; \
-		size_t n; \
+		yy_size_t n; \
 		for ( n = 0; n < max_size && \
-			     (c = getc( yyin )) != EOF && c != '\n'; ++n ) \
+			     (c = getc( convert_in )) != EOF && c != '\n'; ++n ) \
 			buf[n] = (char) c; \
 		if ( c == '\n' ) \
 			buf[n++] = (char) c; \
-		if ( c == EOF && ferror( yyin ) ) \
+		if ( c == EOF && ferror( convert_in ) ) \
 			YY_FATAL_ERROR( "input in flex scanner failed" ); \
 		result = n; \
@@ -2674,5 +2697,5 @@
 		{ \
 		errno=0; \
-		while ( (result = fread(buf, 1, max_size, yyin))==0 && ferror(yyin)) \
+		while ( (result = fread(buf, 1, max_size, convert_in))==0 && ferror(convert_in)) \
 			{ \
 			if( errno != EINTR) \
@@ -2682,5 +2705,5 @@
 				} \
 			errno=0; \
-			clearerr(yyin); \
+			clearerr(convert_in); \
 			} \
 		}\
@@ -2715,10 +2738,10 @@
 #define YY_DECL_IS_OURS 1
 
-extern int yylex (void);
-
-#define YY_DECL int yylex (void)
+extern int convert_lex (void);
+
+#define YY_DECL int convert_lex (void)
 #endif /* !YY_DECL */
 
-/* Code executed at the beginning of each rule, after yytext and yyleng
+/* Code executed at the beginning of each rule, after convert_text and convert_leng
  * have been set up.
  */
@@ -2743,7 +2766,7 @@
 	register int yy_act;
     
-#line 55 "convert.lex"
-
-#line 751 "convert.yy.c"
+#line 54 "convert.lex"
+
+#line 780 "convert.yy.c"
 
 	if ( !(yy_init) )
@@ -2758,17 +2781,17 @@
 			(yy_start) = 1;	/* first start state */
 
-		if ( ! yyin )
-			yyin = stdin;
-
-		if ( ! yyout )
-			yyout = stdout;
+		if ( ! convert_in )
+			convert_in = stdin;
+
+		if ( ! convert_out )
+			convert_out = stdout;
 
 		if ( ! YY_CURRENT_BUFFER ) {
-			yyensure_buffer_stack ();
+			convert_ensure_buffer_stack ();
 			YY_CURRENT_BUFFER_LVALUE =
-				yy_create_buffer(yyin,YY_BUF_SIZE );
+				convert__create_buffer(convert_in,YY_BUF_SIZE );
 		}
 
-		yy_load_buffer_state( );
+		convert__load_buffer_state( );
 		}
 
@@ -2777,5 +2800,5 @@
 		yy_cp = (yy_c_buf_p);
 
-		/* Support of yytext. */
+		/* Support of convert_text. */
 		*yy_cp = (yy_hold_char);
 
@@ -2798,5 +2821,5 @@
 				{
 				yy_current_state = (int) yy_def[yy_current_state];
-				if ( yy_current_state >= 77 )
+				if ( yy_current_state >= 84 )
 					yy_c = yy_meta[(unsigned int) yy_c];
 				}
@@ -2804,5 +2827,5 @@
 			++yy_cp;
 			}
-		while ( yy_base[yy_current_state] != 164 );
+		while ( yy_base[yy_current_state] != 194 );
 
 yy_find_action:
@@ -2830,65 +2853,79 @@
 case 1:
 YY_RULE_SETUP
-#line 56 "convert.lex"
-return TOK_MODULEMAIN; /* name of the module                      */
+#line 55 "convert.lex"
+{ return TOK_MODULEMAIN; } /* name of the module                      */
 	YY_BREAK
 case 2:
 YY_RULE_SETUP
-#line 57 "convert.lex"
-return TOK_NOTGRIDDEP; /* variable which are not grid dependent   */
+#line 56 "convert.lex"
+{ return TOK_NOTGRIDDEP; } /* variable which are not grid dependent   */
 	YY_BREAK
 case 3:
 YY_RULE_SETUP
-#line 58 "convert.lex"
-return TOK_USE;
+#line 57 "convert.lex"
+{ return TOK_USE; }
 	YY_BREAK
 case 4:
 YY_RULE_SETUP
-#line 59 "convert.lex"
-{}
+#line 58 "convert.lex"
+{ }
 	YY_BREAK
 case 5:
 YY_RULE_SETUP
-#line 60 "convert.lex"
-return TOK_SEP;
+#line 59 "convert.lex"
+{ return TOK_SEP; }
 	YY_BREAK
 case 6:
 YY_RULE_SETUP
-#line 61 "convert.lex"
-{strcpy(yylval.na,yytext); return TOK_USEITEM;}
+#line 60 "convert.lex"
+{ return TOK_KIND; }
 	YY_BREAK
 case 7:
 YY_RULE_SETUP
-#line 62 "convert.lex"
-{strcpy(yylval.na,yytext); return TOK_PROBTYPE;}
+#line 61 "convert.lex"
+{ return TOK_EQUAL; }
 	YY_BREAK
-/* dimension of the problem                */
 case 8:
 YY_RULE_SETUP
-#line 64 "convert.lex"
-{strcpy(yylval.na,yytext); return TOK_NAME;}
+#line 62 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_USEITEM;  }
 	YY_BREAK
 case 9:
 YY_RULE_SETUP
-#line 65 "convert.lex"
-{return (int) *yytext;}
+#line 63 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_PROBTYPE; }  /* dimension of the problem */
 	YY_BREAK
 case 10:
-/* rule 10 can match eol */
 YY_RULE_SETUP
-#line 66 "convert.lex"
-{line_num++;return (int) *yytext;}
+#line 64 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_NAME; }
 	YY_BREAK
 case 11:
 YY_RULE_SETUP
-#line 67 "convert.lex"
-;
+#line 65 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_CSTINT; }
 	YY_BREAK
 case 12:
 YY_RULE_SETUP
+#line 66 "convert.lex"
+{ return (int) *convert_text; }
+	YY_BREAK
+case 13:
+/* rule 13 can match eol */
+YY_RULE_SETUP
+#line 67 "convert.lex"
+{ line_num++; return (int) *convert_text; }
+	YY_BREAK
+case 14:
+YY_RULE_SETUP
 #line 68 "convert.lex"
+;
+	YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 69 "convert.lex"
 ECHO;
 	YY_BREAK
-#line 896 "convert.yy.c"
+#line 939 "convert.yy.c"
 case YY_STATE_EOF(INITIAL):
 case YY_STATE_EOF(character):
@@ -2908,6 +2945,6 @@
 			/* We're scanning a new file or input source.  It's
 			 * possible that this happened because the user
-			 * just pointed yyin at a new source and called
-			 * yylex().  If so, then we have to assure
+			 * just pointed convert_in at a new source and called
+			 * convert_lex().  If so, then we have to assure
 			 * consistency between YY_CURRENT_BUFFER and our
 			 * globals.  Here is the right place to do so, because
@@ -2916,5 +2953,5 @@
 			 */
 			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
-			YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin;
+			YY_CURRENT_BUFFER_LVALUE->yy_input_file = convert_in;
 			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
 			}
@@ -2969,9 +3006,9 @@
 				(yy_did_buffer_switch_on_eof) = 0;
 
-				if ( yywrap( ) )
+				if ( convert_wrap( ) )
 					{
 					/* Note: because we've taken care in
 					 * yy_get_next_buffer() to have set up
-					 * yytext, we can now set up
+					 * convert_text, we can now set up
 					 * yy_c_buf_p so that if some total
 					 * hoser (like flex itself) wants to
@@ -3022,5 +3059,5 @@
 	} /* end of action switch */
 		} /* end of scanning one token */
-} /* end of yylex */
+} /* end of convert_lex */
 
 /* yy_get_next_buffer - try to read in a new buffer
@@ -3084,5 +3121,5 @@
 
 			/* just a shorter name for the current buffer */
-			YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE;
+			YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
 
 			int yy_c_buf_p_offset =
@@ -3100,5 +3137,5 @@
 				b->yy_ch_buf = (char *)
 					/* Include room in for 2 EOB chars. */
-					yyrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
+					convert_realloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
 				}
 			else
@@ -3132,5 +3169,5 @@
 			{
 			ret_val = EOB_ACT_END_OF_FILE;
-			yyrestart(yyin  );
+			convert_restart(convert_in  );
 			}
 
@@ -3149,5 +3186,5 @@
 		/* Extend the array by 50%, plus the number we really need. */
 		yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
-		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
+		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) convert_realloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
 		if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
 			YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
@@ -3183,5 +3220,5 @@
 			{
 			yy_current_state = (int) yy_def[yy_current_state];
-			if ( yy_current_state >= 77 )
+			if ( yy_current_state >= 84 )
 				yy_c = yy_meta[(unsigned int) yy_c];
 			}
@@ -3211,11 +3248,11 @@
 		{
 		yy_current_state = (int) yy_def[yy_current_state];
-		if ( yy_current_state >= 77 )
+		if ( yy_current_state >= 84 )
 			yy_c = yy_meta[(unsigned int) yy_c];
 		}
 	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
-	yy_is_jam = (yy_current_state == 76);
-
-		return yy_is_jam ? 0 : yy_current_state;
+	yy_is_jam = (yy_current_state == 83);
+
+	return yy_is_jam ? 0 : yy_current_state;
 }
 
@@ -3226,5 +3263,5 @@
     yy_cp = (yy_c_buf_p);
 
-	/* undo effects of setting up yytext */
+	/* undo effects of setting up convert_text */
 	*yy_cp = (yy_hold_char);
 
@@ -3298,5 +3335,5 @@
 
 					/* Reset buffer status. */
-					yyrestart(yyin );
+					convert_restart(convert_in );
 
 					/*FALLTHROUGH*/
@@ -3304,6 +3341,6 @@
 				case EOB_ACT_END_OF_FILE:
 					{
-					if ( yywrap( ) )
-						return EOF;
+					if ( convert_wrap( ) )
+						return 0;
 
 					if ( ! (yy_did_buffer_switch_on_eof) )
@@ -3324,5 +3361,5 @@
 
 	c = *(unsigned char *) (yy_c_buf_p);	/* cast for 8-bit char's */
-	*(yy_c_buf_p) = '\0';	/* preserve yytext */
+	*(yy_c_buf_p) = '\0';	/* preserve convert_text */
 	(yy_hold_char) = *++(yy_c_buf_p);
 
@@ -3336,15 +3373,15 @@
  * @note This function does not reset the start condition to @c INITIAL .
  */
-    void yyrestart  (FILE * input_file )
+    void convert_restart  (FILE * input_file )
 {
     
 	if ( ! YY_CURRENT_BUFFER ){
-        yyensure_buffer_stack ();
+        convert_ensure_buffer_stack ();
 		YY_CURRENT_BUFFER_LVALUE =
-            yy_create_buffer(yyin,YY_BUF_SIZE );
+            convert__create_buffer(convert_in,YY_BUF_SIZE );
 	}
 
-	yy_init_buffer(YY_CURRENT_BUFFER,input_file );
-	yy_load_buffer_state( );
+	convert__init_buffer(YY_CURRENT_BUFFER,input_file );
+	convert__load_buffer_state( );
 }
 
@@ -3353,13 +3390,13 @@
  * 
  */
-    void yy_switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
+    void convert__switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
 {
     
 	/* TODO. We should be able to replace this entire function body
 	 * with
-	 *		yypop_buffer_state();
-	 *		yypush_buffer_state(new_buffer);
+	 *		convert_pop_buffer_state();
+	 *		convert_push_buffer_state(new_buffer);
      */
-	yyensure_buffer_stack ();
+	convert_ensure_buffer_stack ();
 	if ( YY_CURRENT_BUFFER == new_buffer )
 		return;
@@ -3374,9 +3411,9 @@
 
 	YY_CURRENT_BUFFER_LVALUE = new_buffer;
-	yy_load_buffer_state( );
+	convert__load_buffer_state( );
 
 	/* We don't actually know whether we did this switch during
-	 * EOF (yywrap()) processing, but the only time this flag
-	 * is looked at is after yywrap() is called, so it's safe
+	 * EOF (convert_wrap()) processing, but the only time this flag
+	 * is looked at is after convert_wrap() is called, so it's safe
 	 * to go ahead and always set it.
 	 */
@@ -3384,9 +3421,9 @@
 }
 
-static void yy_load_buffer_state  (void)
+static void convert__load_buffer_state  (void)
 {
     	(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
 	(yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
-	yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+	convert_in = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
 	(yy_hold_char) = *(yy_c_buf_p);
 }
@@ -3398,11 +3435,11 @@
  * @return the allocated buffer state.
  */
-    YY_BUFFER_STATE yy_create_buffer  (FILE * file, int  size )
+    YY_BUFFER_STATE convert__create_buffer  (FILE * file, int  size )
 {
 	YY_BUFFER_STATE b;
     
-	b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state )  );
+	b = (YY_BUFFER_STATE) convert_alloc(sizeof( struct yy_buffer_state )  );
 	if ( ! b )
-		YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+		YY_FATAL_ERROR( "out of dynamic memory in convert__create_buffer()" );
 
 	b->yy_buf_size = size;
@@ -3411,11 +3448,11 @@
 	 * we need to put in 2 end-of-buffer characters.
 	 */
-	b->yy_ch_buf = (char *) yyalloc(b->yy_buf_size + 2  );
+	b->yy_ch_buf = (char *) convert_alloc(b->yy_buf_size + 2  );
 	if ( ! b->yy_ch_buf )
-		YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+		YY_FATAL_ERROR( "out of dynamic memory in convert__create_buffer()" );
 
 	b->yy_is_our_buffer = 1;
 
-	yy_init_buffer(b,file );
+	convert__init_buffer(b,file );
 
 	return b;
@@ -3423,8 +3460,8 @@
 
 /** Destroy the buffer.
- * @param b a buffer created with yy_create_buffer()
+ * @param b a buffer created with convert__create_buffer()
  * 
  */
-    void yy_delete_buffer (YY_BUFFER_STATE  b )
+    void convert__delete_buffer (YY_BUFFER_STATE  b )
 {
     
@@ -3436,25 +3473,29 @@
 
 	if ( b->yy_is_our_buffer )
-		yyfree((void *) b->yy_ch_buf  );
-
-	yyfree((void *) b  );
-}
-
+		convert_free((void *) b->yy_ch_buf  );
+
+	convert_free((void *) b  );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+    
 /* Initializes or reinitializes a buffer.
  * This function is sometimes called more than once on the same buffer,
- * such as during a yyrestart() or at EOF.
+ * such as during a convert_restart() or at EOF.
  */
-    static void yy_init_buffer  (YY_BUFFER_STATE  b, FILE * file )
+    static void convert__init_buffer  (YY_BUFFER_STATE  b, FILE * file )
 
 {
 	int oerrno = errno;
     
-	yy_flush_buffer(b );
+	convert__flush_buffer(b );
 
 	b->yy_input_file = file;
 	b->yy_fill_buffer = 1;
 
-    /* If b is the current buffer, then yy_init_buffer was _probably_
-     * called from yyrestart() or through yy_get_next_buffer.
+    /* If b is the current buffer, then convert__init_buffer was _probably_
+     * called from convert_restart() or through yy_get_next_buffer.
      * In that case, we don't want to reset the lineno or column.
      */
@@ -3473,5 +3514,5 @@
  * 
  */
-    void yy_flush_buffer (YY_BUFFER_STATE  b )
+    void convert__flush_buffer (YY_BUFFER_STATE  b )
 {
     	if ( ! b )
@@ -3493,5 +3534,5 @@
 
 	if ( b == YY_CURRENT_BUFFER )
-		yy_load_buffer_state( );
+		convert__load_buffer_state( );
 }
 
@@ -3502,12 +3543,12 @@
  *  
  */
-void yypush_buffer_state (YY_BUFFER_STATE new_buffer )
+void convert_push_buffer_state (YY_BUFFER_STATE new_buffer )
 {
     	if (new_buffer == NULL)
 		return;
 
-	yyensure_buffer_stack();
-
-	/* This block is copied from yy_switch_to_buffer. */
+	convert_ensure_buffer_stack();
+
+	/* This block is copied from convert__switch_to_buffer. */
 	if ( YY_CURRENT_BUFFER )
 		{
@@ -3523,6 +3564,6 @@
 	YY_CURRENT_BUFFER_LVALUE = new_buffer;
 
-	/* copied from yy_switch_to_buffer. */
-	yy_load_buffer_state( );
+	/* copied from convert__switch_to_buffer. */
+	convert__load_buffer_state( );
 	(yy_did_buffer_switch_on_eof) = 1;
 }
@@ -3532,10 +3573,10 @@
  *  
  */
-void yypop_buffer_state (void)
+void convert_pop_buffer_state (void)
 {
     	if (!YY_CURRENT_BUFFER)
 		return;
 
-	yy_delete_buffer(YY_CURRENT_BUFFER );
+	convert__delete_buffer(YY_CURRENT_BUFFER );
 	YY_CURRENT_BUFFER_LVALUE = NULL;
 	if ((yy_buffer_stack_top) > 0)
@@ -3543,5 +3584,5 @@
 
 	if (YY_CURRENT_BUFFER) {
-		yy_load_buffer_state( );
+		convert__load_buffer_state( );
 		(yy_did_buffer_switch_on_eof) = 1;
 	}
@@ -3551,5 +3592,5 @@
  *  Guarantees space for at least one push.
  */
-static void yyensure_buffer_stack (void)
+static void convert_ensure_buffer_stack (void)
 {
 	yy_size_t num_to_alloc;
@@ -3562,9 +3603,9 @@
          */
 		num_to_alloc = 1;
-		(yy_buffer_stack) = (struct yy_buffer_state**)yyalloc
+		(yy_buffer_stack) = (struct yy_buffer_state**)convert_alloc
 								(num_to_alloc * sizeof(struct yy_buffer_state*)
 								);
 		if ( ! (yy_buffer_stack) )
-			YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );
+			YY_FATAL_ERROR( "out of dynamic memory in convert_ensure_buffer_stack()" );
 								  
 		memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
@@ -3581,10 +3622,10 @@
 
 		num_to_alloc = (yy_buffer_stack_max) + grow_size;
-		(yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc
+		(yy_buffer_stack) = (struct yy_buffer_state**)convert_realloc
 								((yy_buffer_stack),
 								num_to_alloc * sizeof(struct yy_buffer_state*)
 								);
 		if ( ! (yy_buffer_stack) )
-			YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );
+			YY_FATAL_ERROR( "out of dynamic memory in convert_ensure_buffer_stack()" );
 
 		/* zero only the new slots.*/
@@ -3600,5 +3641,5 @@
  * @return the newly allocated buffer state object. 
  */
-YY_BUFFER_STATE yy_scan_buffer  (char * base, yy_size_t  size )
+YY_BUFFER_STATE convert__scan_buffer  (char * base, yy_size_t  size )
 {
 	YY_BUFFER_STATE b;
@@ -3610,7 +3651,7 @@
 		return 0;
 
-	b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state )  );
+	b = (YY_BUFFER_STATE) convert_alloc(sizeof( struct yy_buffer_state )  );
 	if ( ! b )
-		YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );
+		YY_FATAL_ERROR( "out of dynamic memory in convert__scan_buffer()" );
 
 	b->yy_buf_size = size - 2;	/* "- 2" to take care of EOB's */
@@ -3624,10 +3665,10 @@
 	b->yy_buffer_status = YY_BUFFER_NEW;
 
-	yy_switch_to_buffer(b  );
+	convert__switch_to_buffer(b  );
 
 	return b;
 }
 
-/** Setup the input buffer state to scan a string. The next call to yylex() will
+/** Setup the input buffer state to scan a string. The next call to convert_lex() will
  * scan from a @e copy of @a str.
  * @param yystr a NUL-terminated string to scan
@@ -3635,31 +3676,30 @@
  * @return the newly allocated buffer state object.
  * @note If you want to scan bytes that may contain NUL values, then use
- *       yy_scan_bytes() instead.
+ *       convert__scan_bytes() instead.
  */
-YY_BUFFER_STATE yy_scan_string (yyconst char * yystr )
+YY_BUFFER_STATE convert__scan_string (yyconst char * yystr )
 {
     
-	return yy_scan_bytes(yystr,strlen(yystr) );
-}
-
-/** Setup the input buffer state to scan the given bytes. The next call to yylex() will
+	return convert__scan_bytes(yystr,strlen(yystr) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to convert_lex() will
  * scan from a @e copy of @a bytes.
- * @param yybytes the byte buffer to scan
- * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes.
+ * @param bytes the byte buffer to scan
+ * @param len the number of bytes in the buffer pointed to by @a bytes.
  * 
  * @return the newly allocated buffer state object.
  */
-YY_BUFFER_STATE yy_scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
+YY_BUFFER_STATE convert__scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
 {
 	YY_BUFFER_STATE b;
 	char *buf;
-	yy_size_t n;
-	int i;
+	yy_size_t n, i;
     
 	/* Get memory for full buffer, including space for trailing EOB's. */
 	n = _yybytes_len + 2;
-	buf = (char *) yyalloc(n  );
+	buf = (char *) convert_alloc(n  );
 	if ( ! buf )
-		YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );
+		YY_FATAL_ERROR( "out of dynamic memory in convert__scan_bytes()" );
 
 	for ( i = 0; i < _yybytes_len; ++i )
@@ -3668,7 +3708,7 @@
 	buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
 
-	b = yy_scan_buffer(buf,n );
+	b = convert__scan_buffer(buf,n );
 	if ( ! b )
-		YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );
+		YY_FATAL_ERROR( "bad buffer in convert__scan_bytes()" );
 
 	/* It's okay to grow etc. this buffer, and we should throw it
@@ -3696,12 +3736,12 @@
 	do \
 		{ \
-		/* Undo effects of setting up yytext. */ \
+		/* Undo effects of setting up convert_text. */ \
         int yyless_macro_arg = (n); \
         YY_LESS_LINENO(yyless_macro_arg);\
-		yytext[yyleng] = (yy_hold_char); \
-		(yy_c_buf_p) = yytext + yyless_macro_arg; \
+		convert_text[convert_leng] = (yy_hold_char); \
+		(yy_c_buf_p) = convert_text + yyless_macro_arg; \
 		(yy_hold_char) = *(yy_c_buf_p); \
 		*(yy_c_buf_p) = '\0'; \
-		yyleng = yyless_macro_arg; \
+		convert_leng = yyless_macro_arg; \
 		} \
 	while ( 0 )
@@ -3712,8 +3752,8 @@
  * 
  */
-int yyget_lineno  (void)
+int convert_get_lineno  (void)
 {
         
-    return yylineno;
+    return convert_lineno;
 }
 
@@ -3721,7 +3761,7 @@
  * 
  */
-FILE *yyget_in  (void)
-{
-        return yyin;
+FILE *convert_get_in  (void)
+{
+        return convert_in;
 }
 
@@ -3729,7 +3769,7 @@
  * 
  */
-FILE *yyget_out  (void)
-{
-        return yyout;
+FILE *convert_get_out  (void)
+{
+        return convert_out;
 }
 
@@ -3737,7 +3777,7 @@
  * 
  */
-yy_size_t yyget_leng  (void)
-{
-        return yyleng;
+yy_size_t convert_get_leng  (void)
+{
+        return convert_leng;
 }
 
@@ -3746,7 +3786,7 @@
  */
 
-char *yyget_text  (void)
-{
-        return yytext;
+char *convert_get_text  (void)
+{
+        return convert_text;
 }
 
@@ -3755,8 +3795,8 @@
  * 
  */
-void yyset_lineno (int  line_number )
+void convert_set_lineno (int  line_number )
 {
     
-    yylineno = line_number;
+    convert_lineno = line_number;
 }
 
@@ -3765,24 +3805,24 @@
  * @param in_str A readable stream.
  * 
- * @see yy_switch_to_buffer
+ * @see convert__switch_to_buffer
  */
-void yyset_in (FILE *  in_str )
-{
-        yyin = in_str ;
-}
-
-void yyset_out (FILE *  out_str )
-{
-        yyout = out_str ;
-}
-
-int yyget_debug  (void)
-{
-        return yy_flex_debug;
-}
-
-void yyset_debug (int  bdebug )
-{
-        yy_flex_debug = bdebug ;
+void convert_set_in (FILE *  in_str )
+{
+        convert_in = in_str ;
+}
+
+void convert_set_out (FILE *  out_str )
+{
+        convert_out = out_str ;
+}
+
+int convert_get_debug  (void)
+{
+        return convert__flex_debug;
+}
+
+void convert_set_debug (int  bdebug )
+{
+        convert__flex_debug = bdebug ;
 }
 
@@ -3790,5 +3830,5 @@
 {
         /* Initialization is the same as for the non-reentrant scanner.
-     * This function is called from yylex_destroy(), so don't allocate here.
+     * This function is called from convert_lex_destroy(), so don't allocate here.
      */
 
@@ -3802,34 +3842,34 @@
 /* Defined in main.c */
 #ifdef YY_STDINIT
-    yyin = stdin;
-    yyout = stdout;
+    convert_in = stdin;
+    convert_out = stdout;
 #else
-    yyin = (FILE *) 0;
-    yyout = (FILE *) 0;
+    convert_in = (FILE *) 0;
+    convert_out = (FILE *) 0;
 #endif
 
     /* For future reference: Set errno on error, since we are called by
-     * yylex_init()
+     * convert_lex_init()
      */
     return 0;
 }
 
-/* yylex_destroy is for both reentrant and non-reentrant scanners. */
-int yylex_destroy  (void)
+/* convert_lex_destroy is for both reentrant and non-reentrant scanners. */
+int convert_lex_destroy  (void)
 {
     
     /* Pop the buffer stack, destroying each element. */
 	while(YY_CURRENT_BUFFER){
-		yy_delete_buffer(YY_CURRENT_BUFFER  );
+		convert__delete_buffer(YY_CURRENT_BUFFER  );
 		YY_CURRENT_BUFFER_LVALUE = NULL;
-		yypop_buffer_state();
+		convert_pop_buffer_state();
 	}
 
 	/* Destroy the stack itself. */
-	yyfree((yy_buffer_stack) );
+	convert_free((yy_buffer_stack) );
 	(yy_buffer_stack) = NULL;
 
     /* Reset the globals. This is important in a non-reentrant scanner so the next time
-     * yylex() is called, initialization will occur. */
+     * convert_lex() is called, initialization will occur. */
     yy_init_globals( );
 
@@ -3861,10 +3901,10 @@
 #endif
 
-void *yyalloc (yy_size_t  size )
+void *convert_alloc (yy_size_t  size )
 {
 	return (void *) malloc( size );
 }
 
-void *yyrealloc  (void * ptr, yy_size_t  size )
+void *convert_realloc  (void * ptr, yy_size_t  size )
 {
 	/* The cast to (char *) in the following accommodates both
@@ -3878,32 +3918,13 @@
 }
 
-void yyfree (void * ptr )
-{
-	free( (char *) ptr );	/* see yyrealloc() for (char *) cast */
+void convert_free (void * ptr )
+{
+	free( (char *) ptr );	/* see convert_realloc() for (char *) cast */
 }
 
 #define YYTABLES_NAME "yytables"
 
-#line 68 "convert.lex"
-
-
-
-
-int yywrap()
-{
-}
-
-
-yyerror(char *s)
-{
-if (!strcasecmp(curfile,mainfile))
-{
-   printf("Dans convert %s line %d, fichier %s\n",s,line_num,curfile);
-}
-else
-{
-   printf("Dans convert %s line %d, fichier %s\n",s,line_num,curfile);
-}
-exit(0);
-}
-
+#line 69 "convert.lex"
+
+
+
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/run
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/run	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/run	(revision 6808)
@@ -1,2 +1,2 @@
-gmake -f Makefile.lex clean
-gmake -f Makefile.lex
+make -f Makefile.lex clean
+make -f Makefile.lex
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c	(revision 6808)
@@ -37,288 +37,224 @@
 #include <string.h>
 #include "decl.h"
-char lvargridname[LONG_4C];
-char lvargridname2[LONG_4C];
-
-
-/******************************************************************************/
-/*                       variablenameroottabvars                              */
+
+const char * tabvarsname(const variable *var)
+{
+    static char * tname[5] = {
+        "tabvars",      // v_catvar == 0
+        "tabvars_c",    // v_catvar == 1
+        "tabvars_r",    // v_catvar == 2
+        "tabvars_l",    // v_catvar == 3
+        "tabvars_i"     // v_catvar == 4
+    };
+    return tname[var->v_catvar];    // v_catvar should never be ouside the range [0:4].
+}
+
+/******************************************************************************/
+/*                        variablecurgridtabvars                              */
 /******************************************************************************/
 /* This subroutine is used to create the string                               */
 /******************************************************************************/
 /*                                                                            */
-/*  ----------->  Agrif_Mygrid % tabvars (i) % var                            */
-/*                                                                            */
-/******************************************************************************/
-char *variablenameroottabvars (variable * var)
-{
-  char *ligne;
-
-  ligne = (char *) malloc (LONG_C * sizeof (char));
-  sprintf (ligne, "Agrif_Mygrid %% tabvars(%d) %% var ", var->v_indicetabvars);
-  return ligne;
-}
-
-
-/******************************************************************************/
-/*                        variablenametabvars                                 */
+/*  ----------->  Agrif_Curgrid % tabvars (i)                                 */
+/*                                                                            */
+/******************************************************************************/
+const char * variablecurgridtabvars(int which_grid)
+{
+    static char * varname[4] = {
+        " Agrif_%s(%d)",                // which_grid == 0
+        " Agrif_%s(%d) %% parent_var",  // which_grid == 1
+        " Agrif_Mygrid %% %s(%d)",      // which_grid == 2
+        " Agrif_Curgrid %% %s(%d)",     // which_grid == 3
+    };
+
+    return varname[which_grid];
+}
+
+void WARNING_CharSize(const variable *var)
+{
+    if ( var->v_nbdim == 0 )
+    {
+        if ( convert2int(var->v_dimchar) > 2400 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 2400. You must change         \n");
+            printf("   the dimension of carray0                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 161. Replace 2400 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),1);
+    }
+    else if ( var->v_nbdim == 1 )
+    {
+        if ( convert2int(var->v_dimchar) > 200 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 200. You must change          \n");
+            printf("   the dimension of carray1                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 162. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),2);
+    }
+    else if ( var->v_nbdim == 2 )
+    {
+        if ( convert2int(var->v_dimchar) > 200 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 200. You must change          \n");
+            printf("   the dimension of carray2                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 163. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),3);
+    }
+    else if ( var->v_nbdim == 3 )
+    {
+        if ( convert2int(var->v_dimchar) > 200 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 200. You must change          \n");
+            printf("   the dimension of carray3                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 164. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),4);
+    }
+}
+/******************************************************************************/
+/*                           vargridnametabvars                               */
 /******************************************************************************/
 /* This subroutine is used to create the string                               */
 /******************************************************************************/
 /*                                                                            */
-/*  if iorindice = 0 ---------->  Agrif_Gr % tabvars (i) % var                */
-/*                                                                            */
-/*  if iorindice = 1 ---------->  Agrif_Gr % tabvars (12) % var               */
-/*                                                                            */
-/******************************************************************************/
-char *variablenametabvars (variable * var, int iorindice)
-{
-  char *ligne;
-
-  ligne = (char *) malloc (LONG_C * sizeof (char));
-  if ( iorindice == 0 ) sprintf (ligne, " Agrif_Gr %% tabvars(%d)%% var",
-                                 var->v_indicetabvars);
-  else sprintf (ligne, " Agrif_Gr %% tabvars(i)%% var");
-  return ligne;
-}
-
-/******************************************************************************/
-/*                        variablecurgridtabvars                              */
+/*  if iorindice == 0 ----------->  Agrif_Gr % tabvars (i) % array1           */
+/*                                                                            */
+/*  if iorindice == 1 ----------->  Agrif_Gr % tabvars (12) % array1          */
+/*                                                                            */
+/******************************************************************************/
+const char *vargridnametabvars (const variable * var, int iorindice)
+{
+    static char tname_1[LONG_C];
+    static char tname_2[LONG_C];
+
+    if ( iorindice == 0 ) sprintf(tname_1, "Agrif_Gr %% %s(%d)", tabvarsname(var), var->v_indicetabvars);
+    else                  sprintf(tname_1, "Agrif_Gr %% %s(i)",  tabvarsname(var));
+
+    if (!strcasecmp(var->v_typevar, "REAL"))
+    {
+        if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
+        else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
+        else                                                sprintf(tname_2, "%% array%d",  var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "integer"))
+    {
+        sprintf(tname_2, "%% iarray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "logical"))
+    {
+        sprintf(tname_2, "%% larray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "character"))
+    {
+        WARNING_CharSize(var);
+        sprintf (tname_2, "%% carray%d", var->v_nbdim);
+    }
+
+    strcat(tname_1, tname_2);
+    Save_Length(tname_1, 46);
+
+    return tname_1;
+}
+
+/******************************************************************************/
+/*                           vargridcurgridtabvars                            */
 /******************************************************************************/
 /* This subroutine is used to create the string                               */
 /******************************************************************************/
 /*                                                                            */
-/*  ----------->  Agrif_Curgrid % tabvars (i) % var                           */
-/*                                                                            */
-/******************************************************************************/
-char *variablecurgridtabvars (variable * var,int ParentOrCurgrid)
-{
-  char *ligne;
-
-  ligne = (char *) malloc (LONG_C * sizeof (char));
-  if ( ParentOrCurgrid == 0 ) sprintf (ligne, " Agrif_tabvars(%d) %% var",
-                              var->v_indicetabvars);
-  else if ( ParentOrCurgrid == 1 ) sprintf (ligne,
-                              " Agrif_tabvars(%d) %% parent_var %% var",
-                               var->v_indicetabvars);
-  else if ( ParentOrCurgrid == 2 ) sprintf (ligne,
-                              " Agrif_Mygrid %% tabvars(%d) %% var",
-                               var->v_indicetabvars);
-  else if ( ParentOrCurgrid == 3 ) sprintf (ligne,
-                              " Agrif_Curgrid %% tabvars(%d) %% var",
-                               var->v_indicetabvars);
-  else sprintf (ligne, " AGRIF_Mygrid %% tabvars(%d) %% var",
-                               var->v_indicetabvars);
-  return ligne;
-}
-
-void WARNING_CharSize(variable *var)
-{
-   if ( var->v_nbdim == 0 )
-   {
-      if ( convert2int(var->v_dimchar) > 2050 )
-      {
-         printf("WARNING : The dimension of the character  %s   \n",
-                                                              var->v_nomvar);
-         printf("   is upper than 2050. You must change         \n");
-         printf("   the dimension of carray0                    \n");
-         printf("   in the file AGRIF/AGRIF_FILES/modtypes.F    \n");
-         printf("   line 247. Replace 300 with %d.              \n",
-                                            convert2int(var->v_dimchar)+100);
-      }
-      Save_Length_int(convert2int(var->v_dimchar),1);
-   }
-   else if ( var->v_nbdim == 1 )
-   {
-      if ( convert2int(var->v_dimchar) > 300 )
-      {
-         printf("WARNING : The dimension of the character  %s   \n",
-                                                              var->v_nomvar);
-         printf("   is upper than 300. You must change          \n");
-         printf("   the dimension of carray1                    \n");
-         printf("   in the file AGRIF/AGRIF_FILES/modtypes.F    \n");
-         printf("   line 247. Replace 300 with %d.              \n",
-                                            convert2int(var->v_dimchar)+100);
-      }
-      Save_Length_int(convert2int(var->v_dimchar),2);
-   }
-   else if ( var->v_nbdim == 2 )
-   {
-      if ( convert2int(var->v_dimchar) > 300 )
-      {
-         printf("WARNING : The dimension of the character  %s   \n",
-                                                              var->v_nomvar);
-         printf("   is upper than 300. You must change          \n");
-         printf("   the dimension of carray2                    \n");
-         printf("   in the file AGRIF/AGRIF_FILES/modtypes.F    \n");
-         printf("   line 247. Replace 300 with %d.              \n",
-                                            convert2int(var->v_dimchar)+100);
-      }
-      Save_Length_int(convert2int(var->v_dimchar),3);
-   }
-   else if ( var->v_nbdim == 3 )
-   {
-      if ( convert2int(var->v_dimchar) > 300 )
-      {
-         printf("WARNING : The dimension of the character  %s   \n",
-                                                              var->v_nomvar);
-         printf("   is upper than 300. You must change          \n");
-         printf("   the dimension of carray3                    \n");
-         printf("   in the file AGRIF/AGRIF_FILES/modtypes.F    \n");
-         printf("   line 247. Replace 300 with %d.              \n",
-                                            convert2int(var->v_dimchar)+100);
-      }
-      Save_Length_int(convert2int(var->v_dimchar),4);
-   }
-}
-/******************************************************************************/
-/*                           vargridnametabvars                               */
+/* if which_grid == 0 -->  Agrif_Curgrid % tabvars (i) % array1               */
+/*                                                                            */
+/* if which_grid == 1 -->  Agrif_tabvars (i) % parent_var % array1            */
+/*                                                                            */
+/* if which_grid == 2 -->  Agrif_Gr % tabvars (i) % array1                    */
+/*                                                                            */
+/******************************************************************************/
+const char *vargridcurgridtabvars(const variable *var, int which_grid)
+{
+    static char tname_1[LONG_C];
+    static char tname_2[LONG_C];
+
+    if (!strcasecmp(var->v_typevar,"type"))
+    {
+        sprintf(tname_1, "Agrif_%s_var(Agrif_Curgrid%%fixedrank)%%%s", var->v_modulename, var->v_nomvar);
+    }
+    else
+    {
+        sprintf(tname_1, variablecurgridtabvars(which_grid), tabvarsname(var), var->v_indicetabvars);
+
+        if (!strcasecmp(var->v_typevar, "REAL"))
+        {
+            if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
+            else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
+            else                                                sprintf(tname_2, "%% array%d", var->v_nbdim);
+        }
+        else if (!strcasecmp(var->v_typevar, "INTEGER"))
+        {
+            sprintf(tname_2, "%% iarray%d", var->v_nbdim);
+        }
+        else if (!strcasecmp(var->v_typevar, "LOGICAL"))
+        {
+            sprintf(tname_2, "%% larray%d", var->v_nbdim);
+        }
+        else if (!strcasecmp(var->v_typevar, "CHARACTER"))
+        {
+            WARNING_CharSize(var);
+            sprintf(tname_2, "%% carray%d", var->v_nbdim);
+        }
+        strcat(tname_1, tname_2);
+    }
+    Save_Length(tname_1, 46);
+
+    return tname_1;
+}
+
+/******************************************************************************/
+/*                  vargridcurgridtabvarswithoutAgrif_Gr                      */
 /******************************************************************************/
 /* This subroutine is used to create the string                               */
 /******************************************************************************/
 /*                                                                            */
-/*  if iorindice == 0 ----------->  Agrif_Gr % tabvars (i) % var % array1     */
-/*                                                                            */
-/*  if iorindice == 1 ----------->  Agrif_Gr % tabvars (12) % var % array1    */
-/*                                                                            */
-/******************************************************************************/
-char *vargridnametabvars (variable * var,int iorindice)
-{
-  char *tmp;
-  char tmp1[LONG_C];
-
-  tmp = variablenametabvars (var,iorindice);
-  strcpy(tmp1,tmp);
-  if ( todebugfree == 1 ) free(tmp);
-
-  sprintf (lvargridname, "%s", tmp1);
-  if (!strcasecmp (var->v_typevar, "REAL"))
-    {
-      if ( !strcasecmp(var->v_nameinttypename,"8") )
-                           sprintf (lvargridname2, "%% darray%d", var->v_nbdim);
-      else if ( !strcasecmp(var->v_nameinttypename,"4") )
-                           sprintf (lvargridname2, "%% sarray%d", var->v_nbdim);
-      else sprintf (lvargridname2, "%% array%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "INTEGER"))
-    {
-      sprintf (lvargridname2, "%% iarray%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "LOGICAL"))
-    {
-      sprintf (lvargridname2, "%% larray%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "CHARACTER"))
-    {
-      WARNING_CharSize(var);
-      sprintf (lvargridname2, "%% carray%d", var->v_nbdim);
-    }
-
-  strcat (lvargridname, lvargridname2);
-
-  Save_Length(lvargridname,42);
-  Save_Length(lvargridname2,42);
-  return lvargridname;
-}
-
-/******************************************************************************/
-/*                           vargridcurgridtabvars                            */
-/******************************************************************************/
-/* This subroutine is used to create the string                               */
-/******************************************************************************/
-/*                                                                            */
-/* if ParentOrCurgrid == 0 -->  Agrif_Curgrid % tabvars (i) % var % array1    */
-/*                                                                            */
-/* if ParentOrCurgrid == 1 -->  Agrif_tabvars (i) % parent_var %var % array1  */
-/*                                                                            */
-/* if ParentOrCurgrid == 2 -->  Agrif_Gr % tabvars (i) % var % array1         */
-/*                                                                            */
-/******************************************************************************/
-char *vargridcurgridtabvars (variable * var,int ParentOrCurgrid)
-{
-  char *tmp;
-  char tmp1[LONG_C];
-
- if (!strcasecmp(var->v_typevar,"type"))
-  {
-  strcpy(lvargridname2,"");
-  sprintf(lvargridname,"Agrif_%s_var(Agrif_Curgrid%%fixedrank)%%%s",var->v_modulename,var->v_nomvar);
-  printf("modulename = %s %s\n",var->v_nomvar, var->v_modulename);
-  }
-  else
-  {
-  tmp = variablecurgridtabvars (var,ParentOrCurgrid);
-  strcpy(tmp1,tmp);
-  if ( todebugfree == 1 ) free(tmp);
-
-  sprintf (lvargridname, "%s", tmp1);
-  if (!strcasecmp (var->v_typevar, "REAL"))
-    {
-      if ( !strcasecmp(var->v_nameinttypename,"8") )
-                           sprintf (lvargridname2, "%% darray%d", var->v_nbdim);
-      else if ( !strcasecmp(var->v_nameinttypename,"4") )
-                           sprintf (lvargridname2, "%% sarray%d", var->v_nbdim);
-      else sprintf (lvargridname2, "%% array%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "INTEGER"))
-    {
-      sprintf (lvargridname2, "%% iarray%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "LOGICAL"))
-    {
-      sprintf (lvargridname2, "%% larray%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "CHARACTER"))
-    {
-      WARNING_CharSize(var);
-      sprintf (lvargridname2, "%% carray%d", var->v_nbdim);
-    }
-  }
-
-  strcat (lvargridname, lvargridname2);
-
-  Save_Length(lvargridname,42);
-  Save_Length(lvargridname2,42);
-  return lvargridname;
-}
-
-/******************************************************************************/
-/*                  vargridcurgridtabvarswithoutAgrif_Gr                      */
-/******************************************************************************/
-/* This subroutine is used to create the string                               */
-/******************************************************************************/
-/*                                                                            */
-/******************************************************************************/
-char *vargridcurgridtabvarswithoutAgrif_Gr (variable * var)
-{
-
-  sprintf (lvargridname, "(%d) %% var", var->v_indicetabvars);
-
-  if (!strcasecmp (var->v_typevar, "REAL"))
-    {
-      if ( !strcasecmp(var->v_nameinttypename,"8") )
-                           sprintf (lvargridname2, "%% darray%d", var->v_nbdim);
-      else if ( !strcasecmp(var->v_nameinttypename,"4") )
-                           sprintf (lvargridname2, "%% sarray%d", var->v_nbdim);
-      else sprintf (lvargridname2, "%% array%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "INTEGER"))
-    {
-      sprintf (lvargridname2, "%% iarray%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "LOGICAL"))
-    {
-      sprintf (lvargridname2, "%% larray%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "CHARACTER"))
-    {
-      WARNING_CharSize(var);
-      sprintf (lvargridname2, "%% carray%d", var->v_nbdim);
-    }
-
-  strcat (lvargridname, lvargridname2);
-
-  Save_Length(lvargridname,42);
-  Save_Length(lvargridname2,42);
-  return lvargridname;
+/******************************************************************************/
+const char *vargridcurgridtabvarswithoutAgrif_Gr(const variable *var)
+{
+    static char tname_1[LONG_C];
+    static char tname_2[LONG_C];
+
+    sprintf(tname_1, "(%d)", var->v_indicetabvars);
+
+    if (!strcasecmp (var->v_typevar, "REAL"))
+    {
+        if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
+        else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
+        else                                                sprintf(tname_2, "%% array%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "INTEGER"))
+    {
+        sprintf(tname_2, "%% iarray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "LOGICAL"))
+    {
+        sprintf(tname_2, "%% larray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "CHARACTER"))
+    {
+        WARNING_CharSize(var);
+        sprintf(tname_2, "%% carray%d", var->v_nbdim);
+    }
+
+    strcat(tname_1, tname_2);
+    Save_Length(tname_1, 46);
+
+    return tname_1;
 }
 
@@ -333,51 +269,32 @@
 /*                                                                            */
 /******************************************************************************/
-char *vargridparam (variable * v, int whichone)
-{
-  typedim dim;
-  listdim *newdim;
-  char newname[LONG_4C];
-
-  newdim = v->v_dimension;
-  if (!newdim) return "";
-
-  strcpy (tmpvargridname, "(");
-  while (newdim)
-  {
-     dim = newdim->dim;
-
-     strcpy(newname,"");
-     strcpy(newname,
-            ChangeTheInitalvaluebyTabvarsName(dim.first,List_Global_Var,
-                                                                     whichone));
-                                                                     
-        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,
-                       List_Common_Var,whichone));
-
-        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,
-                       List_ModuleUsed_Var,whichone));
-
-     strcat (tmpvargridname, newname);
-     strcat (tmpvargridname, " : ");
-
-     strcpy(newname,"");
-     strcpy(newname,ChangeTheInitalvaluebyTabvarsName
-                        (dim.last,List_Global_Var,whichone));
-                        
-        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
-                       (newname, List_Common_Var,whichone));   
-                       
-        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
-                       (newname, List_ModuleUsed_Var,whichone));                                            
-                        
-     Save_Length(tmpvargridname,46);
-     strcat (tmpvargridname, newname);
-     newdim = newdim->suiv;
-     if (newdim) strcat (tmpvargridname, ",");
-  }
-  strcat (tmpvargridname, ")");
-  strcat (tmpvargridname, "\0");
-  Save_Length(tmpvargridname,40);
-  return tmpvargridname;
+const char * vargridparam(const variable *var)
+{
+    typedim dim;
+    listdim *newdim;
+    char newname[LONG_M];
+
+    newdim = var->v_dimension;
+    if (!newdim) return "";
+
+    strcpy (tmpvargridname, "(");
+    while (newdim)
+    {
+        dim = newdim->dim;
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.first,List_Global_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_Common_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_ModuleUsed_Var));
+        strcat(tmpvargridname, newname);
+        strcat(tmpvargridname, " : ");
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.last,List_Global_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_Common_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_ModuleUsed_Var));
+        strcat(tmpvargridname, newname);
+        newdim = newdim->suiv;
+        if (newdim) strcat(tmpvargridname, ",");
+    }
+    strcat(tmpvargridname, ")\0");
+    Save_Length(tmpvargridname,40);
+    return tmpvargridname;
 }
 
@@ -396,7 +313,7 @@
 {
   FILE *probdim;
-  char ligne[LONG_C];
-
-  probdim = associate("probdim_agrif.h");
+  char ligne[LONG_M];
+
+  probdim = open_for_write("probdim_agrif.h");
   sprintf (ligne, "Agrif_Probdim = %d", dimprob);
   tofich (probdim, ligne,1);
@@ -421,11 +338,7 @@
   FILE *keys;
 
-  keys = associate ("keys_agrif.h");
-  fprintf(keys,"      AGRIF_USE_FIXED_GRIDS = 0\n");
-  fprintf(keys,"      AGRIF_USE_ONLY_FIXED_GRIDS = 0\n");
-  if (fixedgrids     == 1) fprintf(keys,"      AGRIF_USE_FIXED_GRIDS = 1\n");
-  if (onlyfixedgrids == 1)
-                         fprintf(keys,"      AGRIF_USE_ONLY_FIXED_GRIDS = 1\n");
-
+  keys = open_for_write("keys_agrif.h");
+  fprintf(keys,"      AGRIF_USE_FIXED_GRIDS = %d\n", fixedgrids);
+  fprintf(keys,"      AGRIF_USE_ONLY_FIXED_GRIDS = %d\n", onlyfixedgrids);
   fclose(keys);
 }
@@ -444,11 +357,15 @@
 void write_modtypeagrif_file()
 {
-  char ligne[LONG_C];
+  char ligne[LONG_M];
   FILE *typedata;
-
-  typedata = associate ("modtype_agrif.h");
+  int i;
+
+  typedata = open_for_write("modtype_agrif.h");
   /* AGRIF_NbVariables : number of variables                                  */
-  sprintf (ligne, "AGRIF_NbVariables = %d",indicemaxtabvars);
-  tofich(typedata,ligne,1);
+  for (i=0;i<NB_CAT_VARIABLES;i++)
+   {
+    sprintf (ligne, "Agrif_NbVariables(%d) = %d",i,indicemaxtabvars[i]);
+    tofich(typedata,ligne,1);
+   }
   fclose (typedata);
 }
@@ -460,21 +377,14 @@
 /******************************************************************************/
 /*                                                                            */
-/*    Agrif_Gr % tabvars (i) % var % namevar = "variable"                     */
-/*                                                                            */
-/******************************************************************************/
-void write_createvarnameagrif_file(variable *v,FILE *createvarname,
-                                                       int *InitEmpty)
-{
-  char ligne[LONG_C];
-  char *tmp;
-  char temp1[LONG_C];
-
-  tmp =  variablenametabvars(v,0);
-  strcpy (temp1, tmp);
-  if ( todebugfree == 1 ) free(tmp);
-
-  *InitEmpty = 0 ;
-  sprintf(ligne, "%s %% namevar = \"%s\"",temp1,v->v_nomvar);
-  tofich(createvarname,ligne,1);
+/*    Agrif_Gr % tabvars (i) % namevar = "variable"                           */
+/*                                                                            */
+/******************************************************************************/
+void write_createvarnameagrif_file(variable *v,FILE *createvarname, int *InitEmpty)
+{
+    char ligne[LONG_M];
+
+    *InitEmpty = 0 ;
+    sprintf(ligne, "Agrif_Gr %% %s(%d) %% namevar = \"%s\"",tabvarsname(v),v->v_indicetabvars,v->v_nomvar);
+    tofich(createvarname,ligne,1);
 }
 
@@ -488,62 +398,33 @@
 /*                                                                            */
 /******************************************************************************/
-void write_Setnumberofcells_file(char *name)
-{
-  char ligne[LONG_C];
-  FILE *setnumberofcells;
-
-  if ( IndicenbmaillesX != 0 )
-  {
-  setnumberofcells=associate(name);
-
-  if (onlyfixedgrids != 1 )
-  {
-  sprintf (ligne,
-           "Agrif_Gr %% nb(1) = Agrif_Gr %% tabvars(%d) %% var %% iarray0",
-           IndicenbmaillesX);
-  }
-  else
-  {
-  sprintf (ligne,
-           "Agrif_Gr %% nb(1) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0",
-           IndicenbmaillesX);
-  }
-  tofich (setnumberofcells, ligne,1);
-  if (dimprob > 1)
-  {
-     if (onlyfixedgrids != 1 )
-     {
-     sprintf (ligne,
-           "Agrif_Gr %% nb(2) = Agrif_Gr %% tabvars(%d) %% var %% iarray0",
-           IndicenbmaillesY);
-     }
-     else
-     {
-     sprintf (ligne,
-           "Agrif_Gr %% nb(2) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0",
-           IndicenbmaillesY);
-     }
-
-     tofich (setnumberofcells, ligne,1);
-  }
-  if (dimprob > 2)
-  {
-     if (onlyfixedgrids != 1 )
-     {
-     sprintf (ligne,
-           "Agrif_Gr %% nb(3) = Agrif_Gr %% tabvars(%d) %% var %% iarray0",
-           IndicenbmaillesZ);
-     }
-     else
-     {
-     sprintf (ligne,
-           "Agrif_Gr %% nb(3) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0",
-           IndicenbmaillesZ);
-     }
-     tofich (setnumberofcells, ligne,1);
-  }
-
-  fclose (setnumberofcells);
-  }
+void write_Setnumberofcells_file()
+{
+    char ligne[LONG_VNAME];
+    char cformat[LONG_VNAME];
+    FILE *setnumberofcells;
+
+    if ( IndicenbmaillesX == 0 )  return;
+
+    setnumberofcells = open_for_write("SetNumberofcells.h");
+
+    if ( onlyfixedgrids == 1 )
+        strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Curgrid %% tabvars_i(%d) %% iarray0");
+    else
+        strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Gr %% tabvars_i(%d) %% iarray0");
+
+    sprintf(ligne, cformat, 1, IndicenbmaillesX);
+    tofich(setnumberofcells, ligne, 1);
+
+    if ( dimprob > 1 )
+    {
+        sprintf(ligne, cformat, 2, IndicenbmaillesY);
+        tofich(setnumberofcells, ligne, 1);
+    }
+    if ( dimprob > 2 )
+    {
+        sprintf(ligne, cformat, 3, IndicenbmaillesZ);
+        tofich(setnumberofcells, ligne, 1);
+    }
+    fclose(setnumberofcells);
 }
 
@@ -557,32 +438,30 @@
 /*                                                                            */
 /******************************************************************************/
-void write_Getnumberofcells_file(char *name)
-{
-  char ligne[LONG_C];
-  FILE *getnumberofcells;
-
-  if ( IndicenbmaillesX != 0 )
-  {
-  getnumberofcells=associate(name);
-  sprintf (ligne,
-           "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(1)",
-           IndicenbmaillesX);
-  tofich (getnumberofcells, ligne,1);
-  if (dimprob > 1)
-    {
-      sprintf (ligne,
-           "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(2)",
-           IndicenbmaillesY);
-      tofich (getnumberofcells, ligne,1);
-    }
-  if (dimprob > 2)
-    {
-      sprintf (ligne,
-           "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(3)",
-           IndicenbmaillesZ);
-      tofich (getnumberofcells, ligne,1);
-    }
-  fclose (getnumberofcells);
-  }
+void write_Getnumberofcells_file()
+{
+    char ligne[LONG_VNAME];
+    char cformat[LONG_VNAME];
+    FILE *getnumberofcells;
+
+    if ( IndicenbmaillesX == 0 )    return;
+
+    strcpy(cformat, "Agrif_Curgrid %% tabvars_i(%d) %% iarray0 = Agrif_Gr %% nb(%d)");
+
+    getnumberofcells = open_for_write("GetNumberofcells.h");
+
+    sprintf(ligne, cformat, IndicenbmaillesX, 1);
+    tofich(getnumberofcells, ligne, 1);
+
+    if (dimprob > 1)
+    {
+        sprintf(ligne, cformat, IndicenbmaillesY, 2);
+        tofich(getnumberofcells, ligne,1);
+    }
+    if (dimprob > 2)
+    {
+        sprintf(ligne, cformat, IndicenbmaillesZ, 3);
+        tofich(getnumberofcells, ligne,1);
+    }
+    fclose(getnumberofcells);
 }
 
@@ -595,24 +474,17 @@
 /*                                                                            */
 /*              ! variable                                                    */
-/*              Agrif_Gr % tabvars(i) % var % nbdim = 1                       */
-/*                                                                            */
-/******************************************************************************/
-void write_initialisationsagrif_file(variable *v,FILE *initproc,
-                                     int *VarnameEmpty)
-{
-  char ligne[LONG_C];
-  char temp1[LONG_C];
-  char *tmp;
-
-  tmp = variablenameroottabvars (v);
-  strcpy (temp1, tmp);
-  if ( todebugfree == 1 ) free(tmp);
-
-  if ( v->v_nbdim != 0 )
-  {
-     *VarnameEmpty = 0 ;
-     sprintf (ligne, "%s %% nbdim = %d", temp1, v->v_nbdim);
-     tofich (initproc, ligne,1);
-  }
+/*              Agrif_Gr % tabvars(i) % nbdim = 1                             */
+/*                                                                            */
+/******************************************************************************/
+void write_initialisationsagrif_file(variable *v,FILE *initproc,int *VarnameEmpty)
+{
+    char ligne[LONG_M];
+
+    if ( v->v_nbdim != 0 )
+    {
+        *VarnameEmpty = 0 ;
+        sprintf(ligne,"Agrif_Mygrid %% %s(%d) %% nbdim = %d", tabvarsname(v), v->v_indicetabvars, v->v_nbdim);
+        tofich (initproc, ligne,1);
+    }
 }
 
@@ -624,13 +496,12 @@
    FILE *AllocUSE;
 
-   AllocUSE= associate("include_use_Alloc_agrif.h");
-   alloccalls = associate("allocations_calls_agrif.h");
+   AllocUSE= open_for_write("include_use_Alloc_agrif.h");
+   alloccalls = open_for_write("allocations_calls_agrif.h");
 
    parcours = List_Subroutine_For_Alloc;
    while ( parcours )
    {
-      fprintf(AllocUSE,"      USE %s\n", parcours -> o_nom );
-      fprintf (alloccalls,"      Call Alloc_agrif_%s(Agrif_Gr)\n",
-                                                            parcours -> o_nom );
+      fprintf(AllocUSE,"      use %s, only: Alloc_agrif_%s\n", parcours -> o_nom, parcours -> o_nom );
+      fprintf (alloccalls,"      call Alloc_agrif_%s(Agrif_Gr)\n", parcours -> o_nom );
       parcours = parcours -> suiv;
    }
@@ -656,421 +527,338 @@
    return out;
 }
+
 void write_allocation_Common_0()
 {
-   listnom *parcours_nom;
-   listnom *neededparameter;
-   listvar *parcours;
-   listvar *parcoursprec;
-   listvar *parcours1;
-   FILE *allocationagrif;
-   FILE *paramtoamr;
-   char ligne[LONGNOM];
-   char ligne2[LONGNOM];   
-   variable *v;
-   int IndiceMax;
-   int IndiceMin;
-   int compteur;
-   int out;
-   int indiceprec;
-   int ValeurMax;
-   char initialvalue[LONG_4C];
-   listindice *list_indic;
-   listindice *parcoursindic;
-   int i;
-
-   parcoursprec = (listvar *)NULL;
-   parcours_nom = List_NameOfCommon;
-   ValeurMax = 2;
-   while ( parcours_nom  )
-   {
-      /*                                                                      */
-      if ( parcours_nom->o_val == 1 )
-      {
-         /* Open the file to create the Alloc_agrif subroutine                */
-         sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
-         allocationagrif = associate (ligne);
-         /*                                                                   */
-         fprintf(allocationagrif,"#include \"Param_toamr_%s.h\" \n",
-                                                           parcours_nom->o_nom);
-         /*                                                                   */
-         sprintf(ligne,"Param_toamr_%s.h",parcours_nom->o_nom);
-         paramtoamr = associate (ligne);
-         neededparameter = (listnom * )NULL;
-         /*                                                                   */
-         list_indic = (listindice *)NULL;
-         /*                                                                   */
-         shouldincludempif = 1 ;
-         parcours = List_Common_Var;
-         while ( parcours )
-         {
-            if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom) &&
-                  IndiceInlist(parcours->var->v_indicetabvars,list_indic) == 0
-               )
+    listnom *parcours_nom;
+    listnom *neededparameter;
+    listvar *parcours;
+    listvar *parcoursprec;
+    listvar *parcours1;
+    FILE *allocationagrif;
+    FILE *paramtoamr;
+    char ligne[LONG_M];
+    char ligne2[LONG_M];
+    variable *v;
+    int IndiceMax;
+    int IndiceMin;
+    int compteur;
+    int out;
+    int indiceprec;
+    int ValeurMax;
+    char initialvalue[LONG_M];
+    listindice **list_indic;
+    listindice *parcoursindic;
+    int i;
+
+    parcoursprec = (listvar *) NULL;
+    parcours_nom = List_NameOfCommon;
+    ValeurMax = 2;
+    while ( parcours_nom  )
+    {
+        if ( parcours_nom->o_val == 1 )
+        {
+            /* Open the file to create the Alloc_agrif subroutine                */
+            sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
+            allocationagrif = open_for_write(ligne);
+            fprintf(allocationagrif,"#include \"Param_toamr_%s.h\" \n", parcours_nom->o_nom);
+
+            sprintf(ligne,"Param_toamr_%s.h",parcours_nom->o_nom);
+            paramtoamr = open_for_write(ligne);
+            neededparameter = (listnom *) NULL;
+            list_indic = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+
+//             shouldincludempif = 1 ;
+            parcours = List_Common_Var;
+            while ( parcours )
             {
-               /***************************************************************/
-               /***************************************************************/
-               /***************************************************************/
-               v = parcours->var;
-               IndiceMax = 0;
-               IndiceMin = indicemaxtabvars;
-  /* body of the file                                                         */
-  if ( !strcasecmp(v->v_commoninfile,mainfile) )
-  {
-     if (onlyfixedgrids != 1 && v->v_nbdim!=0)
-     {
-        strcpy (ligne, "If (.not. associated(");
-        strcat (ligne, vargridnametabvars(v,0));
-        strcat (ligne, "))                       then");
-        Save_Length(ligne,48);
-        tofich (allocationagrif, ligne,1);
-     }
-     if ( v->v_allocatable != 1 && ( v->v_dimsempty != 1) )
-     {
-        /*                ALLOCATION                                          */
-        if ( v->v_dimension != 0  )
-        {
-           if ( v->v_indicetabvars < IndiceMin ||
-                v->v_indicetabvars > IndiceMax )
-           {
-              parcours1 = parcours;
-              compteur = -1;
-              out = 0;
-              indiceprec = parcours->var->v_indicetabvars -1 ;
-              while ( parcours1 && out == 0 &&
-                      !strcasecmp(  parcours->var->v_readedlistdimension,
-                                  parcours1->var->v_readedlistdimension) &&
-                      !strcasecmp(  parcours->var->v_typevar,
-                                  parcours1->var->v_typevar) &&
-                            ( parcours1->var->v_indicetabvars == indiceprec+1 )
-                     )
-              {
-
-               if ( !strcasecmp(parcours1->var->v_modulename,
-                                parcours_nom->o_nom) ||
-                    !strcasecmp(parcours1->var->v_commonname,
-                                parcours_nom->o_nom) )
-                 {
-                      compteur = compteur +1 ;
-                      indiceprec = parcours1->var->v_indicetabvars;
-                      parcoursprec = parcours1;
-                      parcours1 = parcours1->suiv;
-                 }
-                 else out = 1;
-              }
-
-              if ( compteur > ValeurMax )
-              {
-                 fprintf(allocationagrif,"      DO i = %d , %d\n",
-                                         parcours->var->v_indicetabvars,
-                                       parcours->var->v_indicetabvars+compteur);
-                 IndiceMin = parcours->var->v_indicetabvars;
-                 IndiceMax = parcours->var->v_indicetabvars+compteur;
-                 strcpy (ligne, "allocate ");
-                 strcat (ligne, "(");
-                 strcat (ligne, vargridnametabvars(v,1));
-                 strcat (ligne, vargridparam(v,0));
-                 strcat (ligne, ")");
-                 Save_Length(ligne,48);
-                 tofich (allocationagrif, ligne,1);
-                 fprintf(allocationagrif,"      end do\n");
-                 i=parcours->var->v_indicetabvars;
-                 do
-                 {
-                    parcoursindic =  (listindice *)malloc(sizeof(listindice));
-                    parcoursindic -> i_indice = i;
-                    parcoursindic -> suiv = list_indic;
-                    list_indic = parcoursindic;
-                    i = i + 1;
-                 } while ( i <= parcours->var->v_indicetabvars+compteur );
-                 parcours = parcoursprec;
-                 /*                                                           */
-              }
-              else
-              {
-                 strcpy (ligne, "allocate ");
-                 strcat (ligne, "(");
-                 strcat (ligne, vargridnametabvars(v,0));
-                 strcat (ligne, vargridparam(v,0));
-                 strcat (ligne, ")");
-                 Save_Length(ligne,48);
-                 tofich (allocationagrif, ligne,1);
-                 /*                                                           */
-                 parcoursindic =  (listindice *)malloc(sizeof(listindice));
-                 parcoursindic -> i_indice = parcours->var->v_indicetabvars;
-                 parcoursindic -> suiv = list_indic;
-                 list_indic = parcoursindic;
-              }
-                neededparameter = writedeclarationintoamr(List_Parameter_Var,
-                              paramtoamr,v,parcours_nom->o_nom,neededparameter,
-                                                               v->v_commonname);
-              /*                                                              */
-           }
-        } /* end of the allocation part                                       */
-        /*                INITIALISATION                                      */
-        if ( strcasecmp(v->v_initialvalue,"") )
-        {
-           strcpy (ligne, "");
-           strcat (ligne, vargridnametabvars(v,0));
-           /* We should modify the initialvalue in the case of variable has   */
-           /*    been defined with others variables                           */
-                      
-           strcpy(initialvalue,
-                  ChangeTheInitalvaluebyTabvarsName
-                                      (v->v_initialvalue,List_Global_Var,0));
-           if ( !strcasecmp(initialvalue,v->v_initialvalue) )
-           {
-              strcpy(initialvalue,"");
-              strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
-                                      (v->v_initialvalue,List_Common_Var,0));
-           }
-           if ( !strcasecmp(initialvalue,v->v_initialvalue) )
-           {
-              strcpy(initialvalue,"");
-              strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
-                                     (v->v_initialvalue,List_ModuleUsed_Var,0));
-           }
-           strcat (ligne," = ");
-
-           if (v->v_nbdim == 0)
-           {
-           strcpy(ligne2,initialvalue);
-           }
-           else
-           {
-           sprintf(ligne2,"RESHAPE(%s,SHAPE(%s))",initialvalue,vargridnametabvars(v,0));
-           }
-           strcat (ligne,ligne2);
-           /*                                                                 */
-           Save_Length(ligne,48);
-           tofich (allocationagrif, ligne,1);
-        }
-     }
-     if (onlyfixedgrids != 1 && v->v_nbdim!=0)
-     {
-        strcpy (ligne, "   End if");
-        tofich (allocationagrif, ligne,1);
-     }
-  }
-               /***************************************************************/
-               /***************************************************************/
-               /***************************************************************/
+                if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom) &&
+                    IndiceInlist(parcours->var->v_indicetabvars,list_indic[parcours->var->v_catvar]) == 0 )
+                {
+                    v = parcours->var;
+                    IndiceMax = 0;
+                    IndiceMin = indicemaxtabvars[v->v_catvar];
+                    /* body of the file */
+                    if ( !strcasecmp(v->v_commoninfile,cur_filename) )
+                    {
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0));
+                            tofich(allocationagrif,ligne,1);
+                        }
+                        if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) )
+                        {
+                            /*                ALLOCATION                                          */
+                            if ( v->v_dimension != 0 )
+                            {
+                                if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax )
+                                {
+                                    parcours1 = parcours;
+                                    compteur = -1;
+                                    out = 0;
+                                    indiceprec = parcours->var->v_indicetabvars -1 ;
+                                    while ( parcours1 && out == 0
+                                        && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension)
+                                        && !strcasecmp(parcours->var->v_typevar,            parcours1->var->v_typevar)
+                                        && (parcours1->var->v_indicetabvars == indiceprec+1) )
+                                    {
+                                        if ( !strcasecmp(parcours1->var->v_modulename,parcours_nom->o_nom) ||
+                                             !strcasecmp(parcours1->var->v_commonname,parcours_nom->o_nom) )
+                                        {
+                                            compteur = compteur +1 ;
+                                            indiceprec = parcours1->var->v_indicetabvars;
+                                            parcoursprec = parcours1;
+                                            parcours1 = parcours1->suiv;
+                                        }
+                                        else out = 1;
+                                    }
+                                    sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar);
+                                    tofich(allocationagrif,ligne,1);
+                                    if ( compteur > ValeurMax )
+                                    {
+                                        sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars,
+                                                                      parcours->var->v_indicetabvars+compteur);
+                                        tofich(allocationagrif,ligne,1);
+                                        IndiceMin = parcours->var->v_indicetabvars;
+                                        IndiceMax = parcours->var->v_indicetabvars+compteur;
+                                        sprintf(ligne,"    allocate(%s", vargridnametabvars(v,1));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                        tofich(allocationagrif,"enddo",1);
+                                        i = parcours->var->v_indicetabvars;
+                                        do
+                                        {
+                                            parcoursindic =  (listindice *)calloc(1,sizeof(listindice));
+                                            parcoursindic -> i_indice = i;
+                                            parcoursindic -> suiv = list_indic[parcours->var->v_catvar];
+                                            list_indic[parcours->var->v_catvar] = parcoursindic;
+                                            i = i + 1;
+                                        } while ( i <= parcours->var->v_indicetabvars+compteur );
+                                        parcours = parcoursprec;
+                                    }
+                                    else
+                                    {
+                                        sprintf(ligne,"allocate(%s", vargridnametabvars(v,0));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                        parcoursindic =  (listindice *) calloc(1,sizeof(listindice));
+                                        parcoursindic -> i_indice = parcours->var->v_indicetabvars;
+                                        parcoursindic -> suiv = list_indic[parcours->var->v_catvar];
+                                        list_indic[parcours->var->v_catvar] = parcoursindic;
+                                    }
+                                    neededparameter = writedeclarationintoamr(List_Parameter_Var,
+                                                        paramtoamr,v,parcours_nom->o_nom,neededparameter,v->v_commonname);
+                                }
+                            } /* end of the allocation part                                       */
+                            /*                INITIALISATION                                      */
+                            if ( strcasecmp(v->v_initialvalue,"") )
+                            {
+                                strcpy(ligne, vargridnametabvars(v,0));
+                                /* We should modify the initialvalue in the case of variable has been defined with others variables */
+                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var));
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var));
+                                }
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var));
+                                }
+                                strcat (ligne," = ");
+
+                                if (v->v_nbdim == 0)
+                                {
+                                    strcpy(ligne2,initialvalue);
+                                }
+                                else
+                                {
+                                    sprintf(ligne2,"reshape(%s,shape(%s))",initialvalue,vargridnametabvars(v,0));
+                                }
+                                strcat(ligne,ligne2);
+                                tofich(allocationagrif,ligne,1);
+                            }
+                        }
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            tofich(allocationagrif,"endif",1);
+                        }
+                    }
+                }
+                parcours = parcours -> suiv;
             }
-            parcours = parcours -> suiv;
-         }
-         /* Close the file Alloc_agrif                                        */
-         fclose(allocationagrif);
-         fclose(paramtoamr);
-      }
-      /*                                                                      */
-      parcours_nom = parcours_nom -> suiv;
-   }
-
-}
-
-
+            /* Close the file Alloc_agrif                                        */
+            fclose(allocationagrif);
+            fclose(paramtoamr);
+        }
+        parcours_nom = parcours_nom -> suiv;
+    }
+}
 
 void write_allocation_Global_0()
 {
-   listnom *parcours_nom;
-   listvar *parcours;
-   listvar *parcoursprec;
-   listvar *parcours1;
-   FILE *allocationagrif;
-   char ligne[LONGNOM];
-   variable *v;
-   int IndiceMax;
-   int IndiceMin;
-   int compteur;
-   int out;
-   int indiceprec;
-   int ValeurMax;
-   char initialvalue[LONG_4C];
-   int typeiswritten ;
-
-   parcoursprec = (listvar *)NULL;
-   parcours_nom = List_NameOfModule;
-   ValeurMax = 2;
-   while ( parcours_nom  )
-   {
-      /*                                                                      */
-      if ( parcours_nom->o_val == 1 )
-      {
-         IndiceMax = 0;
-         IndiceMin = indicemaxtabvars;
-         /* Open the file to create the Alloc_agrif subroutine                */
-         sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
-         allocationagrif = associate (ligne);
-         /*                                                                   */
-         if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
-         {
-             /* add the call to initworkspace                                 */
-            tofich(allocationagrif,"if ( .NOT. Agrif_Root() ) then ",1);
-            fprintf(allocationagrif,"#include \"GetNumberofcells.h\" \n");
-            tofich(allocationagrif,"else ",1);
-            fprintf(allocationagrif,"#include \"SetNumberofcells.h\" \n");
-            tofich(allocationagrif,"endif ",1);
-            tofich(allocationagrif,"Call Agrif_InitWorkspace ",1);
-         }
-
-         typeiswritten = 0;
-
-         parcours = List_Global_Var;
-         while ( parcours )
-         {
-            if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) &&
-                 parcours->var->v_VariableIsParameter == 0                  &&
-                 parcours->var->v_notgrid == 0                              &&
-                 !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom)  )
+    listnom *parcours_nom;
+    listvar *parcours;
+    listvar *parcoursprec;
+    listvar *parcours1;
+    FILE *allocationagrif;
+    char ligne[LONG_M];
+    char ligne2[LONG_M];
+    variable *v;
+    int IndiceMax;
+    int IndiceMin;
+    int compteur;
+    int out;
+    int indiceprec;
+    int ValeurMax;
+    char initialvalue[LONG_M];
+    int typeiswritten ;
+
+    parcoursprec = (listvar *) NULL;
+    parcours_nom = List_NameOfModule;
+    ValeurMax = 2;
+
+    while ( parcours_nom  )
+    {
+        if ( parcours_nom->o_val == 1 )
+        {
+            IndiceMax = 0;
+            IndiceMin = indicemaxtabvars[0];
+            /* Open the file to create the Alloc_agrif subroutine                */
+            sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
+            allocationagrif = open_for_write(ligne);
+
+//             if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
+//             {
+//                 /* add the call to initworkspace         */
+//                 tofich(allocationagrif,"if (.not. Agrif_Root() ) then",1);
+//                 tofich(allocationagrif,"#include \"GetNumberofcells.h\"\n",0);
+//                 tofich(allocationagrif,"else",1);
+//                 tofich(allocationagrif,"#include \"SetNumberofcells.h\"\n",0);
+//                 tofich(allocationagrif,"endif",1);
+//                 tofich(allocationagrif,"call Agrif_InitWorkspace",1);
+//             }
+
+            typeiswritten = 0;
+            parcours = List_Global_Var;
+            while ( parcours )
             {
-               /***************************************************************/
-               /***************************************************************/
-               /***************************************************************/
-               v = parcours->var;
-               IndiceMax = 0;
-               IndiceMin = indicemaxtabvars;
-  /* body of the file                                                         */
-  if ( !strcasecmp(v->v_commoninfile,mainfile) )
-  {
-     if (onlyfixedgrids != 1 && v->v_nbdim!=0)
-     {
-        strcpy (ligne, "If (.not. associated(");
-        strcat (ligne, vargridnametabvars(v,0));
-        strcat (ligne, "))                       then");
-        Save_Length(ligne,48);
-        tofich (allocationagrif, ligne,1);
-     }
-     if ( v->v_allocatable != 1 && ( v->v_dimsempty != 1) )
-     {
-        /*                ALLOCATION                                          */
-        if ( v->v_dimension != 0  )
-        {
-           if ( v->v_indicetabvars < IndiceMin ||
-                v->v_indicetabvars > IndiceMax )
-           {
-              parcours1 = parcours;
-              compteur = -1;
-              out = 0;
-              indiceprec = parcours->var->v_indicetabvars -1 ;
-              while ( parcours1 && out == 0 &&
-                      !strcasecmp(  parcours->var->v_readedlistdimension,
-                                  parcours1->var->v_readedlistdimension) &&
-                      !strcasecmp(  parcours->var->v_typevar,
-                                  parcours1->var->v_typevar) &&
-                             ( parcours1->var->v_indicetabvars == indiceprec+1 )
-                     )
-              {
-
-               if ( !strcasecmp(parcours1->var->v_modulename,
-                                parcours_nom->o_nom) ||
-                    !strcasecmp(parcours1->var->v_commonname,
-                                parcours_nom->o_nom) )
-                 {
-                      compteur = compteur +1 ;
-                      indiceprec = parcours1->var->v_indicetabvars;
-                      parcoursprec = parcours1;
-                      parcours1 = parcours1->suiv;
-                 }
-                 else out = 1;
-              }
-              if ( compteur > ValeurMax )
-              {
-                 fprintf(allocationagrif,"      DO i = %d , %d\n",
-                                          parcours->var->v_indicetabvars,
-                                       parcours->var->v_indicetabvars+compteur);
-                 IndiceMin = parcours->var->v_indicetabvars;
-                 IndiceMax = parcours->var->v_indicetabvars+compteur;
-                 strcpy (ligne, "allocate ");
-                 strcat (ligne, "(");
-                 strcat (ligne, vargridnametabvars(v,1));
-                 strcat (ligne, vargridparam(v,0));
-                 strcat (ligne, ")");
-                 Save_Length(ligne,48);
-                 tofich (allocationagrif, ligne,1);
-                 fprintf(allocationagrif,"      end do\n");
-                 parcours = parcoursprec;
-              }
-              else
-              {
-                 strcpy (ligne, "allocate ");
-                 strcat (ligne, "(");
-                 strcat (ligne, vargridnametabvars(v,0));
-                 strcat (ligne, vargridparam(v,0));
-                 strcat (ligne, ")");
-                 Save_Length(ligne,48);
-                 tofich (allocationagrif, ligne,1);
-              }
-           }
-        } /* end of the allocation part                                       */
-
-        /*                INITIALISATION                                      */
-        if ( strcasecmp(v->v_initialvalue,"") )
-        {
-           strcpy (ligne, "");
-           strcat (ligne, vargridnametabvars(v,0));
-           /* We should modify the initialvalue in the case of variable has   */
-           /*    been defined with others variables                           */
-
-           strcpy(initialvalue,
-                  ChangeTheInitalvaluebyTabvarsName
-                                      (v->v_initialvalue,List_Global_Var,0));
-           if ( !strcasecmp(initialvalue,v->v_initialvalue) )
-           {
-              strcpy(initialvalue,"");
-              strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
-                                      (v->v_initialvalue,List_Common_Var,0));
-           }
-           if ( !strcasecmp(initialvalue,v->v_initialvalue) )
-           {
-              strcpy(initialvalue,"");
-              strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
-                                     (v->v_initialvalue,List_ModuleUsed_Var,0));
-           }
-           strcat (ligne," = ");
-           strcat (ligne,initialvalue);
-           /*                                                                 */
-           Save_Length(ligne,48);
-           tofich (allocationagrif, ligne,1);
-        }
-     }
-/* Case of structure types */
-        if ((typeiswritten == 0) && !strcasecmp(v->v_typevar,"type"))
-        {
-        sprintf(ligne,"If (.Not.Allocated(Agrif_%s_var)) Then",v->v_modulename);
-        tofich(allocationagrif, ligne, 1);
-        sprintf(ligne,"Allocate(Agrif_%s_var(0:Agrif_NbMaxGrids))",v->v_modulename);
-        tofich(allocationagrif, ligne, 1);
-        strcpy(ligne,"End If");
-        tofich(allocationagrif, ligne, 1);
-        typeiswritten = 1;
-        }
-     if (onlyfixedgrids != 1 && v->v_nbdim!=0)
-     {
-        strcpy (ligne, "   End if");
-        tofich (allocationagrif, ligne,1);
-     }
-  }
-               /***************************************************************/
-               /***************************************************************/
-               /***************************************************************/
+                if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) &&
+                       parcours->var->v_VariableIsParameter == 0                  &&
+                       parcours->var->v_notgrid == 0  )
+                {
+                    v = parcours->var;
+                    IndiceMax = 0;
+                    IndiceMin = indicemaxtabvars[v->v_catvar];
+                    /* body of the file */
+                    if ( !strcasecmp(v->v_commoninfile,cur_filename) )
+                    {
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0));
+                            tofich(allocationagrif,ligne,1);
+                        }
+                        if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) )
+                        {
+                            /*                ALLOCATION                                          */
+                            if ( v->v_dimension != 0 )
+                            {
+                                if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax )
+                                {
+                                    parcours1 = parcours;
+                                    compteur = -1;
+                                    out = 0;
+                                    indiceprec = parcours->var->v_indicetabvars -1 ;
+                                    while ( parcours1 && out == 0
+                                        && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension)
+                                        && !strcasecmp(parcours->var->v_typevar,            parcours1->var->v_typevar)
+                                        && (parcours1->var->v_indicetabvars == indiceprec+1) )
+                                    {
+                                        if ( !strcasecmp(parcours1->var->v_modulename, parcours_nom->o_nom) ||
+                                             !strcasecmp(parcours1->var->v_commonname, parcours_nom->o_nom) )
+                                        {
+                                            compteur = compteur +1 ;
+                                            indiceprec = parcours1->var->v_indicetabvars;
+                                            parcoursprec = parcours1;
+                                            parcours1 = parcours1->suiv;
+                                        }
+                                        else out = 1;
+                                    }
+                                    sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar);
+                                    tofich(allocationagrif,ligne,1);
+                                    if ( compteur > ValeurMax )
+                                    {
+                                        sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars,
+                                                                      parcours->var->v_indicetabvars+compteur);
+                                        tofich(allocationagrif,ligne,1);
+                                        IndiceMin = parcours->var->v_indicetabvars;
+                                        IndiceMax = parcours->var->v_indicetabvars+compteur;
+                                        sprintf(ligne,"    allocate(%s", vargridnametabvars(v,1));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                        tofich(allocationagrif,"enddo",1);
+                                        parcours = parcoursprec;
+                                    }
+                                    else
+                                    {
+                                        sprintf(ligne,"allocate(%s", vargridnametabvars(v,0));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                    }
+                                }
+                            } /* end of the allocation part                                       */
+                            /*                INITIALISATION                                      */
+                            if ( strcasecmp(v->v_initialvalue,"") )
+                            {
+                                strcpy(ligne, vargridnametabvars(v,0));
+                                /* We should modify the initialvalue in the case of variable has been defined with others variables */
+                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var));
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var));
+                                }
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var));
+                                }
+                                strcat (ligne," = ");
+                                strcat (ligne,initialvalue);
+                                Save_Length(ligne,48);
+                                tofich(allocationagrif,ligne,1);
+                            }
+                        }
+                        /* Case of structure types */
+                        if ( (typeiswritten == 0) && !strcasecmp(v->v_typevar,"type") )
+                        {
+                            sprintf(ligne,"if (.not. allocated(Agrif_%s_var)) then",v->v_modulename);
+                            tofich(allocationagrif, ligne, 1);
+                            sprintf(ligne,"    allocate(Agrif_%s_var(0:Agrif_NbMaxGrids))",v->v_modulename);
+                            tofich(allocationagrif, ligne, 1);
+                            tofich(allocationagrif, "endif", 1);
+                            typeiswritten = 1;
+                        }
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            tofich(allocationagrif,"endif",1);
+                        }
+                    }
+                }
+                parcours = parcours -> suiv;
             }
-            parcours = parcours -> suiv;
-         }
-         /*                                                                   */
-         if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
-         {
-            /* add the call to initworkspace                                  */
-            tofich(allocationagrif,"if ( .NOT. Agrif_Root() ) then ",1);
-            fprintf(allocationagrif,"#include \"GetNumberofcells.h\" \n");
-            tofich(allocationagrif,"else ",1);
-            fprintf(allocationagrif,"#include \"SetNumberofcells.h\" \n");
-            tofich(allocationagrif,"endif ",1);
-            tofich(allocationagrif,"Call Agrif_InitWorkspace ",1);
-         }
-         /* Close the file Alloc_agrif                                        */
-         fclose(allocationagrif);
-      } /* end parcours_nom == 1                                              */
-      /*                                                                      */
-      parcours_nom = parcours_nom -> suiv;
-   }
+            if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
+            {
+                fprintf(allocationagrif, "      if ( .not.Agrif_Root() ) then\n");
+                fprintf(allocationagrif, "#include \"GetNumberofcells.h\"\n");
+                fprintf(allocationagrif, "      else\n");
+                fprintf(allocationagrif, "#include \"SetNumberofcells.h\"\n");
+                fprintf(allocationagrif, "      endif\n");
+                fprintf(allocationagrif, "      call Agrif_InitWorkspace\n");
+            }
+            fclose(allocationagrif);
+        }
+        parcours_nom = parcours_nom -> suiv;
+    }
 }
 
@@ -1082,33 +870,30 @@
 /*                                                                            */
 /******************************************************************************/
-void creefichieramr (char *NameTampon)
-{
-  listvar *newvar;
-  variable *v;
-  int erreur;
-  char filefich[LONG_C];
-  char ligne[LONG_C];
-  int IndiceMax;
-  int IndiceMin;
-  int InitEmpty;
-  int VarnameEmpty;
-  int donotwrite;
-
-  FILE *initproc;
-  FILE *initglobal;
-  FILE *createvarname;
-  FILE *createvarnameglobal;
-
-  if ( todebug == 1 ) printf("Enter in creefichieramr\n");
-  strcpy (filefich, "cd ");
-  strcat (filefich, nomdir);
-  erreur = system (filefich);
-  if (erreur)
-  {
-     strcpy (filefich, "mkdir ");
-     strcat (filefich, nomdir);
-     system (filefich);
-     printf ("%s: Directory created\n", nomdir);
-  }
+void creefichieramr ()
+{
+    listvar *newvar;
+    variable *v;
+    int erreur;
+    char filefich[LONG_M];
+
+    int InitEmpty;
+    int VarnameEmpty;
+    int donotwrite;
+
+    FILE *initproc;
+    FILE *initglobal;
+    FILE *createvarname;
+    FILE *createvarnameglobal;
+
+    if ( todebug == 1 ) printf("Enter in creefichieramr\n");
+
+    sprintf(filefich, "cd %s", include_dir);
+    erreur = system (filefich);
+    if (erreur)
+    {
+        sprintf(filefich, "mkdir -p %s", include_dir);
+        system(filefich);
+        printf("%s: Directory created\n", include_dir);
+    }
 
 /******************************************************************************/
@@ -1116,89 +901,62 @@
 /******************************************************************************/
 
-/*----------------------------------------------------------------------------*/
-  if ( todebug == 1 )
-  {
-     strcpy(ligne,"initialisations_agrif_");
-     strcat(ligne,NameTampon);
-     strcat(ligne,".h");
-     initproc = associate (ligne);
-/*----------------------------------------------------------------------------*/
-     strcpy(ligne,"createvarname_agrif_");
-     strcat(ligne,NameTampon);
-     strcat(ligne,".h");
-     createvarname = associate (ligne);
-/*----------------------------------------------------------------------------*/
-     InitEmpty = 1 ;
-     VarnameEmpty = 1 ;
-
-     newvar = List_Global_Var;
-     while ( newvar && todebug == 1 )
-     {
-        donotwrite = 0;
-        v = newvar->var;
-
-        if ( ( v->v_common == 1 || v->v_module == 1 ) && donotwrite == 0 )
-        {
-          write_createvarnameagrif_file(v,createvarname,&VarnameEmpty);
-          write_initialisationsagrif_file(v,initproc,&InitEmpty);
-        }
-        newvar = newvar->suiv;
-     }
-  /*                                                                          */
-     fclose (createvarname);
-     fclose (initproc);
-  /*--------------------------------------------------------------------------*/
-     if ( Did_filetoparse_readed(curmodulename) == 0 )
-     {
-        if ( InitEmpty != 1  )
-        {
-           initglobal = associateaplus("initialisations_agrif.h");
-           strcpy(ligne,"#include \"initialisations_agrif_");
-           strcat(ligne,NameTampon);
-           strcat(ligne,".h\"\n");
-           fprintf(initglobal,ligne);
-           fclose(initglobal);
-        }
-  /*--------------------------------------------------------------------------*/
-        if ( VarnameEmpty != 1 )
-        {
-           createvarnameglobal= associateaplus("createvarname_agrif.h");
-           strcpy(ligne,"#include \"createvarname_agrif_");
-           strcat(ligne,NameTampon);
-           strcat(ligne,".h\"\n");
-           fprintf(createvarnameglobal,ligne);
-           fclose(createvarnameglobal);
-        }
-     }
-  }
-/*----------------------------------------------------------------------------*/
-/*----------------------------------------------------------------------------*/
-/*----------------------------------------------------------------------------*/
-/*----------------------------------------------------------------------------*/
-/*----------------------------------------------------------------------------*/
-  IndiceMax = 0;
-  IndiceMin = 0;
-
-  write_allocation_Common_0();
-  write_allocation_Global_0();
-
-  Write_Alloc_Agrif_Files();
-  write_probdimagrif_file();
-  write_keysagrif_file();
-  write_modtypeagrif_file();
-  if ( NbMailleXDefined == 1 )
-                             write_Setnumberofcells_file("SetNumberofcells.h");
-  if ( NbMailleXDefined == 1 )
-                             write_Getnumberofcells_file("GetNumberofcells.h");
-  retour77 = 0;
-  if ( NbMailleXDefined == 1 )
-                          write_Setnumberofcells_file("SetNumberofcellsFree.h");
-  if ( NbMailleXDefined == 1 )
-                          write_Getnumberofcells_file("GetNumberofcellsFree.h");
-  retour77 = 1;
-  if ( NbMailleXDefined == 1 )
-                         write_Setnumberofcells_file("SetNumberofcellsFixed.h");
-  if ( NbMailleXDefined == 1 )
-                         write_Getnumberofcells_file("GetNumberofcellsFixed.h");
-  if ( todebug == 1 ) printf("Out of creefichieramr\n");
-}
+    if ( todebug == 1 )
+    {
+        const char *NameTampon = "toto";
+        sprintf(filefich,"initialisations_agrif_%s.h", NameTampon);
+        initproc = open_for_write(filefich);
+
+        sprintf(filefich,"createvarname_agrif_%s.h", NameTampon);
+        createvarname = open_for_write(filefich);
+
+        InitEmpty = 1 ;
+        VarnameEmpty = 1 ;
+
+        newvar = List_Global_Var;
+        while ( newvar )
+        {
+            donotwrite = 0;
+            v = newvar->var;
+
+            if ( ( v->v_common == 1 || v->v_module == 1 ) && donotwrite == 0 )
+            {
+                write_createvarnameagrif_file(v,createvarname,&VarnameEmpty);
+                write_initialisationsagrif_file(v,initproc,&InitEmpty);
+            }
+            newvar = newvar->suiv;
+        }
+        fclose (createvarname);
+        fclose (initproc);
+
+        if ( is_dependfile_created(curmodulename) == 0 )
+        {
+            if ( InitEmpty != 1  )
+            {
+                initglobal = open_for_append("initialisations_agrif.h");
+                fprintf(initglobal,"#include \"initialisations_agrif_%s.h\"\n", NameTampon);
+                fclose(initglobal);
+            }
+            if ( VarnameEmpty != 1 )
+            {
+                createvarnameglobal= open_for_append("createvarname_agrif.h");
+                fprintf(createvarnameglobal,"#include \"createvarname_agrif_%s.h\"\n", NameTampon);
+                fclose(createvarnameglobal);
+            }
+        }
+    }
+    write_allocation_Common_0();
+    write_allocation_Global_0();
+
+    Write_Alloc_Agrif_Files();
+    write_probdimagrif_file();
+    write_keysagrif_file();
+    write_modtypeagrif_file();
+
+    if ( NbMailleXDefined == 1 )
+    {
+        write_Setnumberofcells_file();
+        write_Getnumberofcells_file();
+    }
+
+    if ( todebug == 1 ) printf("Out of creefichieramr\n");
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90	(revision 6808)
@@ -83,5 +83,5 @@
       CALL ice_run_2                   ! read in namelist some run parameters
       !          
-      rdt_ice = nn_fsbc * rdttra(1)    ! sea-ice time step
+      rdt_ice = nn_fsbc * rdt           ! sea-ice time step
       numit   = nit000 - 1
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90	(revision 6808)
@@ -71,8 +71,6 @@
          CALL fld_read( kt, nn_fsbc, sf_icedmp )
          !
-!CDIR COLLAPSE
          hicif(:,:) = MAX( 0._wp,                     &        ! h >= 0         avoid spurious out of physical range
             &         hicif(:,:) - rdt_ice * resto_ice(:,:,1) * ( hicif(:,:) - sf_icedmp(jp_hicif)%fnow(:,:,1) )  ) 
-!CDIR COLLAPSE
          frld (:,:) = MAX( 0._wp, MIN( 1._wp,         &        ! 0<= frld<=1    values which blow the run up
             &         frld (:,:) - rdt_ice * resto_ice(:,:,1) * ( frld (:,:) - sf_icedmp(jp_frld )%fnow(:,:,1) )  )  )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90	(revision 6808)
@@ -160,7 +160,5 @@
       !-------------------------------------------------------------------
 
-!CDIR NOVERRCHK
       DO jj = k_j1 , k_jpj-1
-!CDIR NOVERRCHK
          DO ji = 1 , jpi
             ! only the sinus changes its sign with the hemisphere
@@ -245,7 +243,5 @@
          ! Computation of free drift field for free slip boundary conditions.
 
-!CDIR NOVERRCHK
          DO jj = k_j1, k_jpj-1
-!CDIR NOVERRCHK
             DO ji = 1, fs_jpim1
                !- Rate of strain tensor.
@@ -401,7 +397,5 @@
 iflag:   DO jter = 1 , nbitdr                                   !    Relaxation    !
             !                                                   ! ================ !
-!CDIR NOVERRCHK
             DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
                DO ji = 2, fs_jpim1   ! NO vector opt.
                   !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90	(revision 6808)
@@ -71,6 +71,4 @@
                WRITE(numout,*)
                SELECT CASE ( jprstlib )
-               CASE ( jprstdimg )
-                  WRITE(numout,*) '             open ice restart binary file: ',TRIM(clpath)//clname
                CASE DEFAULT
                   WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname
@@ -192,11 +190,4 @@
       ENDIF
 
-      IF ( jprstlib == jprstdimg ) THEN
-        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
-        ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90
-        INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok )
-        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
-      ENDIF
-
       CALL iom_open ( TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in), numrir, kiolib = jlibalt )
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90	(revision 6808)
@@ -29,7 +29,8 @@
    USE sbc_ice          ! surface boundary condition: ice
    USE sbc_oce          ! surface boundary condition: ocean
-   USE sbccpl
+   USE sbccpl           ! surface boundary condition: coupled interface
    USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
    USE albedo           ! albedo parameters
+   !
    USE lbclnk           ! ocean lateral boundary condition - MPP exchanges
    USE lib_mpp          ! MPP library
@@ -43,7 +44,7 @@
    PRIVATE
 
-   PUBLIC   lim_sbc_init_2     ! called by ice_init_2
-   PUBLIC   lim_sbc_flx_2      ! called by sbc_ice_lim_2
-   PUBLIC   lim_sbc_tau_2      ! called by sbc_ice_lim_2
+   PUBLIC   lim_sbc_init_2   ! called by ice_init_2
+   PUBLIC   lim_sbc_flx_2    ! called by sbc_ice_lim_2
+   PUBLIC   lim_sbc_tau_2    ! called by sbc_ice_lim_2
 
    REAL(wp)  ::   r1_rdtice            ! = 1. / rdt_ice 
@@ -52,5 +53,5 @@
    REAL(wp)  ::   rone   = 1._wp       !     -      -
    !
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   soce_0, sice_0   ! constant SSS and ice salinity used in levitating sea-ice case
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   soce_0, sice_0       ! fix SSS and ice salinity used in levitating case 0
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress              [N/m2]
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmod_io              ! modulus of the ice-ocean relative velocity   [m/s]
@@ -58,5 +59,4 @@
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011)
@@ -102,5 +102,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt    ! number of iteration
-      !!
+      !
       INTEGER  ::   ji, jj   ! dummy loop indices
       INTEGER  ::   ii0, ii1, ij0, ij1         ! local integers
@@ -114,13 +114,13 @@
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp   ! 2D/3D workspace
       !!---------------------------------------------------------------------
-     
+      !
       CALL wrk_alloc( jpi, jpj, zqnsoce )
       CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp )
-
-      SELECT CASE( nn_ice_embd )                 ! levitating or embedded sea-ice option
-        CASE( 0    )   ;   zswitch = 1           ! (0) standard levitating sea-ice : salt exchange only
-        CASE( 1, 2 )   ;   zswitch = 0           ! (1) levitating sea-ice: salt and volume exchange but no pressure effect
-                                                 ! (2) embedded sea-ice : salt and volume fluxes and pressure
-      END SELECT                                 !    
+      !
+      SELECT CASE( nn_ice_embd )             ! levitating or embedded sea-ice option
+         CASE( 0    )   ;   zswitch = 1         ! (0) old levitating sea-ice : salt exchange only
+         CASE( 1, 2 )   ;   zswitch = 0         ! (1) levitating sea-ice: salt and volume exchange but no pressure effect
+         !                                      ! (2) embedded sea-ice : salt and volume fluxes and pressure
+      END SELECT
 
       !------------------------------------------!
@@ -303,5 +303,5 @@
       INTEGER ,                     INTENT(in) ::   kt               ! ocean time-step index
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pu_oce, pv_oce   ! surface ocean currents
-      !!
+      !
       INTEGER  ::   ji, jj   ! dummy loop indices
       REAL(wp) ::   zfrldu, zat_u, zu_i, zutau_ice, zu_t, zmodt   ! local scalar
@@ -319,7 +319,6 @@
          !
          IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==! (i.e. surface module time-step)
-!CDIR NOVERRCHK
+            !
             DO jj = 1, jpj                               !* modulus of ice-ocean relative velocity at I-point
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   zu_i  = u_ice(ji,jj) - u_oce(ji,jj)                   ! ice-ocean relative velocity at I-point
@@ -328,7 +327,5 @@
                END DO
             END DO
-!CDIR NOVERRCHK
             DO jj = 1, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
-!CDIR NOVERRCHK
                DO ji = 1, jpim1   ! NO vector opt.
                   !                                               ! modulus of U_ice-U_oce at T-point
@@ -383,7 +380,6 @@
          !
          IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==! (i.e. surface module time-step)
-!CDIR NOVERRCHK
+            !
             DO jj = 2, jpjm1                          !* modulus of the ice-ocean velocity at T-point
-!CDIR NOVERRCHK
                DO ji = fs_2, fs_jpim1
                   zu_t  = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   ! 2*(U_ice-U_oce) at T-point
@@ -439,6 +435,6 @@
       !! ** input   : Namelist namicedia
       !!-------------------------------------------------------------------
-      !
-      INTEGER :: jk           ! local integer
+      INTEGER ::   jk   ! local integer
+      !!-------------------------------------------------------------------
       !
       IF(lwp) WRITE(numout,*)
@@ -474,35 +470,37 @@
          sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
          sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
-         do jk = 1,jpkm1                     ! adjust initial vertical scale factors
-          fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
-          fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
-         end do
-         fse3t_a(:,:,:) = fse3t_b(:,:,:)
-         ! Reconstruction of all vertical scale factors at now and before time steps
-         ! =============================================================================
-         ! Horizontal scale factor interpolations
-         ! --------------------------------------
-         CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' )
-         CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' )
-         CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' )
-         CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' )
-         CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' )
-         ! Vertical scale factor interpolations
-         ! ------------------------------------
-         CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W'  )
-         CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' )
-         CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' )
-         CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' )
-         CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' )
-         ! t- and w- points depth
-         ! ----------------------
-         fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)
-         fsdepw_n(:,:,1) = 0.0_wp
-         fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:)
-         DO jk = 2, jpk
-            fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk)
-            fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1)
-            fsde3w_n(:,:,jk) = fsdept_n(:,:,jk  ) - sshn   (:,:)
-         END DO
+!!gm I really don't like this staff here...  Find a way to put that elsewhere or differently
+!!gm
+         IF( .NOT.ln_linssh ) THEN
+
+            do jk = 1,jpkm1                     ! adjust initial vertical scale factors
+               e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+               e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+            end do
+            e3t_a(:,:,:) = e3t_b(:,:,:)
+            ! Reconstruction of all vertical scale factors at now and before time steps
+            !        ! Horizontal scale factor interpolations
+            CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
+            CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
+            CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+            CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+            CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
+            !        ! Vertical scale factor interpolations
+            CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
+            CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
+            CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
+            CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
+            CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+            !        ! t- and w- points depth
+            gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+            gdepw_n(:,:,1) = 0.0_wp
+            gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+            DO jk = 2, jpk
+               gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk)
+               gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1)
+               gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:)
+            END DO
+         ENDIF
+!!gm end
       ENDIF
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90	(revision 6808)
@@ -18,18 +18,19 @@
    USE phycst           ! physical constants
    USE dom_oce          ! ocean space and time domain variables
-   USE domvvl
-   USE lbclnk
+   USE domvvl           ! ocean domain
+   USE ice_2            ! LIM sea-ice variables
+   USE sbc_oce          ! surface boundary condition: ocean
+   USE sbc_ice          ! surface boundary condition: sea-ice
+   USE thd_ice_2        ! LIM thermodynamic sea-ice variables
+   USE dom_ice_2        ! LIM sea-ice domain
+   USE limthd_zdf_2     !
+   USE limthd_lac_2     !
+   USE limtab_2         !
+   !
    USE in_out_manager   ! I/O manager
-   USE lib_mpp
+   USE lbclnk           !
+   USE lib_mpp          !
    USE wrk_nemo         ! work arrays
    USE iom              ! IOM library
-   USE ice_2            ! LIM sea-ice variables
-   USE sbc_oce          ! 
-   USE sbc_ice          ! 
-   USE thd_ice_2        ! LIM thermodynamic sea-ice variables
-   USE dom_ice_2        ! LIM sea-ice domain
-   USE limthd_zdf_2
-   USE limthd_lac_2
-   USE limtab_2
    USE prtctl           ! Print control
    USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
@@ -43,9 +44,8 @@
    REAL(wp) ::   epsi16 = 1.e-16   !
    REAL(wp) ::   epsi04 = 1.e-04   !
-   REAL(wp) ::   rzero  = 0.e0     !
-   REAL(wp) ::   rone   = 1.e0     !
+   REAL(wp) ::   rzero  = 0._wp    !
+   REAL(wp) ::   rone   = 1._wp    !
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!-------- -------------------------------------------------------------
@@ -75,5 +75,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt     ! number of iteration
-      !!
+      !
       INTEGER  ::   ji, jj               ! dummy loop indices
       INTEGER  ::   nbpb                 ! nb of icy pts for thermo. cal.
@@ -196,7 +196,5 @@
       !--------------------------------------------------------------------------
 
-      !CDIR NOVERRCHK
       DO jj = 1, jpj
-         !CDIR NOVERRCHK
          DO ji = 1, jpi
             zthsnice       = hsnif(ji,jj) + hicif(ji,jj)
@@ -235,5 +233,5 @@
             
             !  energy needed to bring ocean surface layer until its freezing
-            qcmif  (ji,jj) =  rau0 * rcp * fse3t_m(ji,jj) * ( tfu(ji,jj) - sst_m(ji,jj) - rt0 ) * ( 1 - zinda )
+            qcmif  (ji,jj) =  rau0 * rcp * e3t_m(ji,jj) * ( tfu(ji,jj) - sst_m(ji,jj) - rt0 ) * ( 1 - zinda )
             
             !  calculate oceanic heat flux.
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90	(revision 6808)
@@ -134,5 +134,4 @@
       !---------------------------------------------------------------------
       
-!CDIR NOVERRCHK
       DO ji = kideb , kiut
          iicefr       = 1 - MAX( 0, INT( SIGN( 1.5 * zone , zfrl_old(ji) - 1.0 + epsi13 ) ) )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90	(revision 6808)
@@ -85,10 +85,4 @@
 
 #if ! defined key_iomput
-# if defined key_dimgout
-   !!----------------------------------------------------------------------
-   !!   'key_dimgout'                                    Direct Access file
-   !!----------------------------------------------------------------------
-# include "limwri_dimg_2.h90"
-# else
    SUBROUTINE lim_wri_2( kt )
       !!-------------------------------------------------------------------
@@ -215,6 +209,4 @@
       !
    END SUBROUTINE lim_wri_2
-     
-#endif     
 
    SUBROUTINE lim_wri_init_2
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90	(revision 6807)
+++ 	(revision )
@@ -1,217 +1,0 @@
-    SUBROUTINE lim_wri_2(kt)
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-    !!-------------------------------------------------------------------
-    !!  This routine computes the average of some variables and write it
-    !!  on the ouput files.
-    !!  ATTENTION cette routine n'est valable que si le pas de temps est
-    !!  egale a une fraction entiere de 1 jours.
-    !!  Diff 1-D 3-D : suppress common also included in etat
-    !!                 suppress cmoymo 11-18
-    !!  modif : 03/06/98
-    !!-------------------------------------------------------------------
-    USE  diadimg                ! use of dia_wri_dimg
-
-    INTEGER, INTENT(in) ::   kt     ! number of iteration
-
-    INTEGER , SAVE ::   nmoyice   !: counter for averaging
-    INTEGER , SAVE ::   nwf       !: number of fields to write on disk
-    INTEGER, SAVE,DIMENSION (:), ALLOCATABLE  :: nsubindex   !: subindex to be saved
-    INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE :: rcmoy
-
-    INTEGER ::  ji, jj, jf, ii   ! dummy loop indices and array index
-    INTEGER :: iyear, iday, imon ! 
-    INTEGER :: ialloc
-    CHARACTER(LEN=80) :: clname, cltext, clmode
-    REAL(wp), DIMENSION(1) ::   zdept
-    REAL(wp) ::   zsto, zsec, zjulian,zout
-    REAL(wp) ::   zindh, zinda, zindb, ztmu
-    REAL(wp), POINTER, DIMENSION(:,:)     ::   zfield
-
-#if ! defined key_diainstant
-    LOGICAL, PARAMETER :: ll_dia_inst=.false.      ! local logical variable 
-#else
-    LOGICAL, PARAMETER :: ll_dia_inst=.true.
-#endif
-    !!-------------------------------------------------------------------
-    IF( .NOT. ALLOCATED(rcmoy) )THEN
-        ALLOCATE(rcmoy(jpi,jpj,jpnoumax),  STAT=ialloc )
-       !
-       IF( lk_mpp      )   CALL mpp_sum ( ialloc  )
-       IF( ialloc /= 0 )   CALL ctl_warn('lim_wri_2 (limwri_dimg_2.h90) : failed to allocate arrays')
-    ENDIF
-
-    CALL wrk_alloc( jpi, jpj, zfield )
-
-    IF ( kt == nit000 ) THEN 
-       !
-       CALL lim_wri_init_2 
-
-       nwf = 0 
-       ii  = 0
-
-       IF (lwp ) THEN
-          WRITE(numout,*) 'lim_wri_2 : Write ice outputs in dimg'
-          WRITE(numout,*) '~~~~~~~~'
-          WRITE(numout,*) '   According to namelist_ice, following fields saved:'
-          DO jf =1, noumef
-             IF (nc(jf) == 1 ) THEN
-                WRITE(numout,* ) '    -',titn(jf), nam(jf), uni(jf)
-             ENDIF
-          END DO
-       ENDIF
-
-       DO jf = 1, noumef
-          IF (nc(jf) == 1 ) nwf = nwf + 1
-       END DO
-
-       ALLOCATE( nsubindex (nwf) )
-
-       DO jf = 1, noumef
-          IF (nc(jf) == 1 ) THEN 
-             ii = ii +1 
-             nsubindex(ii) = jf
-          END IF
-       END DO
-
-       rcmoy(:,:,:) = 0.0_wp
-       zsto     = rdt_ice
-       zout     = nwrite * rdt_ice / nn_fsbc
-       zsec     = 0.
-       niter    = 0
-       zdept(1) = 0.
-       nmoyice  = 0
-
-    ENDIF
-
-#if ! defined key_diainstant 
-    !-- Compute mean values
-
-    zcmo(:,:, 1:jpnoumax ) = 0.e0 
-    DO jj = 2 , jpjm1
-       DO ji = 2 , jpim1
-          zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
-          zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
-          zindb  = zindh * zinda
-          zcmo(ji,jj,1)  = hsnif (ji,jj)
-          zcmo(ji,jj,2)  = hicif (ji,jj)
-          zcmo(ji,jj,3)  = hicifp(ji,jj)
-          zcmo(ji,jj,4)  = frld  (ji,jj)
-          zcmo(ji,jj,5)  = sist  (ji,jj)
-          zcmo(ji,jj,6)  = fbif  (ji,jj)
-          IF (lk_lim2_vp) THEN
-            ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
-            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
-             &                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
-               / ztmu 
-
-            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
-             &                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
-               / ztmu
-           ELSE
-            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) )/ 2.0
-            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) )/ 2.0
-           ENDIF
-
-          zcmo(ji,jj,9)  = sst_m(ji,jj)
-          zcmo(ji,jj,10) = sss_m(ji,jj)
-
-          zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
-          zcmo(ji,jj,12) = qsr(ji,jj)
-          zcmo(ji,jj,13) = qns(ji,jj)
-          ! See thersf for the coefficient
-          zcmo(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
-          zcmo(ji,jj,15) = utau_ice(ji,jj)
-          zcmo(ji,jj,16) = vtau_ice(ji,jj)
-          zcmo(ji,jj,17) = qsr_ice(ji,jj,1)
-          zcmo(ji,jj,18) = qns_ice(ji,jj,1)
-          zcmo(ji,jj,19) = sprecip(ji,jj)
-       END DO
-    END DO
-    ! Cumulates values between outputs           
-    rcmoy(:,:,:)= rcmoy(:,:,:) + zcmo(:,:,:)
-    nmoyice = nmoyice + 1 
-    ! compute mean value if it is time to write on file
-    IF ( MOD(kt+nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN
-       rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice)
-#else  
-       IF ( MOD(kt-nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN 
-          !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0
-          DO jj = 2 , jpjm1
-             DO ji = 2 , jpim1
-                zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
-                zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
-                zindb  = zindh * zinda
-                rcmoy(ji,jj,1)  = hsnif (ji,jj)
-                rcmoy(ji,jj,2)  = hicif (ji,jj)
-                rcmoy(ji,jj,3)  = hicifp(ji,jj)
-                rcmoy(ji,jj,4)  = frld  (ji,jj)
-                rcmoy(ji,jj,5)  = sist  (ji,jj)
-                rcmoy(ji,jj,6)  = fbif  (ji,jj)
-                IF (lk_lim2_vp) THEN
-                   ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )
-                   rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
-                      &                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
-                        / ztmu
-
-                   rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
-                      &                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
-                       / ztmu
-                ELSE
-                   rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) )/ 2.0
-                   rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) )/ 2.0
-                ENDIF
-                rcmoy(ji,jj,9)  = sst_m(ji,jj)
-                rcmoy(ji,jj,10) = sss_m(ji,jj)
-
-                rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
-                rcmoy(ji,jj,12) = qsr(ji,jj)
-                rcmoy(ji,jj,13) = qns(ji,jj)
-                ! See thersf for the coefficient
-                rcmoy(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
-                rcmoy(ji,jj,15) = utau_ice(ji,jj)
-                rcmoy(ji,jj,16) = vtau_ice(ji,jj)
-                rcmoy(ji,jj,17) = qsr_ice(ji,jj,1)
-                rcmoy(ji,jj,18) = qns_ice(ji,jj,1)
-                rcmoy(ji,jj,19) = sprecip(ji,jj)
-             END DO
-          END DO
-#endif
-
-          !
-          niter = niter + 1
-          DO jf = 1 , noumef
-             zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1)
-
-             SELECT CASE (jf) 
-             CASE ( 7, 8, 15, 16 ) ! velocity or stress fields (vectors)
-                CALL lbc_lnk( zfield, 'T', -1. )
-             CASE DEFAULT          ! scalar fields
-                CALL lbc_lnk( zfield, 'T',  1. )
-             END SELECT
-             rcmoy(:,:,jf) = zfield(:,:)
-          END DO
-
-          IF (ll_dia_inst) THEN
-           clmode='instantaneous'
-          ELSE
-           WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average'
-          END IF
-          iyear = ndastp/10000
-          imon = (ndastp-iyear*10000)/100
-          iday = ndastp - imon*100 - iyear*10000
-          WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday
-          cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode)
-          CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex)
-9000      FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
-
-          rcmoy(:,:,:) = 0.0
-          nmoyice = 0 
-       END IF     !  MOD(kt+nn_fsbc-1-nit000+1, nwrite == 0 ) !
-       CALL wrk_dealloc( jpi,jpj, zfield )
-
-     END SUBROUTINE lim_wri_2
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90	(revision 6808)
@@ -97,5 +97,5 @@
 
       !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                     
-      psm (:,:)  = MAX( pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
+      psm (:,:)  = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
 
       !  Calculate fluxes and moments between boxes i<-->i+1              
@@ -282,5 +282,5 @@
 
       !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
-      psm(:,:)  = MAX(  pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  )
+      psm(:,:)  = MAX(  pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  )
 
       !  Calculate fluxes and moments between boxes j<-->j+1              
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 6808)
@@ -185,23 +185,23 @@
          zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
             &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &
-            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv )
+            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv )
 
          ! water flux
          zfw_b  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  &
             &                  wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    &
-            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv )
+            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv )
 
          ! heat flux
          zft_b  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
             &                - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
-            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv )
-
-         zvi_b  = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e12t * tmask(:,:,1) * zconv )
-
-         zsmv_b = glob_sum( SUM( smv_i * rhoic            , dim=3 ) * e12t * tmask(:,:,1) * zconv )
+            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv )
+
+         zvi_b  = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t * tmask(:,:,1) * zconv )
+
+         zsmv_b = glob_sum( SUM( smv_i * rhoic            , dim=3 ) * e1e2t * tmask(:,:,1) * zconv )
 
          zei_b  = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  &
             &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    &
-                            ) * e12t * tmask(:,:,1) * zconv )
+                            ) * e1e2t * tmask(:,:,1) * zconv )
 
       ELSEIF( icount == 1 ) THEN
@@ -210,30 +210,30 @@
          zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
             &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
-            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfs_b
+            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfs_b
 
          ! water flux
          zfw  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  &
             &                wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    &
-            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfw_b
+            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfw_b
 
          ! heat flux
          zft  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
             &              - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
-            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zft_b
+            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zft_b
  
          ! outputs
          zvi  = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 )  &
-            &                    * e12t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday
+            &                    * e1e2t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday
 
          zsmv = ( ( glob_sum( SUM( smv_i * rhoic            , dim=3 )  &
-            &                    * e12t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday
+            &                    * e1e2t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday
 
          zei  =   glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  &
             &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    &
-            &                ) * e12t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft
+            &                ) * e1e2t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft
 
          ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative
-         zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e12t * tmask(:,:,1) * zconv ) * rday 
-         zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e12t * tmask(:,:,1) * zconv )
+         zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e1e2t * tmask(:,:,1) * zconv ) * rday 
+         zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e1e2t * tmask(:,:,1) * zconv )
 
          zvmin = glob_min( v_i )
@@ -242,5 +242,5 @@
 
          ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 
-         zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2
+         zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2
          zv_sill = zarea * 2.5e-5
          zs_sill = zarea * 25.e-5
@@ -286,12 +286,12 @@
 #if ! defined key_bdy
       ! heat flux
-      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e12t * tmask(:,:,1) * zconv ) 
+      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e1e2t * tmask(:,:,1) * zconv ) 
       ! salt flux
-      zsfx  = glob_sum( ( sfx + diag_smvi ) * e12t * tmask(:,:,1) * zconv ) * rday
+      zsfx  = glob_sum( ( sfx + diag_smvi ) * e1e2t * tmask(:,:,1) * zconv ) * rday
       ! water flux
-      zvfx  = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e12t * tmask(:,:,1) * zconv ) * rday
+      zvfx  = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t * tmask(:,:,1) * zconv ) * rday
 
       ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 
-      zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2
+      zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2
       zv_sill = zarea * 2.5e-5
       zs_sill = zarea * 25.e-5
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90	(revision 6808)
@@ -306,5 +306,5 @@
                WRITE(numout,*) ' - Cell values '
                WRITE(numout,*) '   ~~~~~~~~~~~ '
-               WRITE(numout,*) ' cell area     : ', e12t(ji,jj)
+               WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj)
                WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
                WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
@@ -350,5 +350,5 @@
                WRITE(numout,*) ' - Cell values '
                WRITE(numout,*) '   ~~~~~~~~~~~ '
-               WRITE(numout,*) ' cell area     : ', e12t(ji,jj)
+               WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj)
                WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
                WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90	(revision 6808)
@@ -71,72 +71,72 @@
 
       ! 1/area
-      z1_area = 1._wp / MAX( glob_sum( e12t(:,:) * tmask(:,:,1) ), epsi06 )
-
-      rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e12t(:,:) * tmask(:,:,1) ) - epsi06 ) )
+      z1_area = 1._wp / MAX( glob_sum( e1e2t(:,:) * tmask(:,:,1) ), epsi06 )
+
+      rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e1e2t(:,:) * tmask(:,:,1) ) - epsi06 ) )
       ! ----------------------- !
       ! 1 -  Content variations !
       ! ----------------------- !
-      zbg_ivo = glob_sum( vt_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume ice 
-      zbg_svo = glob_sum( vt_s(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume snow
-      zbg_are = glob_sum( at_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! area
-      zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) )       ! mean salt content
-      zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e12t(:,:) * tmask(:,:,1) )  ! mean temp content
-
-      !zbg_ihc = glob_sum( et_i(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content
-      !zbg_shc = glob_sum( et_s(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content
+      zbg_ivo = glob_sum( vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume ice 
+      zbg_svo = glob_sum( vt_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume snow
+      zbg_are = glob_sum( at_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! area
+      zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e1e2t(:,:) * tmask(:,:,1) )       ! mean salt content
+      zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) )  ! mean temp content
+
+      !zbg_ihc = glob_sum( et_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content
+      !zbg_shc = glob_sum( et_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content
 
       ! Volume
       ztmp = rswitch * z1_area * r1_rau0 * rday
-      zbg_vfx     = ztmp * glob_sum(     emp(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_vfx     = ztmp * glob_sum(     emp(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) )
 
       ! Salt
-      zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) )
-
-      zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) )
-      zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+
+      zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) )
+      zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) )
 
       ! Heat budget
-      zbg_ihc      = glob_sum( et_i(:,:) * e12t(:,:) * 1.e-20 ) ! ice heat content  [1.e20 J]
-      zbg_shc      = glob_sum( et_s(:,:) * e12t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J]
-      zbg_hfx_dhc  = glob_sum( diag_heat(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
-      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
-
-      zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
-      zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
-      zbg_hfx_res  = glob_sum( hfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
-      zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
-      zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
-      zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
-      zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
-      zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
-      zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
-      zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
-      zbg_hfx_out  = glob_sum( hfx_out(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
-      zbg_hfx_in   = glob_sum(  hfx_in(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_ihc      = glob_sum( et_i(:,:) * e1e2t(:,:) ) * 1.e-20  ! ice heat content  [1.e20 J]
+      zbg_shc      = glob_sum( et_s(:,:) * e1e2t(:,:) ) * 1.e-20  ! snow heat content [1.e20 J]
+      zbg_hfx_dhc  = glob_sum( diag_heat(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+
+      zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_res  = glob_sum( hfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_out  = glob_sum( hfx_out(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_in   = glob_sum(  hfx_in(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W]
     
       ! --------------------------------------------- !
       ! 2 - Trends due to forcing and ice growth/melt !
       ! --------------------------------------------- !
-      z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes
-      z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * e12t(:,:) * tmask(:,:,1) ) ! salt fluxes
+      z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes
+      z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! salt fluxes
       z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + &
                           &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + &
-                          &     wfx_sub(:,:) ) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes
+                          &     wfx_sub(:,:) ) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes
       !
       frc_vol  = frc_vol  + z_frc_vol  * rdt_ice
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 6808)
@@ -191,5 +191,5 @@
          CALL prt_ctl(tab2d_1=delta_i   , clinfo1=' lim_dyn  : delta_i   :')
          CALL prt_ctl(tab2d_1=strength  , clinfo1=' lim_dyn  : strength  :')
-         CALL prt_ctl(tab2d_1=e12t      , clinfo1=' lim_dyn  : cell area :')
+         CALL prt_ctl(tab2d_1=e1e2t     , clinfo1=' lim_dyn  : cell area :')
          CALL prt_ctl(tab2d_1=at_i      , clinfo1=' lim_dyn  : at_i      :')
          CALL prt_ctl(tab2d_1=vt_i      , clinfo1=' lim_dyn  : vt_i      :')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 6808)
@@ -76,5 +76,5 @@
          DO jj = 2, jpjm1  
             DO ji = fs_2 , fs_jpim1   ! vector opt.
-               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e12t(ji,jj)
+               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e1e2t(ji,jj)
             END DO
          END DO
@@ -107,5 +107,5 @@
          DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes
             DO ji = fs_2 , fs_jpim1   ! vector opt. 
-               zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj)
+               zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj)
             END DO
          END DO
@@ -149,5 +149,5 @@
       DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes
          DO ji = fs_2 , fs_jpim1   ! vector opt. 
-            zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj)
+            zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj)
             ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) )
          END DO
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 6808)
@@ -28,4 +28,6 @@
    USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
    USE wrk_nemo         ! work arrays
+   USE fldread          ! read input fields
+   USE iom
 
    IMPLICIT NONE
@@ -47,5 +49,15 @@
    REAL(wp) ::   rn_tmi_ini_s   ! initial temperature
 
-   LOGICAL  ::  ln_iceini    ! initialization or not
+   INTEGER , PARAMETER ::   jpfldi = 6           ! maximum number of files to read
+   INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness (m)    at T-point
+   INTEGER , PARAMETER ::   jp_hts = 2           ! index of snow thicknes (m)    at T-point
+   INTEGER , PARAMETER ::   jp_ati = 3           ! index of ice fraction (%) at T-point
+   INTEGER , PARAMETER ::   jp_tsu = 4           ! index of ice surface temp (K)    at T-point
+   INTEGER , PARAMETER ::   jp_tmi = 5           ! index of ice temp at T-point
+   INTEGER , PARAMETER ::   jp_smi = 6           ! index of ice sali at T-point
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si    ! structure of input fields (file informations, fields read)
+
+   LOGICAL  ::  ln_iceini        ! initialization or not
+   LOGICAL  ::  ln_iceini_file   ! Ice initialization state from 2D netcdf file
    !!----------------------------------------------------------------------
    !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008)
@@ -88,15 +100,14 @@
       REAL(wp)   :: ztmelts, zdh
       INTEGER    :: i_hemis, i_fill, jl0  
-      REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv
-      REAL(wp), POINTER, DIMENSION(:)     :: zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini
-      REAL(wp), POINTER, DIMENSION(:,:)   :: zh_i_ini, za_i_ini, zv_i_ini
+      REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv 
       REAL(wp), POINTER, DIMENSION(:,:)   :: zswitch    ! ice indicator
-      INTEGER,  POINTER, DIMENSION(:,:)   :: zhemis   ! hemispheric index
-      !--------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi, jpj, zswitch )
-      CALL wrk_alloc( jpi, jpj, zhemis )
-      CALL wrk_alloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini )
-      CALL wrk_alloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zht_i_ini, zat_i_ini, zvt_i_ini            !data from namelist or nc file
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini, zv_i_ini               !data by cattegories to fill
+      !--------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini,  zv_i_ini )
+      CALL wrk_alloc( jpi, jpj,      zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
+      CALL wrk_alloc( jpi, jpj,      zswitch )
 
       IF(lwp) WRITE(numout,*)
@@ -120,263 +131,292 @@
       t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 
 
+
       IF( ln_iceini ) THEN
 
-      !--------------------------------------------------------------------
-      ! 2) Basal temperature, ice mask and hemispheric index
-      !--------------------------------------------------------------------
-
-      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest
-         DO ji = 1, jpi
-            IF( ( sst_m(ji,jj)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN 
-               zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice
-            ELSE                                                                                   
-               zswitch(ji,jj) = 1._wp * tmask(ji,jj,1)    !    ice
-            ENDIF
+         !--------------------------------------------------------------------
+         ! 2) Basal temperature, ice mask and hemispheric index
+         !--------------------------------------------------------------------
+
+         DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest
+            DO ji = 1, jpi
+               IF( ( sst_m(ji,jj)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN 
+                  zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice
+               ELSE                                                                                   
+                  zswitch(ji,jj) = 1._wp * tmask(ji,jj,1)    !    ice
+               ENDIF
+            END DO
          END DO
-      END DO
-
-
-      ! Hemispheric index
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( fcor(ji,jj) >= 0._wp ) THEN    
-               zhemis(ji,jj) = 1 ! Northern hemisphere
-            ELSE
-               zhemis(ji,jj) = 2 ! Southern hemisphere
-            ENDIF
-         END DO
-      END DO
-
-      !--------------------------------------------------------------------
-      ! 3) Initialization of sea ice state variables
-      !--------------------------------------------------------------------
-
-      !-----------------------------
-      ! 3.1) Hemisphere-dependent arrays
-      !-----------------------------
-      ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array
-      zht_i_ini(1) = rn_hti_ini_n ; zht_i_ini(2) = rn_hti_ini_s  ! ice thickness
-      zht_s_ini(1) = rn_hts_ini_n ; zht_s_ini(2) = rn_hts_ini_s  ! snow depth
-      zat_i_ini(1) = rn_ati_ini_n ; zat_i_ini(2) = rn_ati_ini_s  ! ice concentration
-      zsm_i_ini(1) = rn_smi_ini_n ; zsm_i_ini(2) = rn_smi_ini_s  ! bulk ice salinity
-      ztm_i_ini(1) = rn_tmi_ini_n ; ztm_i_ini(2) = rn_tmi_ini_s  ! temperature (ice and snow)
-
-      zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:)   ! ice volume
-
-      !---------------------------------------------------------------------
-      ! 3.2) Distribute ice concentration and thickness into the categories
-      !---------------------------------------------------------------------
-      ! a gaussian distribution for ice concentration is used
-      ! then we check whether the distribution fullfills
-      ! volume and area conservation, positivity and ice categories bounds
-      DO i_hemis = 1, 2
-
-      ztest_1 = 0 ; ztest_2 = 0 ; ztest_3 = 0 ; ztest_4 = 0
-
-      ! note for the great nemo engineers: 
-      ! only very few of the WRITE statements are necessary for the reference version
-      ! they were one day useful, but now i personally doubt of their
-      ! potential for bringing anything useful
-
-      DO i_fill = jpl, 1, -1
-         IF ( ( ztest_1 + ztest_2 + ztest_3 + ztest_4 ) .NE. 4 ) THEN
-            !----------------------------
-            ! fill the i_fill categories
-            !----------------------------
-            ! *** 1 category to fill
-            IF ( i_fill .EQ. 1 ) THEN
-               zh_i_ini(1,i_hemis)       = zht_i_ini(i_hemis)
-               za_i_ini(1,i_hemis)       = zat_i_ini(i_hemis)
-               zh_i_ini(2:jpl,i_hemis)   = 0._wp
-               za_i_ini(2:jpl,i_hemis)   = 0._wp
-            ELSE
-
-               ! *** >1 categores to fill
-               !--- Ice thicknesses in the i_fill - 1 first categories
-               DO jl = 1, i_fill - 1
-                  zh_i_ini(jl,i_hemis) = hi_mean(jl)
-               END DO
-               
-               !--- jl0: most likely index where cc will be maximum
-               DO jl = 1, jpl
-                  IF ( ( zht_i_ini(i_hemis) >  hi_max(jl-1) ) .AND. &
-                     & ( zht_i_ini(i_hemis) <= hi_max(jl)   ) ) THEN
-                     jl0 = jl
+
+         !--------------------------------------------------------------------
+         ! 3) Initialization of sea ice state variables
+         !--------------------------------------------------------------------
+         IF( ln_iceini_file )THEN
+
+            zht_i_ini(:,:)  = si(jp_hti)%fnow(:,:,1)
+            zht_s_ini(:,:)  = si(jp_hts)%fnow(:,:,1)
+            zat_i_ini(:,:)  = si(jp_ati)%fnow(:,:,1)
+            zts_u_ini(:,:)  = si(jp_tsu)%fnow(:,:,1)
+            ztm_i_ini(:,:)  = si(jp_tmi)%fnow(:,:,1)
+            zsm_i_ini(:,:)  = si(jp_smi)%fnow(:,:,1)
+
+         ELSE ! ln_iceini_file = F
+
+            !-----------------------------
+            ! 3.1) Hemisphere-dependent arrays
+            !-----------------------------
+            ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( fcor(ji,jj) >= 0._wp ) THEN
+                     zht_i_ini(ji,jj) = rn_hti_ini_n
+                     zht_s_ini(ji,jj) = rn_hts_ini_n
+                     zat_i_ini(ji,jj) = rn_ati_ini_n
+                     zts_u_ini(ji,jj) = rn_tmi_ini_n
+                     zsm_i_ini(ji,jj) = rn_smi_ini_n
+                     ztm_i_ini(ji,jj) = rn_tmi_ini_n
+                  ELSE
+                     zht_i_ini(ji,jj) = rn_hti_ini_s
+                     zht_s_ini(ji,jj) = rn_hts_ini_s
+                     zat_i_ini(ji,jj) = rn_ati_ini_s
+                     zts_u_ini(ji,jj) = rn_tmi_ini_s
+                     zsm_i_ini(ji,jj) = rn_smi_ini_s
+                     ztm_i_ini(ji,jj) = rn_tmi_ini_s
                   ENDIF
                END DO
-               jl0 = MIN(jl0, i_fill)
-               
-               !--- Concentrations
-               za_i_ini(jl0,i_hemis)      = zat_i_ini(i_hemis) / SQRT(REAL(jpl))
-               DO jl = 1, i_fill - 1
-                  IF ( jl .NE. jl0 ) THEN
-                     zsigma               = 0.5 * zht_i_ini(i_hemis)
-                     zarg                 = ( zh_i_ini(jl,i_hemis) - zht_i_ini(i_hemis) ) / zsigma
-                     za_i_ini(jl,i_hemis) = za_i_ini(jl0,i_hemis) * EXP(-zarg**2)
-                  ENDIF
-               END DO
-               
-               zA = 0. ! sum of the areas in the jpl categories 
-               DO jl = 1, i_fill - 1
-                 zA = zA + za_i_ini(jl,i_hemis)
-               END DO
-               za_i_ini(i_fill,i_hemis)   = zat_i_ini(i_hemis) - zA ! ice conc in the last category
-               IF ( i_fill .LT. jpl ) za_i_ini(i_fill+1:jpl, i_hemis) = 0._wp
-         
-               !--- Ice thickness in the last category
-               zV = 0. ! sum of the volumes of the N-1 categories
-               DO jl = 1, i_fill - 1
-                  zV = zV + za_i_ini(jl,i_hemis)*zh_i_ini(jl,i_hemis)
-               END DO
-               zh_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis) 
-               IF ( i_fill .LT. jpl ) zh_i_ini(i_fill+1:jpl, i_hemis) = 0._wp
-
-               !--- volumes
-               zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh_i_ini(:,i_hemis)
-               IF ( i_fill .LT. jpl ) zv_i_ini(i_fill+1:jpl, i_hemis) = 0._wp
-
-            ENDIF ! i_fill
-
-            !---------------------
-            ! Compatibility tests
-            !---------------------
-            ! Test 1: area conservation
-            zA_cons = SUM(za_i_ini(:,i_hemis)) ; zconv = ABS(zat_i_ini(i_hemis) - zA_cons )
-            IF ( zconv .LT. 1.0e-6 ) THEN
-               ztest_1 = 1
-            ELSE 
-              ! this write is useful
-              IF(lwp)  WRITE(numout,*) ' * TEST1 AREA NOT CONSERVED *** zA_cons = ', zA_cons,' zat_i_ini = ',zat_i_ini(i_hemis) 
-               ztest_1 = 0
-            ENDIF
-
-            ! Test 2: volume conservation
-            zV_cons = SUM(zv_i_ini(:,i_hemis))
-            zconv = ABS(zvt_i_ini(i_hemis) - zV_cons)
-
-            IF ( zconv .LT. 1.0e-6 ) THEN
-               ztest_2 = 1
-            ELSE
-              ! this write is useful
-              IF(lwp)  WRITE(numout,*) ' * TEST2 VOLUME NOT CONSERVED *** zV_cons = ', zV_cons, &
-                            ' zvt_i_ini = ', zvt_i_ini(i_hemis)
-               ztest_2 = 0
-            ENDIF
-
-            ! Test 3: thickness of the last category is in-bounds ?
-            IF ( zh_i_ini(i_fill, i_hemis) > hi_max(i_fill-1) ) THEN
-               ztest_3 = 1
-            ELSE
-               ! this write is useful
-               IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(i_fill,i_hemis) = ', &
-               zh_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1)
-               ztest_3 = 0
-            ENDIF
-
-            ! Test 4: positivity of ice concentrations
-            ztest_4 = 1
-            DO jl = 1, jpl
-               IF ( za_i_ini(jl,i_hemis) .LT. 0._wp ) THEN 
-                  ! this write is useful
-                  IF(lwp) WRITE(numout,*) ' * TEST 4 POSITIVITY NOT OK FOR CAT ', jl, ' WITH A = ', za_i_ini(jl,i_hemis)
-                  ztest_4 = 0
-               ENDIF
-            END DO
-
-         ENDIF ! ztest_1 + ztest_2 + ztest_3 + ztest_4
- 
-         ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4
-
-      END DO ! i_fill
-
-      IF(lwp) THEN 
-         WRITE(numout,*) ' ztests : ', ztests
-         IF ( ztests .NE. 4 ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) ' !!!! ALERT                  !!! '
-            WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure '
-            WRITE(numout,*)
-            WRITE(numout,*) ' *** ztests is not equal to 4 '
-            WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4
-            WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(i_hemis)
-            WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(i_hemis)
-         ENDIF ! ztests .NE. 4
-      ENDIF
-      
-      END DO ! i_hemis
-
-      !---------------------------------------------------------------------
-      ! 3.3) Space-dependent arrays for ice state variables
-      !---------------------------------------------------------------------
-
-      ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature
-      DO jl = 1, jpl ! loop over categories
+            END DO
+
+         ENDIF ! ln_iceini_file
+
+         zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:)   ! ice volume
+
+         !---------------------------------------------------------------------
+         ! 3.2) Distribute ice concentration and thickness into the categories
+         !---------------------------------------------------------------------
+         ! a gaussian distribution for ice concentration is used
+         ! then we check whether the distribution fullfills
+         ! volume and area conservation, positivity and ice categories bounds
+         zh_i_ini(:,:,:) = 0._wp 
+         za_i_ini(:,:,:) = 0._wp
+         zv_i_ini(:,:,:) = 0._wp
+
          DO jj = 1, jpj
             DO ji = 1, jpi
-               a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration
-               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))   ! ice thickness
-               ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) )  ! snow depth
-               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj))     ! salinity
-               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                        ! age (1 day)
-               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp
-
-               ! This case below should not be used if (ht_s/ht_i) is ok in namelist
-               ! In case snow load is in excess that would lead to transformation from snow to ice
-               ! Then, transfer the snow excess into the ice (different from limthd_dh)
-               zdh = MAX( 0._wp, ( rhosn * ht_s(ji,jj,jl) + ( rhoic - rau0 ) * ht_i(ji,jj,jl) ) * r1_rau0 ) 
-               ! recompute ht_i, ht_s avoiding out of bounds values
-               ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh )
-               ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn )
-
-               ! ice volume, salt content, age content
-               v_i(ji,jj,jl)   = ht_i(ji,jj,jl) * a_i(ji,jj,jl)              ! ice volume
-               v_s(ji,jj,jl)   = ht_s(ji,jj,jl) * a_i(ji,jj,jl)              ! snow volume
-               smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content
-               oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content
-            END DO
-         END DO
-      END DO
-
-      ! Snow temperature and heat content
-      DO jk = 1, nlay_s
+
+               IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN
+
+                  ztest_1 = 0 ; ztest_2 = 0 ; ztest_3 = 0 ; ztest_4 = 0
+!                  ztests  = 0 
+
+                  DO i_fill = jpl, 1, -1
+
+!                     IF( ztests .NE. 4 ) THEN
+                     IF ( ( ztest_1 + ztest_2 + ztest_3 + ztest_4 ) .NE. 4 ) THEN
+                        !----------------------------
+                        ! fill the i_fill categories
+                        !----------------------------
+                        ! *** 1 category to fill
+                        IF ( i_fill .EQ. 1 ) THEN
+                           zh_i_ini(ji,jj,    1)   = zht_i_ini(ji,jj)
+                           za_i_ini(ji,jj,    1)   = zat_i_ini(ji,jj)
+                           zh_i_ini(ji,jj,2:jpl)   = 0._wp
+                           za_i_ini(ji,jj,2:jpl)   = 0._wp
+                        ELSE
+
+                           ! *** >1 categores to fill
+                           !--- Ice thicknesses in the i_fill - 1 first categories
+                           DO jl = 1, i_fill - 1
+                              zh_i_ini(ji,jj,jl) = hi_mean(jl)
+                           END DO
+               
+                           !--- jl0: most likely index where cc will be maximum
+                           DO jl = 1, jpl
+                              IF ( ( zht_i_ini(ji,jj) >  hi_max(jl-1) ) .AND. &
+                                 & ( zht_i_ini(ji,jj) <= hi_max(jl)   ) ) THEN
+                                 jl0 = jl
+                              ENDIF
+                           END DO
+                           jl0 = MIN(jl0, i_fill)
+               
+                           !--- Concentrations
+                           za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl))
+                           DO jl = 1, i_fill - 1
+                              IF( jl .NE. jl0 )THEN
+                                 zsigma             = 0.5 * zht_i_ini(ji,jj)
+                                 zarg               = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / zsigma
+                                 za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2)
+                              ENDIF
+                           END DO
+               
+                           zA = 0. ! sum of the areas in the jpl categories 
+                           DO jl = 1, i_fill - 1
+                              zA = zA + za_i_ini(ji,jj,jl)
+                           END DO
+                           za_i_ini(ji,jj,i_fill)   = zat_i_ini(ji,jj) - zA ! ice conc in the last category
+                           IF ( i_fill .LT. jpl ) za_i_ini(ji,jj,i_fill+1:jpl) = 0._wp
+         
+                           !--- Ice thickness in the last category
+                           zV = 0. ! sum of the volumes of the N-1 categories
+                           DO jl = 1, i_fill - 1
+                              zV = zV + za_i_ini(ji,jj,jl)*zh_i_ini(ji,jj,jl)
+                           END DO
+                           zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / za_i_ini(ji,jj,i_fill) 
+                           IF ( i_fill .LT. jpl ) zh_i_ini(ji,jj,i_fill+1:jpl) = 0._wp
+
+                           !--- volumes
+                           zv_i_ini(ji,jj,:) = za_i_ini(ji,jj,:) * zh_i_ini(ji,jj,:)
+                           IF ( i_fill .LT. jpl ) zv_i_ini(ji,jj,i_fill+1:jpl) = 0._wp
+
+                        ENDIF ! i_fill
+
+                        !---------------------
+                        ! Compatibility tests
+                        !---------------------
+                        ! Test 1: area conservation
+                        zA_cons = SUM(za_i_ini(ji,jj,:)) ; zconv = ABS(zat_i_ini(ji,jj) - zA_cons )
+                        IF ( zconv .LT. 1.0e-6 ) THEN
+                           ztest_1 = 1
+                        ELSE 
+                          !this write is useful
+                          IF(lwp)  WRITE(numout,*) ' * TEST1 AREA NOT CONSERVED *** zA_cons = ', zA_cons,' zat_i_ini = ',zat_i_ini(ji,jj) 
+                          ztest_1 = 0
+                        ENDIF
+
+                        ! Test 2: volume conservation
+                        zV_cons = SUM(zv_i_ini(ji,jj,:))
+                        zconv = ABS(zvt_i_ini(ji,jj) - zV_cons)
+
+                        IF( zconv .LT. 1.0e-6 ) THEN
+                           ztest_2 = 1
+                        ELSE
+                           !this write is useful
+                           IF(lwp)  WRITE(numout,*) ' * TEST2 VOLUME NOT CONSERVED *** zV_cons = ', zV_cons, &
+                                                    ' zvt_i_ini = ', zvt_i_ini(ji,jj)
+                           ztest_2 = 0
+                        ENDIF
+
+                        ! Test 3: thickness of the last category is in-bounds ?
+                        IF ( zh_i_ini(ji,jj,i_fill) > hi_max(i_fill-1) ) THEN
+                           ztest_3 = 1
+                        ELSE
+                           ! this write is useful
+                           IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(ji,jj,i_fill) = ', &
+                           zh_i_ini(ji,jj,i_fill), ' hi_max(jpl-1) = ', hi_max(i_fill-1)
+                           IF(lwp) WRITE(numout,*) ' ji,jj,i_fill ',ji,jj,i_fill
+                           IF(lwp) WRITE(numout,*) 'zht_i_ini ',zht_i_ini(ji,jj)
+                           ztest_3 = 0
+                        ENDIF
+
+                        ! Test 4: positivity of ice concentrations
+                        ztest_4 = 1
+                        DO jl = 1, jpl
+                           IF ( za_i_ini(ji,jj,jl) .LT. 0._wp ) THEN 
+                              ! this write is useful
+                              IF(lwp) WRITE(numout,*) ' * TEST 4 POSITIVITY NOT OK FOR CAT ', jl, ' WITH A = ', za_i_ini(ji,jj,jl)
+                              ztest_4 = 0
+                           ENDIF
+                        END DO
+
+                     ENDIF ! ztest_1 + ztest_2 + ztest_3 + ztest_4
+ 
+                     ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4
+
+                  END DO ! i_fill
+
+                  IF(lwp) THEN 
+                     WRITE(numout,*) ' ztests : ', ztests
+                     IF( ztests .NE. 4 )THEN
+                        WRITE(numout,*)
+                        WRITE(numout,*) ' !!!! ALERT                  !!! '
+                        WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure '
+                        WRITE(numout,*)
+                        WRITE(numout,*) ' *** ztests is not equal to 4 '
+                        WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4
+                        WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj)
+                        WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj)
+                     ENDIF ! ztests .NE. 4
+                  ENDIF
+      
+               ENDIF !  zat_i_ini(ji,jj) > 0._wp .AND. zhm_i_ini(ji,jj) > 0._wp
+
+            ENDDO   
+         ENDDO   
+
+         !---------------------------------------------------------------------
+         ! 3.3) Space-dependent arrays for ice state variables
+         !---------------------------------------------------------------------
+
+         ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature
          DO jl = 1, jpl ! loop over categories
             DO jj = 1, jpj
                DO ji = 1, jpi
-                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0
-                   ! Snow energy of melting
-                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
-
-                   ! Mutliply by volume, and divide by number of layers to get heat content in J/m2
-                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
+                  a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini(ji,jj,jl)                       ! concentration
+                  ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(ji,jj,jl)                       ! ice thickness
+                  sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(ji,jj)                         ! salinity
+                  o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                                    ! age (1 day)
+                  t_su(ji,jj,jl)  = zswitch(ji,jj) * zts_u_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp
+
+                  IF( zht_i_ini(ji,jj) > 0._wp )THEN
+                    ht_s(ji,jj,jl)= ht_i(ji,jj,jl) * ( zht_s_ini(ji,jj) / zht_i_ini(ji,jj) )  ! snow depth
+                  ELSE
+                    ht_s(ji,jj,jl)= 0._wp
+                  ENDIF
+
+                  ! This case below should not be used if (ht_s/ht_i) is ok in namelist
+                  ! In case snow load is in excess that would lead to transformation from snow to ice
+                  ! Then, transfer the snow excess into the ice (different from limthd_dh)
+                  zdh = MAX( 0._wp, ( rhosn * ht_s(ji,jj,jl) + ( rhoic - rau0 ) * ht_i(ji,jj,jl) ) * r1_rau0 ) 
+                  ! recompute ht_i, ht_s avoiding out of bounds values
+                  ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh )
+                  ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn )
+
+                  ! ice volume, salt content, age content
+                  v_i(ji,jj,jl)   = ht_i(ji,jj,jl) * a_i(ji,jj,jl)              ! ice volume
+                  v_s(ji,jj,jl)   = ht_s(ji,jj,jl) * a_i(ji,jj,jl)              ! snow volume
+                  smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content
+                  oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content
                END DO
             END DO
          END DO
-      END DO
-
-      ! Ice salinity, temperature and heat content
-      DO jk = 1, nlay_i
-         DO jl = 1, jpl ! loop over categories
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 
-                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin
-                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K
-
-                   ! heat content per unit volume
-                   e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
-                      +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &
-                      -   rcp     * ( ztmelts - rt0 ) )
-
-                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
-                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i
+
+         ! Snow temperature and heat content
+         DO jk = 1, nlay_s
+            DO jl = 1, jpl ! loop over categories
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0
+                     ! Snow energy of melting
+                     e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
+
+                     ! Mutliply by volume, and divide by number of layers to get heat content in J/m2
+                     e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
+                  END DO
                END DO
             END DO
          END DO
-      END DO
-
-      tn_ice (:,:,:) = t_su (:,:,:)
-
-      ELSE 
-         ! if ln_iceini=false
+
+         ! Ice salinity, temperature and heat content
+         DO jk = 1, nlay_i
+            DO jl = 1, jpl ! loop over categories
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 
+                     s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rn_simin
+                     ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K
+
+                     ! heat content per unit volume
+                     e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
+                        +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &
+                        -   rcp     * ( ztmelts - rt0 ) )
+
+                     ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
+                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i
+                  END DO
+               END DO
+            END DO
+         END DO
+
+         tn_ice (:,:,:) = t_su (:,:,:)
+
+      ELSE ! if ln_iceini=false
          a_i  (:,:,:) = 0._wp
          v_i  (:,:,:) = 0._wp
@@ -400,5 +440,5 @@
             END DO
          END DO
-      
+
       ENDIF ! ln_iceini
       
@@ -452,8 +492,7 @@
 
 
-      CALL wrk_dealloc( jpi, jpj, zswitch )
-      CALL wrk_dealloc( jpi, jpj, zhemis )
-      CALL wrk_dealloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini )
-      CALL wrk_dealloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
+      CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini,  zv_i_ini )
+      CALL wrk_dealloc( jpi, jpj,      zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
+      CALL wrk_dealloc( jpi, jpj,      zswitch )
 
    END SUBROUTINE lim_istate
@@ -475,7 +514,17 @@
       !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization
       !!-----------------------------------------------------------------------------
-      NAMELIST/namiceini/ ln_iceini, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, rn_hti_ini_n, rn_hti_ini_s,  &
-         &                                      rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s
-      INTEGER :: ios                 ! Local integer output status for namelist read
+      !
+      INTEGER :: ios,ierr,inum_ice                 ! Local integer output status for namelist read
+      INTEGER :: ji,jj
+      INTEGER :: ifpr, ierror
+      !
+      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ice files
+      TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi
+      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read
+      !
+      NAMELIST/namiceini/ ln_iceini, ln_iceini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s,  &
+         &                rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, &
+         &                rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s,                             &
+         &                sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, cn_dir
       !!-----------------------------------------------------------------------------
       !
@@ -489,4 +538,8 @@
       IF(lwm) WRITE ( numoni, namiceini )
 
+      slf_i(jp_hti) = sn_hti  ;  slf_i(jp_hts) = sn_hts
+      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_tsu) = sn_tsu
+      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_smi) = sn_smi
+
       ! Define the initial parameters
       ! -------------------------
@@ -497,4 +550,5 @@
          WRITE(numout,*) '~~~~~~~~~~~~~~~'
          WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_iceini     = ', ln_iceini
+         WRITE(numout,*) '   ice initialization from a netcdf file      ln_iceini_file  = ', ln_iceini_file
          WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst
          WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n
@@ -510,4 +564,24 @@
       ENDIF
 
+      IF( ln_iceini_file ) THEN                      ! Ice initialization using input file
+         !
+         ! set si structure
+         ALLOCATE( si(jpfldi), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'Ice_ini in limistate: unable to allocate si structure' )   ;   RETURN
+         ENDIF
+
+         DO ifpr = 1, jpfldi
+            ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) )
+            ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) )
+         END DO
+
+         ! fill si with slf_i and control print
+         CALL fld_fill( si, slf_i, cn_dir, 'lim_istate', 'lim istate ini', 'numnam_ice' )
+
+         CALL fld_read( nit000, 1, si )                ! input fields provided at the current time-step
+
+      ENDIF
+
    END SUBROUTINE lim_istate_init
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 6808)
@@ -377,5 +377,5 @@
          CALL prt_ctl_info(' - Cell values : ')
          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_me  : cell area :')
+         CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_itd_me  : cell area :')
          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me  : at_i      :')
          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me  : vt_i      :')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 6808)
@@ -355,14 +355,14 @@
                divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
                   &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
-                  &            ) * r1_e12t(ji,jj)
+                  &            ) * r1_e1e2t(ji,jj)
 
                zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
                   &         - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
-                  &         ) * r1_e12t(ji,jj)
+                  &         ) * r1_e1e2t(ji,jj)
 
                !
                zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
                   &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
-                  &         ) * r1_e12f(ji,jj) * ( 2._wp - fmask(ji,jj,1) )   &
+                  &         ) * r1_e1e2f(ji,jj) * ( 2._wp - fmask(ji,jj,1) )   &
                   &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1)
 
@@ -386,5 +386,5 @@
                zdst          = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )   &
                   &            + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1)   &
-                  &            ) * r1_e12t(ji,jj)
+                  &            ) * r1_e1e2t(ji,jj)
 
                delta          = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )  
@@ -394,9 +394,9 @@
                zddc  = (  ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  &
                   &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  &
-                  &    ) * r1_e12f(ji,jj)
+                  &    ) * r1_e1e2f(ji,jj)
 
                zdtc  = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  &
                   &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  &
-                  &    ) * r1_e12f(ji,jj)
+                  &    ) * r1_e1e2f(ji,jj)
 
                zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl
@@ -423,10 +423,10 @@
                   &             + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj)          &
                   &             + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj)  &
-                  &                ) * r1_e12u(ji,jj)
+                  &                ) * r1_e1e2u(ji,jj)
                ! contribution of zs1, zs2 and zs12 to zf2
                zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)  &
                   &             - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj)          &
                   &             + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj)  &
-                  &               )  * r1_e12v(ji,jj)
+                  &               )  * r1_e1e2v(ji,jj)
             END DO
          END DO
@@ -607,18 +607,18 @@
                divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj  ) * u_ice(ji-1,jj  )   &
                   &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji  ,jj-1) * v_ice(ji  ,jj-1)   &
-                  &            ) * r1_e12t(ji,jj)
+                  &            ) * r1_e1e2t(ji,jj)
 
                zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)  &
                   &          -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)  &
-                  &         ) * r1_e12t(ji,jj)
+                  &         ) * r1_e1e2t(ji,jj)
                !
                ! SB modif because ocean has no slip boundary condition 
                zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  &
                   &          +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  &
-                  &         ) * r1_e12f(ji,jj) * ( 2.0 - fmask(ji,jj,1) )                                     &
+                  &         ) * r1_e1e2f(ji,jj) * ( 2.0 - fmask(ji,jj,1) )                                     &
                   &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1)
 
                zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )    &
-                  &   + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1) ) * r1_e12t(ji,jj)
+                  &   + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1) ) * r1_e1e2t(ji,jj)
 
                delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )  
@@ -637,5 +637,5 @@
          DO ji = fs_2, fs_jpim1
             zdst           = (  e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)  &   
-               &              + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e12t(ji,jj) 
+               &              + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e1e2t(ji,jj) 
             shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst )
          END DO
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 6808)
@@ -77,6 +77,4 @@
                WRITE(numout,*)
                SELECT CASE ( jprstlib )
-               CASE ( jprstdimg )
-                  WRITE(numout,*) '             open ice restart binary file: ',TRIM(clpath)//clname
                CASE DEFAULT
                   WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname
@@ -331,11 +329,4 @@
       ENDIF
 
-      IF ( jprstlib == jprstdimg ) THEN
-        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
-        ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90
-        INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok )
-        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
-      ENDIF
-
       CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib )
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 6808)
@@ -23,29 +23,30 @@
    !!   lim_sbc_tau   : update i- and j-stresses, and its modulus at the ocean surface
    !!----------------------------------------------------------------------
-   USE par_oce          ! ocean parameters
-   USE phycst           ! physical constants
-   USE dom_oce          ! ocean domain
-   USE ice              ! LIM sea-ice variables
-   USE sbc_ice          ! Surface boundary condition: sea-ice fields
-   USE sbc_oce          ! Surface boundary condition: ocean fields
-   USE sbccpl
-   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
-   USE albedo           ! albedo parameters
-   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges
-   USE lib_mpp          ! MPP library
-   USE wrk_nemo         ! work arrays
-   USE in_out_manager   ! I/O manager
-   USE prtctl           ! Print control
-   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE traqsr           ! add penetration of solar flux in the calculation of heat budget
-   USE iom
-   USE domvvl           ! Variable volume
-   USE limctl
-   USE limcons
+   USE par_oce        ! ocean parameters
+   USE oce     , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean domain
+   USE ice            ! LIM sea-ice variables
+   USE sbc_ice        ! Surface boundary condition: sea-ice fields
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbccpl         ! Surface boundary condition: coupled interface
+   USE albedo         ! albedo parameters
+   USE traqsr         ! add penetration of solar flux in the calculation of heat budget
+   USE domvvl         ! Variable volume
+   USE limctl         ! 
+   USE limcons        ! 
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! xIO server
+   USE lbclnk         ! ocean lateral boundary condition - MPP exchanges
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE prtctl         ! Print control
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_sbc_init   ! called by sbc_lim_init
+   PUBLIC   lim_sbc_init   ! called by sbcice_lim
    PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim
    PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim
@@ -57,5 +58,4 @@
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
@@ -101,12 +101,12 @@
       !!              The ref should be Rousset et al., 2015
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt                                  ! number of iteration
-      INTEGER  ::   ji, jj, jl, jk                                 ! dummy loop indices
-      REAL(wp) ::   zqmass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2)
-      REAL(wp) ::   zqsr                                           ! New solar flux received by the ocean
-      !
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace
+      INTEGER, INTENT(in) ::   kt   ! number of iteration
+      !
+      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices
+      REAL(wp) ::   zqmass           ! Heat flux associated with mass exchange ice->ocean (W.m-2)
+      REAL(wp) ::   zqsr             ! New solar flux received by the ocean
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 3D workspace
       !!---------------------------------------------------------------------
-
+      !
       ! make calls for heat fluxes before it is modified
       IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface
@@ -198,15 +198,15 @@
       !    Snow/ice albedo (only if sent to coupler, useless in forced mode)   !
       !------------------------------------------------------------------------!
-      CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os )    
+      CALL wrk_alloc( jpi,jpj,jpl,   zalb_cs, zalb_os )    
       CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos
       alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
-      CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os )
+      CALL wrk_dealloc( jpi,jpj,jpl,   zalb_cs, zalb_os )
 
       ! conservation test
-      IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' )
+      IF( ln_limdiahsb )   CALL lim_cons_final( 'limsbc' )
 
       ! control prints
       IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' )
-
+      !
       IF(ln_ctl) THEN
          CALL prt_ctl( tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns , clinfo2=' qns     : ' )
@@ -215,5 +215,5 @@
          CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl )
       ENDIF
-
+      !
    END SUBROUTINE lim_sbc_flx
 
@@ -246,5 +246,5 @@
       INTEGER ,                     INTENT(in) ::   kt               ! ocean time-step index
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pu_oce, pv_oce   ! surface ocean currents
-      !!
+      !
       INTEGER  ::   ji, jj   ! dummy loop indices
       REAL(wp) ::   zat_u, zutau_ice, zu_t, zmodt   ! local scalar
@@ -303,6 +303,8 @@
       !! ** input   : Namelist namicedia
       !!-------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk                       ! dummy loop indices
-      REAL(wp) ::   zcoefu, zcoefv, zcoeff          ! local scalar
+      INTEGER  ::   ji, jj, jk               ! dummy loop indices
+      REAL(wp) ::   zcoefu, zcoefv, zcoeff   ! local scalar
+      !!-------------------------------------------------------------------
+      !
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'lim_sbc_init : LIM-3 sea-ice - surface boundary condition'
@@ -335,43 +337,44 @@
             sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
             sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
-#if defined key_vvl            
-           ! key_vvl necessary? clem: yes for compilation purpose
-            DO jk = 1,jpkm1                     ! adjust initial vertical scale factors
-               fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
-               fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
-            ENDDO
-            fse3t_a(:,:,:) = fse3t_b(:,:,:)
-            ! Reconstruction of all vertical scale factors at now and before time
-            ! steps
-            ! =============================================================================
-            ! Horizontal scale factor interpolations
-            ! --------------------------------------
-            CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' )
-            CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' )
-            CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' )
-            CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' )
-            CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' )
-            ! Vertical scale factor interpolations
-            ! ------------------------------------
-            CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W'  )
-            CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' )
-            CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' )
-            CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' )
-            CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' )
-            ! t- and w- points depth
-            ! ----------------------
-            fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)
-            fsdepw_n(:,:,1) = 0.0_wp
-            fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:)
-            DO jk = 2, jpk
-               fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk)
-               fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1)
-               fsde3w_n(:,:,jk) = fsdept_n(:,:,jk  ) - sshn   (:,:)
-            END DO
-#endif
+
+!!gm I really don't like this staff here...  Find a way to put that elsewhere or differently
+!!gm
+            IF( .NOT.ln_linssh ) THEN
+               DO jk = 1,jpkm1                     ! adjust initial vertical scale factors
+                  e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+                  e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+               END DO
+               e3t_a(:,:,:) = e3t_b(:,:,:)
+               ! Reconstruction of all vertical scale factors at now and before time-steps
+               ! =========================================================================
+               ! Horizontal scale factor interpolations
+               ! --------------------------------------
+               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
+               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
+               CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+               CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+               CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
+               ! Vertical scale factor interpolations
+                 ! ------------------------------------
+               CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
+               CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
+               CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
+               CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
+               CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+               ! t- and w- points depth
+               ! ----------------------
+!!gm not sure of that....
+               gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+               gdepw_n(:,:,1) = 0.0_wp
+               gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+               DO jk = 2, jpk
+                  gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk)
+                  gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1)
+                  gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:)
+               END DO
+            ENDIF
          ENDIF
       ENDIF ! .NOT. ln_rstart
       !
-
    END SUBROUTINE lim_sbc_init
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 6808)
@@ -25,23 +25,24 @@
    USE sbc_oce        ! Surface boundary condition: ocean fields
    USE sbc_ice        ! Surface boundary condition: ice fields
-   USE thd_ice        ! LIM thermodynamic sea-ice variables
-   USE dom_ice        ! LIM sea-ice domain
+   USE dom_ice        ! LIM: sea-ice domain
+   USE thd_ice        ! LIM: thermodynamic sea-ice variables
    USE limthd_dif     ! LIM: thermodynamics, vertical diffusion
    USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation
    USE limthd_sal     ! LIM: thermodynamics, ice salinity
    USE limthd_ent     ! LIM: thermodynamics, ice enthalpy redistribution
-   USE limthd_lac     ! LIM-3 lateral accretion
-   USE limitd_th      ! remapping thickness distribution
+   USE limthd_lac     ! LIM: lateral accretion
+   USE limitd_th      ! LIM: remapping thickness distribution
    USE limtab         ! LIM: 1D <==> 2D transformation
    USE limvar         ! LIM: sea-ice variables
+   USE limcons        ! LIM: conservation tests
+   USE limctl         ! LIM: control print
+   !
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
    USE lbclnk         ! lateral boundary condition - MPP links
    USE lib_mpp        ! MPP library
    USE wrk_nemo       ! work arrays
-   USE in_out_manager ! I/O manager
-   USE prtctl         ! Print control
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
    USE timing         ! Timing
-   USE limcons        ! conservation tests
-   USE limctl
 
    IMPLICIT NONE
@@ -52,5 +53,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -81,19 +81,17 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) :: kt    ! number of iteration
-      !!
+      !
       INTEGER  :: ji, jj, jk, jl   ! dummy loop indices
       INTEGER  :: nbpb             ! nb of icy pts for vertical thermo calculations
-      INTEGER  :: ii, ij           ! temporary dummy loop index
       REAL(wp) :: zfric_u, zqld, zqfr
       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
       REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04)
       REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient
-      !
       !!-------------------------------------------------------------------
 
-      IF( nn_timing == 1 )  CALL timing_start('limthd')
+      IF( nn_timing == 1 )   CALL timing_start('limthd')
 
       ! conservation test
-      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+      IF( ln_limdiahsb )   CALL lim_cons_hsm( 0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b )
 
       CALL lim_var_glo2eqv
@@ -147,5 +145,5 @@
 
             ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- !
-            zqfr = tmask(ji,jj,1) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )
+            zqfr = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )
 
             ! --- Energy from the turbulent oceanic heat flux (W/m2) --- !
@@ -226,47 +224,25 @@
 
          IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing.
-
-            !-------------------------!
-            ! --- Move to 1D arrays ---
-            !-------------------------!
-            CALL lim_thd_1d2d( nbpb, jl, 1 )
-
-            !--------------------------------------!
-            ! --- Ice/Snow Temperature profile --- !
-            !--------------------------------------!
-            CALL lim_thd_dif( 1, nbpb )
-
-            !---------------------------------!
-            ! --- Ice/Snow thickness ---      !
-            !---------------------------------!
-            CALL lim_thd_dh( 1, nbpb )    
-
-            ! --- Ice enthalpy remapping --- !
-            CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) ) 
-                                            
-            !---------------------------------!
-            ! --- Ice salinity ---            !
-            !---------------------------------!
-            CALL lim_thd_sal( 1, nbpb )    
-
-            !---------------------------------!
-            ! --- temperature update ---      !
-            !---------------------------------!
-            CALL lim_thd_temp( 1, nbpb )
-
-            !------------------------------------!
-            ! --- lateral melting if monocat --- !
-            !------------------------------------!
+            !
+            CALL lim_thd_1d2d( nbpb, jl, 1 )                ! --- Move to 1D arrays ---!
+            !
+            CALL lim_thd_dif ( 1, nbpb )                    ! --- Ice/Snow Temperature profile --- !
+            !
+            CALL lim_thd_dh  ( 1, nbpb )                    ! --- Ice/Snow thickness ---!
+            !
+            CALL lim_thd_ent ( 1, nbpb, q_i_1d(1:nbpb,:) )  ! --- Ice enthalpy remapping --- !
+            !
+            CALL lim_thd_sal ( 1, nbpb )                    ! --- Ice salinity ---            !
+            !
+            CALL lim_thd_temp( 1, nbpb )                    ! --- temperature update ---      !
+            !
+            !                                               ! --- lateral melting if monocat --- !
             IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN
                CALL lim_thd_lam( 1, nbpb )
             END IF
-
-            !-------------------------!
-            ! --- Move to 2D arrays ---
-            !-------------------------!
-            CALL lim_thd_1d2d( nbpb, jl, 2 )
-
-            !
-            IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ??
+            !
+            CALL lim_thd_1d2d( nbpb, jl, 2 )                ! --- Move to 2D arrays ---
+            !
+            IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice )  !RB necessary ??
          ENDIF
          !
@@ -325,5 +301,5 @@
          CALL prt_ctl_info(' - Cell values : ')
          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_thd  : cell area :')
+         CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_thd  : cell area :')
          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd  : at_i      :')
          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd  : vt_i      :')
@@ -382,5 +358,5 @@
          CALL prt_ctl_info(' - Cell values : ')
          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_th  : cell area :')
+         CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_itd_th  : cell area :')
          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th  : at_i      :')
          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th  : vt_i      :')
@@ -410,6 +386,6 @@
       ENDIF
       !
-      IF( nn_timing == 1 )  CALL timing_stop('limthd')
-
+      IF( nn_timing == 1 )   CALL timing_stop('limthd')
+      !
    END SUBROUTINE lim_thd 
 
@@ -424,5 +400,5 @@
       !!-------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop
-      !!
+      !
       INTEGER  ::   ji, jk   ! dummy loop indices
       REAL(wp) ::   ztmelts, zaaa, zbbb, zccc, zdiscrim  ! local scalar 
@@ -444,6 +420,7 @@
          END DO 
       END DO 
-
+      !
    END SUBROUTINE lim_thd_temp
+
 
    SUBROUTINE lim_thd_lam( kideb, kiut )
@@ -455,9 +432,11 @@
       !!-----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kideb, kiut        ! bounds for the spatial loop
-      INTEGER             ::   ji                 ! dummy loop indices
-      REAL(wp)            ::   zhi_bef            ! ice thickness before thermo
-      REAL(wp)            ::   zdh_mel, zda_mel   ! net melting
-      REAL(wp)            ::   zvi, zvs           ! ice/snow volumes 
-
+      !
+      INTEGER  ::   ji                 ! dummy loop indices
+      REAL(wp) ::   zhi_bef            ! ice thickness before thermo
+      REAL(wp) ::   zdh_mel, zda_mel   ! net melting
+      REAL(wp) ::   zvi, zvs           ! ice/snow volumes 
+      !!-----------------------------------------------------------------------
+      !
       DO ji = kideb, kiut
          zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) )
@@ -477,6 +456,7 @@
          END IF
       END DO
-      
+      !
    END SUBROUTINE lim_thd_lam
+
 
    SUBROUTINE lim_thd_1d2d( nbpb, jl, kn )
@@ -486,19 +466,20 @@
       !! ** Purpose :   move arrays from 1d to 2d and the reverse
       !!-----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D
-                                        ! 2= from 1D to 2D
+      INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D   ;   2= from 1D to 2D
       INTEGER, INTENT(in) ::   nbpb     ! size of 1D arrays
       INTEGER, INTENT(in) ::   jl       ! ice cat
+      !
       INTEGER             ::   jk       ! dummy loop indices
-
+      !!-----------------------------------------------------------------------
+      !
       SELECT CASE( kn )
-
-      CASE( 1 )
-
+      !
+      CASE( 1 )            ! from 2D to 1D
+         !
          CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-         
+         !
          CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
@@ -512,5 +493,5 @@
             CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
          END DO
-         
+         !
          CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
@@ -526,8 +507,8 @@
          CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) )
-         
+         !
          CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) )
-         
+         !
          CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) )
@@ -536,5 +517,5 @@
          CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) )
-         
+         !
          CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) )
@@ -543,5 +524,5 @@
          CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) )
-         
+         !
          CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) )
@@ -557,7 +538,7 @@
          CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) )
-
-      CASE( 2 )
-
+         !
+      CASE( 2 )            ! from 1D to 2D
+         !
          CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj )
          CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj )
@@ -576,8 +557,8 @@
          END DO
          CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj )
-         
+         !
          CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj )
          CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj )
-         
+         !
          CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj )
          CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj )
@@ -586,5 +567,5 @@
          CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj )
          CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj )
-         
+         !
          CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj )
          CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj )
@@ -593,5 +574,5 @@
          CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj )
          CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj )
-         
+         !
          CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj )
          CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj )
@@ -612,5 +593,5 @@
          !         
       END SELECT
-
+      !
    END SUBROUTINE lim_thd_1d2d
 
@@ -629,6 +610,7 @@
       !!-------------------------------------------------------------------
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,                       &
-         &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, &
+      !!
+      NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,                &
+         &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon,  &
          &                nn_monocat, ln_it_qnsice
       !!-------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 6808)
@@ -95,5 +95,5 @@
       ENDIF
 
-      zsm(:,:) = e12t(:,:)
+      zsm(:,:) = e1e2t(:,:)
       
       !                             !-------------------------------------!
@@ -162,14 +162,14 @@
          ! transported fields                                        
          !-------------------------
-         z0opw(:,:,1) = ato_i(:,:) * e12t(:,:)             ! Open water area 
-         DO jl = 1, jpl
-            z0snw (:,:,jl)  = v_s  (:,:,jl) * e12t(:,:)    ! Snow volume
-            z0ice(:,:,jl)   = v_i  (:,:,jl) * e12t(:,:)    ! Ice  volume
-            z0ai  (:,:,jl)  = a_i  (:,:,jl) * e12t(:,:)    ! Ice area
-            z0smi (:,:,jl)  = smv_i(:,:,jl) * e12t(:,:)    ! Salt content
-            z0oi (:,:,jl)   = oa_i (:,:,jl) * e12t(:,:)    ! Age content
-            z0es (:,:,jl)   = e_s  (:,:,1,jl) * e12t(:,:)  ! Snow heat content
+         z0opw(:,:,1) = ato_i(:,:) * e1e2t(:,:)             ! Open water area 
+         DO jl = 1, jpl
+            z0snw (:,:,jl)  = v_s  (:,:,  jl) * e1e2t(:,:)  ! Snow volume
+            z0ice(:,:,jl)   = v_i  (:,:,  jl) * e1e2t(:,:)  ! Ice  volume
+            z0ai  (:,:,jl)  = a_i  (:,:,  jl) * e1e2t(:,:)  ! Ice area
+            z0smi (:,:,jl)  = smv_i(:,:,  jl) * e1e2t(:,:)  ! Salt content
+            z0oi (:,:,jl)   = oa_i (:,:,  jl) * e1e2t(:,:)  ! Age content
+            z0es (:,:,jl)   = e_s  (:,:,1,jl) * e1e2t(:,:)  ! Snow heat content
             DO jk = 1, nlay_i
-               z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e12t(:,:) ! Ice  heat content
+               z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content
             END DO
          END DO
@@ -263,14 +263,14 @@
          ! Recover the properties from their contents
          !-------------------------------------------
-         ato_i(:,:) = z0opw(:,:,1) * r1_e12t(:,:)
-         DO jl = 1, jpl
-            v_i  (:,:,jl)   = z0ice(:,:,jl) * r1_e12t(:,:)
-            v_s  (:,:,jl)   = z0snw(:,:,jl) * r1_e12t(:,:)
-            smv_i(:,:,jl)   = z0smi(:,:,jl) * r1_e12t(:,:)
-            oa_i (:,:,jl)   = z0oi (:,:,jl) * r1_e12t(:,:)
-            a_i  (:,:,jl)   = z0ai (:,:,jl) * r1_e12t(:,:)
-            e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e12t(:,:)
+         ato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:)
+         DO jl = 1, jpl
+            v_i  (:,:,  jl) = z0ice(:,:,jl) * r1_e1e2t(:,:)
+            v_s  (:,:,  jl) = z0snw(:,:,jl) * r1_e1e2t(:,:)
+            smv_i(:,:,  jl) = z0smi(:,:,jl) * r1_e1e2t(:,:)
+            oa_i (:,:,  jl) = z0oi (:,:,jl) * r1_e1e2t(:,:)
+            a_i  (:,:,  jl) = z0ai (:,:,jl) * r1_e1e2t(:,:)
+            e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e1e2t(:,:)
             DO jk = 1, nlay_i
-               e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e12t(:,:)
+               e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:)
             END DO
          END DO
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90	(revision 6808)
@@ -146,5 +146,5 @@
          CALL prt_ctl_info(' - Cell values : ')
          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update1  : cell area   :')
+         CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' lim_update1  : cell area   :')
          CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update1  : at_i        :')
          CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update1  : vt_i        :')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90	(revision 6808)
@@ -191,5 +191,5 @@
          CALL prt_ctl_info(' - Cell values : ')
          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update2  : cell area   :')
+         CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' lim_update2  : cell area   :')
          CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update2  : at_i        :')
          CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update2  : vt_i        :')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 6808)
@@ -41,7 +41,4 @@
 CONTAINS
 
-#if defined key_dimgout
-# include "limwri_dimg.h90"
-#else
 
    SUBROUTINE lim_wri( kindic )
@@ -298,5 +295,4 @@
       
    END SUBROUTINE lim_wri
-#endif
 
  
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90	(revision 6807)
+++ 	(revision )
@@ -1,198 +1,0 @@
-SUBROUTINE lim_wri
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-   !!-------------------------------------------------------------------
-   !!  This routine computes the average of some variables and write it
-   !!  on the ouput files.
-   !!  ATTENTION cette routine n'est valable que si le pas de temps est
-   !!  egale a une fraction entiere de 1 jours.
-   !!  Diff 1-D 3-D : suppress common also included in etat
-   !!                 suppress cmoymo 11-18
-   !!  modif : 03/06/98
-   !!-------------------------------------------------------------------
-   USE  diawri, ONLY : dia_wri_dimg
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
-
-   REAL(wp),DIMENSION(1) ::   zdept
-
-   REAL(wp) ::   zsto, zsec, zjulian,zout, &
-   REAL(wp) ::   zindh,zinda,zindb, ztmu
-   REAL(wp), DIMENSION(jpi,jpj,jpnoumax) ::   zcmo
-   REAL(wp), DIMENSION(jpi,jpj) ::   zfield
-   INTEGER, SAVE ::   nmoyice   !: counter for averaging
-   INTEGER, SAVE ::   nwf       !: number of fields to write on disk
-   INTEGER, SAVE,DIMENSION (:), ALLOCATABLE  :: nsubindex   !: subindex to be saved
-   ! according to namelist
-
-   REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy
-#if ! defined key_diainstant
-   LOGICAL, PARAMETER :: ll_dia_inst=.false.      ! local logical variable 
-#else
-   LOGICAL, PARAMETER :: ll_dia_inst=.true.
-#endif
-   INTEGER ::  ji, jj, jf, ii   ! dummy loop indices and array index
-   INTEGER :: iyear, iday, imon ! 
-
-   CHARACTER(LEN=80) :: clname, cltext, clmode
-
-
-   INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid
-   INTEGER , DIMENSION( jpij ) , SAVE ::   ndex51  
-   !!-------------------------------------------------------------------
-   IF ( numit == nstart ) THEN 
-
-      CALL lim_wri_init 
-
-      nwf = 0 
-      ii  = 0
-
-      IF (lwp ) THEN
-         WRITE(numout,*) 'lim_wri : Write ice outputs in dimg'
-         WRITE(numout,*) '~~~~~~~~'
-         WRITE(numout,*) '   According to namelist_ice, following fields saved:'
-         DO jf =1, noumef
-            IF (nc(jf) == 1 ) THEN
-               WRITE(numout,* ) '    -',titn(jf), nam(jf), uni(jf)
-            ENDIF
-         END DO
-      ENDIF
-
-      DO jf = 1, noumef
-         IF (nc(jf) == 1 ) nwf = nwf + 1
-      END DO
-
-      ALLOCATE( nsubindex (nwf) )
-
-      DO jf = 1, noumef
-         IF (nc(jf) == 1 ) THEN 
-            ii = ii +1 
-            nsubindex(ii) = jf
-         END IF
-      END DO
-
-      zsto     = rdt_ice
-      zout     = nwrite * rdt_ice / nn_fsbc
-      zsec     = 0.
-      niter    = 0
-      zdept(1) = 0.
-      nmoyice  = 0
-
-   ENDIF
-
-#if ! defined key_diainstant 
-   !-- calculs des valeurs instantanees
-
-   zcmo(:,:, 1:jpnoumax ) = 0.e0 
-   DO jj = 2 , jpjm1
-      DO ji = 2 , jpim1   ! NO vector opt.
-         zindh  = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )
-         zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
-         zindb  = zindh * zinda
-         ztmu   = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) ) 
-         zcmo(ji,jj,1)  = ht_s (ji,jj,1)
-         zcmo(ji,jj,2)  = ht_i (ji,jj,1)
-         zcmo(ji,jj,3)  = 0.
-         zcmo(ji,jj,4)  = frld  (ji,jj)
-         zcmo(ji,jj,5)  = sist  (ji,jj)
-         zcmo(ji,jj,6)  = fhtur  (ji,jj)
-         zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * umask(ji,jj,1) + u_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
-            + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
-            / ztmu 
-
-         zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * umask(ji,jj,1) + v_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
-            + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
-            / ztmu
-         zcmo(ji,jj,9)  = sst_m(ji,jj)
-         zcmo(ji,jj,10) = sss_m(ji,jj)
-
-         zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
-         zcmo(ji,jj,12) = qsr(ji,jj)
-         zcmo(ji,jj,13) = qns(ji,jj)
-         ! See thersf for the coefficient
-         zcmo(ji,jj,14) = - sfx (ji,jj) * rday      ! converted in Kg/m2/day = mm/day
-         zcmo(ji,jj,15) = utau_ice(ji,jj)
-         zcmo(ji,jj,16) = vtau_ice(ji,jj)
-         zcmo(ji,jj,17) = qsr (ji,jj)
-         zcmo(ji,jj,18) = qns(ji,jj)
-         zcmo(ji,jj,19) = sprecip(ji,jj)
-      END DO
-   END DO
-   ! Cumulates values between outputs           
-   rcmoy(:,:,:)= rcmoy(:,:,:) + zcmo(:,:,:)
-   nmoyice = nmoyice + 1 
-   ! compute mean value if it is time to write on file
-   IF ( MOD(numit,nwrite) == 0 ) THEN
-      rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice)
-#else  
-      IF ( MOD(numit,nwrite) == 0 ) THEN 
-         !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0
-         DO jj = 2 , jpjm1
-            DO ji = 2 , jpim1   ! NO vector opt.
-               zindh  = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )
-               zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
-               zindb  = zindh * zinda
-               ztmu   = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) )
-               rcmoy(ji,jj,1)  = ht_s (ji,jj,1)
-               rcmoy(ji,jj,2)  = ht_i (ji,jj,1)
-               rcmoy(ji,jj,3)  = 0.
-               rcmoy(ji,jj,4)  = frld  (ji,jj)
-               rcmoy(ji,jj,5)  = sist  (ji,jj)
-               rcmoy(ji,jj,6)  = fhtur  (ji,jj)
-               rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * umask(ji,jj,1) + u_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
-                  + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
-                  / ztmu
-
-               rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * umask(ji,jj,1) + v_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
-                  + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
-                  / ztmu
-               rcmoy(ji,jj,9)  = sst_m(ji,jj)
-               rcmoy(ji,jj,10) = sss_m(ji,jj)
-
-               rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
-               rcmoy(ji,jj,12) = qsr(ji,jj)
-               rcmoy(ji,jj,13) = qns(ji,jj)
-               ! See thersf for the coefficient
-               rcmoy(ji,jj,14) = - sfx (ji,jj) * rday      ! converted in mm/day
-               rcmoy(ji,jj,15) = utau_ice(ji,jj)
-               rcmoy(ji,jj,16) = vtau_ice(ji,jj)
-               rcmoy(ji,jj,17) = qsr(ji,jj)
-               rcmoy(ji,jj,18) = qns(ji,jj)
-               rcmoy(ji,jj,19) = sprecip(ji,jj)
-            END DO
-         END DO
-#endif
-
-         !
-         niter = niter + 1
-         DO jf = 1 , noumef
-            zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1)
-
-            IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN 
-               CALL lbc_lnk( zfield, 'T', -1. )
-            ELSE 
-               CALL lbc_lnk( zfield, 'T',  1. )
-            ENDIF
-            rcmoy(:,:,jf) = zfield(:,:)
-         END DO
-
-         IF (ll_dia_inst) THEN
-            clmode='instantaneous'
-         ELSE
-            WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average'
-         END IF
-         iyear = ndastp/10000
-         imon = (ndastp-iyear*10000)/100
-         iday = ndastp - imon*100 - iyear*10000
-         WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday
-         cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode)
-         CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex)
-9000     FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
-
-         rcmoy(:,:,:) = 0.0
-         nmoyice = 0 
-      END IF     !  MOD(numit, nwrite == 0 ) !
-
-   END SUBROUTINE lim_wri
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif2model.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 6808)
@@ -1,62 +1,64 @@
 #if defined key_agrif
-   !!----------------------------------------------------------------------
-   !! 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
+!!----------------------------------------------------------------------
+!! 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
 
-   SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr)
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_Set_numberofcells ***
-      !!--------------------------------------------- 
-      USE Agrif_Types
-      IMPLICIT NONE
+SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr)
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_Set_numberofcells ***
+   !!--------------------------------------------- 
+   USE Agrif_Grids
+   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_Types
-      IMPLICIT NONE
+SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr)
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_Get_numberofcells ***
+   !!--------------------------------------------- 
+   USE Agrif_Grids
+   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_Types 
+SUBROUTINE Agrif_Allocationcalls(Agrif_Gr)
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_Allocationscalls ***
+   !!--------------------------------------------- 
+   USE Agrif_Grids 
 #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"
@@ -64,43 +66,24 @@
 #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 ***
-      !!--------------------------------------------- 
-      Use Agrif_Types
-      IMPLICIT NONE
+SUBROUTINE Agrif_clustering_def()
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_clustering_def ***
+   !!--------------------------------------------- 
+   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
+#else
+SUBROUTINE Agrif2Model
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif2Model ***
+   !!--------------------------------------------- 
+   WRITE(*,*) 'Impossible to bet here'
+END SUBROUTINE Agrif2model
 #endif
-      Return
-
-   END SUBROUTINE Agrif_comm_def
-#else
-   SUBROUTINE Agrif2Model
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif2Model ***
-      !!--------------------------------------------- 
-      WRITE(*,*) 'Impossible to bet here'
-   END SUBROUTINE Agrif2model
-#endif
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90	(revision 6808)
@@ -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,4 +41,8 @@
    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)
@@ -65,6 +69,6 @@
       u_ice_nst(:,:) = 0.
       v_ice_nst(:,:) = 0.
-      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. )
+      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. )
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .FALSE.
@@ -138,5 +142,4 @@
       !!  we are in inside a new parent ice time step
       !!-----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj) :: zuice, zvice
       INTEGER :: ji,jj
       REAL(wp) :: zrhox, zrhoy
@@ -155,33 +158,36 @@
          Agrif_SpecialValue=-9999.
          Agrif_UseSpecialValue = .TRUE.
-         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.)
+         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.)
          Agrif_SpecialValue=0.
          Agrif_UseSpecialValue = .FALSE.
          !  
          zrhox = agrif_rhox() ;    zrhoy = agrif_rhoy()      
-         zuice(:,:) =  zuice(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)
-         zvice(:,:) =  zvice(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)
+         uice_agr(:,:) =  uice_agr(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)
+         vice_agr(:,:) =  vice_agr(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)
          ! fill  boundaries
          DO jj = 1, jpj
             DO ji = 1, 2
-               u_ice_oe(ji,  jj,2) = zuice(ji       ,jj) 
-               u_ice_oe(ji+2,jj,2) = zuice(nlci+ji-3,jj)
+               u_ice_oe(ji,  jj,2) = uice_agr(ji       ,jj) 
+               u_ice_oe(ji+2,jj,2) = uice_agr(nlci+ji-3,jj)
             END DO
          END DO
          DO jj = 1, jpj
-            v_ice_oe(2,jj,2) = zvice(2     ,jj) 
-            v_ice_oe(4,jj,2) = zvice(nlci-1,jj)
+            v_ice_oe(2,jj,2) = vice_agr(2     ,jj) 
+            v_ice_oe(4,jj,2) = vice_agr(nlci-1,jj)
          END DO
          DO ji = 1, jpi
-            u_ice_sn(ji,2,2) = zuice(ji,2     ) 
-            u_ice_sn(ji,4,2) = zuice(ji,nlcj-1)
+            u_ice_sn(ji,2,2) = uice_agr(ji,2     ) 
+            u_ice_sn(ji,4,2) = uice_agr(ji,nlcj-1)
          END DO
          DO jj = 1, 2
             DO ji = 1, jpi
-               v_ice_sn(ji,jj  ,2) = zvice(ji,jj       ) 
-               v_ice_sn(ji,jj+2,2) = zvice(ji,nlcj+jj-3)
+               v_ice_sn(ji,jj  ,2) = vice_agr(ji,jj       ) 
+               v_ice_sn(ji,jj+2,2) = vice_agr(ji,nlcj+jj-3)
             END DO
          END DO
@@ -334,5 +340,4 @@
       !!  we are in inside a new parent ice time step
      !!-----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 
       INTEGER :: ji,jj,jn
       !!-----------------------------------------------------------------------
@@ -345,8 +350,11 @@
          adv_ice_sn(:,:,:,1) =  adv_ice_sn(:,:,:,2)
          ! interpolation of boundaries
-         ztab(:,:,:) = 0.
+         IF(.NOT.ALLOCATED(tabice_agr))THEN
+            ALLOCATE(tabice_agr(jpi,jpj,7))   
+         ENDIF
+         tabice_agr(:,:,:) = 0.
          Agrif_SpecialValue=-9999.
          Agrif_UseSpecialValue = .TRUE.
-         CALL Agrif_Bc_variable( ztab, adv_ice_id ,procname=interp_adv_ice,calledweight=1. )
+         CALL Agrif_Bc_variable( adv_ice_id ,procname=interp_adv_ice,calledweight=1. )
          Agrif_SpecialValue=0.
          Agrif_UseSpecialValue = .FALSE.
@@ -356,6 +364,6 @@
             DO jj = 1, jpj
                DO ji=1,2
-                  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)
+                  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)
                END DO
             END DO
@@ -365,6 +373,6 @@
             Do jj =1,2
                DO ji = 1, jpi
-                  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)
+                  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)
                END DO
             END DO
@@ -384,5 +392,5 @@
       INTEGER :: ji,jj,jn
       REAL(wp) :: zalpha
-      REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 
+      REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr 
       !!-----------------------------------------------------------------------      
       !
@@ -391,10 +399,10 @@
       zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc))
       !
-      ztab(:,:,:) = 0.e0
+      tabice_agr(:,:,:) = 0.e0
       DO jn =1,7
          DO jj =1,2
             DO ji = 1, jpi
-               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) 
+               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) 
             END DO
          END DO
@@ -404,17 +412,17 @@
          DO jj = 1, jpj
             DO ji=1,2
-               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) 
+               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( 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 )
+      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 )
       !
    END SUBROUTINE agrif_trp_lim2
@@ -499,5 +507,5 @@
 
 
-   SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2 )
+   SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2, before )
       !!-----------------------------------------------------------------------
       !!                     *** ROUTINE interp_u_ice ***
@@ -505,4 +513,5 @@
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
       !!
       INTEGER :: ji,jj
@@ -510,28 +519,32 @@
       !
 #if defined key_lim2_vp
-      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
+      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
 #else
-      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
+      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
 #endif
    END SUBROUTINE interp_u_ice
 
 
-   SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2 )
+   SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2, before )
       !!-----------------------------------------------------------------------
       !!                    *** ROUTINE interp_v_ice ***
@@ -539,4 +552,5 @@
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
       !!
       INTEGER :: ji, jj
@@ -544,28 +558,32 @@
       !
 #if defined key_lim2_vp
-      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
+      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   
 #else
-      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
+      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
 #endif
    END SUBROUTINE interp_v_ice
 
 
-   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2 )
+   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, before )
       !!-----------------------------------------------------------------------
       !!                    *** ROUTINE interp_adv_ice ***                           
@@ -577,23 +595,26 @@
       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
       !!-----------------------------------------------------------------------
       !
-      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
+      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
       !
    END SUBROUTINE interp_adv_ice
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90	(revision 6808)
@@ -52,6 +52,4 @@
       INTEGER, INTENT(in) :: kt
       !!
-      REAL(wp), DIMENSION(jpi,jpj)  :: zvel
-      REAL(wp), DIMENSION(jpi,jpj,7):: zadv
       !!----------------------------------------------------------------------
       !
@@ -60,14 +58,13 @@
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
-
 # if defined TWO_WAY
       IF( MOD(nbcline,nbclineupdate) == 0) THEN
-         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    )
+         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    )
       ENDIF
 # endif
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 6808)
@@ -12,5 +12,5 @@
    USE par_oce      ! ocean parameters
    USE dom_oce      ! domain parameters
-   
+
    IMPLICIT NONE
    PRIVATE 
@@ -19,8 +19,10 @@
 
    !                                              !!* Namelist namagrif: AGRIF parameters
-   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
+   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 
 
    !                                              !!! OLD namelist names
@@ -30,16 +32,42 @@
    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 :: 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
 
-   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
+   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
 
    !!----------------------------------------------------------------------
@@ -54,6 +82,24 @@
       !!                ***  FUNCTION agrif_oce_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( spe1ur (jpi,jpj) , spe2vr (jpi,jpj) , spbtr2(jpi,jpj) ,      &
-         &      spe1ur2(jpi,jpj) , spe2vr2(jpi,jpj) , spbtr3(jpi,jpj) , STAT = 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)
+      !
    END FUNCTION agrif_oce_alloc
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 6808)
@@ -7,4 +7,5 @@
    !!             -   !  2005-11  (XXX) 
    !!            3.2  !  2009-04  (R. Benshila) 
+   !!            3.6  !  2014-09  (R. Benshila) 
    !!----------------------------------------------------------------------
 #if defined key_agrif && ! defined key_offline
@@ -21,587 +22,363 @@
    USE oce
    USE dom_oce      
-   USE sol_oce
+   USE zdf_oce
    USE agrif_oce
    USE phycst
+   !
    USE in_out_manager
    USE agrif_opa_sponge
    USE lib_mpp
    USE wrk_nemo
-   USE dynspg_oce
-
+ 
    IMPLICIT NONE
    PRIVATE
 
-   ! 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   interpu, interpv, interpunb, interpvnb, interpsshn
-
-#  include "domzgr_substitute.h90"  
+   PUBLIC   interpun, interpvn
+   PUBLIC   interptsn,  interpsshn
+   PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b
+   PUBLIC   interpe3t, interpumsk, interpvmsk
+# if defined key_zdftke
+   PUBLIC   Agrif_tke, interpavm
+# endif
+
+   INTEGER ::   bdy_tinterp = 0
+
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
-   CONTAINS
-   
+CONTAINS
+
    SUBROUTINE 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
+      !!                  ***  ROUTINE Agrif_tra  ***
       !!----------------------------------------------------------------------
       !
       IF( Agrif_Root() )   RETURN
-
-      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztsa ) 
-
-      Agrif_SpecialValue    = 0.e0
+      !
+      Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = .TRUE.
-      ztsa(:,:,:,:) = 0.e0
-
-      CALL Agrif_Bc_variable( ztsa, tsn_id, procname=interptsn )
+      !
+      CALL Agrif_Bc_variable( 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)
+      !
+   END SUBROUTINE Agrif_tra
+
+
+   SUBROUTINE Agrif_dyn( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_DYN  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) ::   kt
+      !
+      INTEGER ::   ji, jj, jk       ! dummy loop indices
+      INTEGER ::   j1, j2, i1, i2
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zub, zvb
+      !!----------------------------------------------------------------------  
+      !
+      IF( Agrif_Root() )   RETURN
+      !
+      CALL wrk_alloc( jpi,jpj,   zub, zvb )
+      !
+      Agrif_SpecialValue    = 0._wp
+      Agrif_UseSpecialValue = ln_spc_dyn
+      !
+      CALL Agrif_Bc_variable( un_interp_id, procname=interpun )
+      CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn )
+      !
+      Agrif_UseSpecialValue = .FALSE.
+      !
+      ! 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
+
+      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
+         !
+         ! Smoothing
+         ! ---------
+         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+            ua_b(2,:) = 0._wp
             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)
+                  ua_b(2,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)
+               END DO
+            END DO
+            DO jj = 1, jpj
+               ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj)            
+            END DO
+         ENDIF
+         !
+         DO jk=1,jpkm1                 ! Smooth
+            DO jj=j1,j2
+               ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk))
+               ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
+            END DO
+         END DO
+         !
+         zub(2,:) = 0._wp              ! Correct transport
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)
+            END DO
+         END DO
+         DO jj=1,jpj
+            zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj)
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk)
+            END DO
+         END DO
+
+         ! Set tangential velocities to time splitting estimate
+         !-----------------------------------------------------
+         IF( ln_dynspg_ts ) THEN
+            zvb(2,:) = 0._wp
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk)
+               END DO
+            END DO
+            DO jj = 1, jpj
+               zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj)
+            END DO
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk)
+               END DO
+            END DO
+         ENDIF
+         !
+         ! Mask domain edges:
+         !-------------------
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               ua(1,jj,jk) = 0._wp
+               va(1,jj,jk) = 0._wp
+            END DO
+         END DO         
+         !
+      ENDIF
+
+      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
+
+         ! Smoothing
+         ! ---------
+         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+            ua_b(nlci-2,:) = 0._wp
+            DO jk=1,jpkm1
+               DO jj=1,jpj
+                  ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk)
+               END DO
+            END DO
+            DO jj=1,jpj
+               ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj)            
+            END DO
+         ENDIF
+
+         DO jk = 1, jpkm1              ! Smooth
+            DO jj = j1, j2
+               ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      &
+                  &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) )
+            END DO
+         END DO
+
+         zub(nlci-2,:) = 0._wp        ! Correct transport
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk)
+            END DO
+         END DO
+         DO jj = 1, jpj
+            zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj)
+         END DO
+
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk)
+            END DO
+         END DO
+         !
+         ! Set tangential velocities to time splitting estimate
+         !-----------------------------------------------------
+         IF( ln_dynspg_ts ) THEN
+            zvb(nlci-1,:) = 0._wp
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk)
+               END DO
+            END DO
+            DO jj=1,jpj
+               zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj)
+            END DO
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk)
+               END DO
+            END DO
+         ENDIF
+         !
+         ! Mask domain edges:
+         !-------------------
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               ua(nlci-1,jj,jk) = 0._wp
+               va(nlci  ,jj,jk) = 0._wp
+            END DO
+         END DO 
+         !
+      ENDIF
+
+      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
+
+         ! Smoothing
+         ! ---------
+         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+            va_b(:,2) = 0._wp
             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
-
-
-   SUBROUTINE Agrif_dyn( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_DYN  ***
-      !!----------------------------------------------------------------------  
-      !! 
-      INTEGER, INTENT(in) ::   kt
-      !!
-      INTEGER :: ji,jj,jk
-      REAL(wp) :: timeref
-      REAL(wp) :: z2dt, znugdt
-      REAL(wp) :: zrhox, zrhoy
-      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, zua2d, zva2d )
-      CALL wrk_alloc( jpi, jpj, jpk, zua, zva )
-
-      zrhox = Agrif_Rhox()
-      zrhoy = Agrif_Rhoy()
-
-      timeref = 1.
-
-      ! time step: leap-frog
-      z2dt = 2. * rdt
-      ! time step: Euler if restart from rest
-      IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt
-      ! coefficients
-      znugdt =  grav * z2dt    
-
-      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 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
-         END DO
-
-         spgu(2,:)=0.
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               spgu(2,jj)=spgu(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk)
-            END DO
-         END DO
-
-         DO jj=1,jpj
-            IF (umask(2,jj,1).NE.0.) THEN
-               spgu(2,jj)=spgu(2,jj)*hur_a(2,jj)
-            ENDIF
-         END DO
-#else
-         spgu(2,:) = ua_b(2,:)
-#endif
-
-         DO jk=1,jpkm1
-            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)
-            END DO
-         END DO
-
-         spgu1(2,:)=0.
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               spgu1(2,jj)=spgu1(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk)
-            END DO
-         END DO
-
-         DO jj=1,jpj
-            IF (umask(2,jj,1).NE.0.) THEN
-               spgu1(2,jj)=spgu1(2,jj)*hur_a(2,jj)
-            ENDIF
-         END DO
-
-         DO jk=1,jpkm1
-            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
-
-#if defined key_dynspg_ts
-         ! Set tangential velocities to time splitting estimate
-         spgv1(2,:)=0.
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               spgv1(2,jj)=spgv1(2,jj)+fse3v_a(2,jj,jk)*va(2,jj,jk)
-            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
-               va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-spgv1(2,jj))*vmask(2,jj,jk)
-            END DO
-         END DO
-#endif
-
-      ENDIF
-
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-#if defined key_dynspg_flt
-         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_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)*hur_a(nlci-2,jj)
-            ENDIF
-         END DO
-#else
-         spgu(nlci-2,:) = ua_b(nlci-2,:)
-#endif
-
-         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))
-
-               ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk)
-
-            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_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)*hur_a(nlci-2,jj)
-            ENDIF
-         END DO
-
-         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
-
-#if defined key_dynspg_ts
-         ! Set tangential velocities to time splitting estimate
-         spgv1(nlci-1,:)=0._wp
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+fse3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk)
-            END DO
-         END DO
-
-         DO jj=1,jpj
-            spgv1(nlci-1,jj)=spgv1(nlci-1,jj)*hvr_a(nlci-1,jj)
-         END DO
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               va(nlci-1,jj,jk) = (va(nlci-1,jj,jk)+va_b(nlci-1,jj)-spgv1(nlci-1,jj))*vmask(nlci-1,jj,jk)
-            END DO
-         END DO
-#endif
-
-      ENDIF
-
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-
-#if defined key_dynspg_flt
-         DO ji=1,jpi
-            laplacv(ji,2) = timeref * (zva2d(ji,2)/(zrhox*e1v(ji,2)))
-         END DO
-#endif
-
+                  va_b(ji,2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk)
+               END DO
+            END DO
+            DO ji=1,jpi
+               va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2)            
+            END DO
+         ENDIF
+         !
+         DO jk = 1, jpkm1              ! Smooth
+            DO ji = i1, i2
+               va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    &
+                  &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) )
+            END DO
+         END DO
+         !
+         zvb(:,2) = 0._wp              ! Correct transport
          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
-               va(ji,2,jk) = (va(ji,2,jk) - z2dt * znugdt * laplacv(ji,2))*vmask(ji,2,jk)
-            END DO
-         END DO
-
-         spgv(:,2)=0.
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               spgv(ji,2)=spgv(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)
-            END DO
-         END DO
-
-         DO ji=1,jpi
-            IF (vmask(ji,2,1).NE.0.) THEN
-               spgv(ji,2)=spgv(ji,2)*hvr_a(ji,2)
-            ENDIF
-         END DO
-#else
-         spgv(:,2)=va_b(:,2)
-#endif
-
-         DO jk=1,jpkm1
-            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)
-            END DO
-         END DO
-
-         spgv1(:,2)=0.
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               spgv1(ji,2)=spgv1(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)
-            END DO
-         END DO
-
-         DO ji=1,jpi
-            IF (vmask(ji,2,1).NE.0.) THEN
-               spgv1(ji,2)=spgv1(ji,2)*hvr_a(ji,2)
-            ENDIF
-         END DO
-
-         DO jk=1,jpkm1
-            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
-
-#if defined key_dynspg_ts
+               zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk)
+            END DO
+         END DO
+         DO ji = 1, jpi
+            zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2)
+         END DO
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk)
+            END DO
+         END DO
+
          ! Set tangential velocities to time splitting estimate
-         spgu1(:,2)=0._wp
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               spgu1(ji,2)=spgu1(ji,2)+fse3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk)
-            END DO
-         END DO
-
-         DO ji=1,jpi
-            spgu1(ji,2)=spgu1(ji,2)*hur_a(ji,2)
-         END DO
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               ua(ji,2,jk) = (ua(ji,2,jk)+ua_b(ji,2)-spgu1(ji,2))*umask(ji,2,jk)
-            END DO
-         END DO
-#endif
-      ENDIF
-
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-
-#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
-               va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)-z2dt * znugdt * laplacv(ji,nlcj-2))*vmask(ji,nlcj-2,jk)
-            END DO
-         END DO
-
-         spgv(:,nlcj-2)=0.
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
-            END DO
-         END DO
-
-         DO ji=1,jpi
-            IF (vmask(ji,nlcj-2,1).NE.0.) THEN
-               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*hvr_a(ji,nlcj-2)
-            ENDIF
-         END DO
-#else
-         spgv(:,nlcj-2)=va_b(:,nlcj-2)
-#endif
-
-         DO jk=1,jpkm1
-            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)
-            END DO
-         END DO
-
-         spgv1(:,nlcj-2)=0.
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
-            END DO
-         END DO
-
-         DO ji=1,jpi
-            IF (vmask(ji,nlcj-2,1).NE.0.) THEN
-               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*hvr_a(ji,nlcj-2)
-            ENDIF
-         END DO
-
-         DO jk=1,jpkm1
-            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
-
-#if defined key_dynspg_ts
+         !-----------------------------------------------------
+         IF( ln_dynspg_ts ) THEN
+            zub(:,2) = 0._wp
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk)
+               END DO
+            END DO
+            DO ji = 1, jpi
+               zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2)
+            END DO
+
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk)
+               END DO
+            END DO
+         ENDIF
+
+         ! Mask domain edges:
+         !-------------------
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               ua(ji,1,jk) = 0._wp
+               va(ji,1,jk) = 0._wp
+            END DO
+         END DO 
+
+      ENDIF
+
+      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
+         !
+         ! Smoothing
+         ! ---------
+         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+            va_b(:,nlcj-2) = 0._wp
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk)
+               END DO
+            END DO
+            DO ji = 1, jpi
+               va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)            
+            END DO
+         ENDIF
+         !
+         DO jk = 1, jpkm1              ! Smooth
+            DO ji = i1, i2
+               va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   &
+                  &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) )
+            END DO
+         END DO
+         !
+         zvb(:,nlcj-2) = 0._wp         ! Correct transport
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk)
+            END DO
+         END DO
+         DO ji = 1, jpi
+            zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)
+         END DO
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk)
+            END DO
+         END DO
+         !
          ! Set tangential velocities to time splitting estimate
-         spgu1(:,nlcj-1)=0._wp
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+fse3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk)
-            END DO
-         END DO
-
-         DO ji=1,jpi
-            spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)*hur_a(ji,nlcj-1)
-         END DO
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               ua(ji,nlcj-1,jk) = (ua(ji,nlcj-1,jk)+ua_b(ji,nlcj-1)-spgu1(ji,nlcj-1))*umask(ji,nlcj-1,jk)
-            END DO
-         END DO
-#endif
-
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d )
-      CALL wrk_dealloc( jpi, jpj, jpk, zua, zva )
+         !-----------------------------------------------------
+         IF( ln_dynspg_ts ) THEN
+            zub(:,nlcj-1) = 0._wp
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk)
+               END DO
+            END DO
+            DO ji = 1, jpi
+               zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1)
+            END DO
+            !
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk)
+               END DO
+            END DO
+         ENDIF
+         !
+         ! Mask domain edges:
+         !-------------------
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               ua(ji,nlcj  ,jk) = 0._wp
+               va(ji,nlcj-1,jk) = 0._wp
+            END DO
+         END DO 
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,   zub, zvb )
       !
    END SUBROUTINE Agrif_dyn
+
 
    SUBROUTINE Agrif_dyn_ts( jn )
@@ -614,52 +391,53 @@
       INTEGER :: ji, jj
       !!----------------------------------------------------------------------  
-
+      !
       IF( Agrif_Root() )   RETURN
-
+      !
       IF((nbondi == -1).OR.(nbondi == 2)) THEN
          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)) )
-         END DO
-      ENDIF
-
+            ! 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
+      !
       IF((nbondi == 1).OR.(nbondi == 2)) THEN
          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)) )
-         END DO
-      ENDIF
-
+            ! 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
+      !
       IF((nbondj == -1).OR.(nbondj == 2)) THEN
          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)) )
-         END DO
-      ENDIF
-
+            ! 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
+      !
       IF((nbondj == 1).OR.(nbondj == 2)) THEN
          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
       !
    END SUBROUTINE Agrif_dyn_ts
+
 
    SUBROUTINE Agrif_dta_ts( kt )
@@ -672,376 +450,750 @@
       INTEGER :: ji, jj
       LOGICAL :: ll_int_cons
-      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
-      !!----------------------------------------------------------------------  
-
+      REAL(wp) :: zrhot, zt
+      !!----------------------------------------------------------------------  
+      !
       IF( Agrif_Root() )   RETURN
-
-      ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in
-                             ! the forward case only
-
-      zrhox = Agrif_Rhox()
-      zrhoy = Agrif_Rhoy()
+      !
+      ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in the forward case only
+      !
       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:
-      IF (ln_bt_fw) THEN
-         zt = REAL(Agrif_NbStepint()+0.5_wp,wp) / zrhot
+      IF( ln_bt_fw ) THEN
+         zt = REAL( Agrif_NbStepint()+0.5_wp, wp ) / zrhot
       ELSE
-         zt = REAL(Agrif_NbStepint(),wp) / zrhot
-      ENDIF
-
+         zt = REAL( Agrif_NbStepint()       , wp ) / zrhot
+      ENDIF
+      !
       ! Linear interpolation of sea level
-      Agrif_SpecialValue    = 0.e0
+      Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = .TRUE.
-      CALL Agrif_Bc_variable(zsshn, sshn_id,calledweight=zt, procname=interpsshn )
+      CALL Agrif_Bc_variable( sshn_id, calledweight=zt, procname=interpsshn )
       Agrif_UseSpecialValue = .FALSE.
-
+      !
       ! Interpolate barotropic fluxes
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = ln_spc_dyn
-
-      IF (ll_int_cons) THEN ! Conservative interpolation
-         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)
-         
+      !
+      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  )         
+      ELSE ! Linear interpolation
+         bdy_tinterp = 0
+         ubdy_w(:) = 0._wp   ;   vbdy_w(:) = 0._wp 
+         ubdy_e(:) = 0._wp   ;   vbdy_e(:) = 0._wp 
+         ubdy_n(:) = 0._wp   ;   vbdy_n(:) = 0._wp 
+         ubdy_s(:) = 0._wp   ;   vbdy_s(:) = 0._wp
+         CALL Agrif_Bc_variable( unb_id, calledweight=zt, procname=interpunb )
+         CALL Agrif_Bc_variable( vnb_id, calledweight=zt, procname=interpvnb )
+      ENDIF
+      Agrif_UseSpecialValue = .FALSE.
+      ! 
+   END SUBROUTINE Agrif_dta_ts
+
+
+   SUBROUTINE Agrif_ssh( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_DYN  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) ::   kt
+      !!
+      !!----------------------------------------------------------------------  
+      !
+      IF( Agrif_Root() )   RETURN
+      !
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         ssha(2,:)=ssha(3,:)
+         sshn(2,:)=sshn(3,:)
+      ENDIF
+      !
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         ssha(nlci-1,:)=ssha(nlci-2,:)
+         sshn(nlci-1,:)=sshn(nlci-2,:)
+      ENDIF
+      !
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         ssha(:,2)=ssha(:,3)
+         sshn(:,2)=sshn(:,3)
+      ENDIF
+      !
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         ssha(:,nlcj-1)=ssha(:,nlcj-2)
+         sshn(:,nlcj-1)=sshn(:,nlcj-2)
+      ENDIF
+      !
+   END SUBROUTINE Agrif_ssh
+
+
+   SUBROUTINE Agrif_ssh_ts( jn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_ssh_ts  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) ::   jn
+      !!
+      INTEGER :: ji,jj
+      !!----------------------------------------------------------------------  
+      !
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         DO jj = 1, jpj
+            ssha_e(2,jj) = hbdy_w(jj)
+         END DO
+      ENDIF
+      !
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         DO jj = 1, jpj
+            ssha_e(nlci-1,jj) = hbdy_e(jj)
+         END DO
+      ENDIF
+      !
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         DO ji = 1, jpi
+            ssha_e(ji,2) = hbdy_s(ji)
+         END DO
+      ENDIF
+      !
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         DO ji = 1, jpi
+            ssha_e(ji,nlcj-1) = hbdy_n(ji)
+         END DO
+      ENDIF
+      !
+   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._wp ) 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._wp ) 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
+               tsa(nlci,j1:j2,k1:k2,jn) = 0._wp
+            END DO
+         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._wp ) 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._wp ) 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
+               tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp
+            END DO
+         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._wp ) 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._wp ) 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
+               tsa(1,j1:j2,k1:k2,jn) = 0._wp
+            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._wp ) 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._wp ) 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
+               tsa(i1:i2,1,k1:k2,jn) = 0._wp
+            END DO
+         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 )
+      !!----------------------------------------------------------------------
+      !!                  ***  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
+      !
+   END SUBROUTINE interpsshn
+
+
+   SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!----------------------------------------------------------------------
+      !!   *** ROUTINE interpun ***
+      !!----------------------------------------------------------------------
+      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) ::   zrhoy	
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN 
+         DO jk = k1, jpk
+            ptab(i1:i2,j1:j2,jk) = e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk)
+         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) * e3u_n(i1:i2,jj,jk) )
+            END DO
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE interpun
+
+
+   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
+            ptab(i1:i2,j1:j2,jk) = e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) * vn(i1:i2,j1:j2,jk)
+         END DO
+      ELSE          
+         zrhox= Agrif_Rhox()
+         DO jk = 1, jpkm1
+            va(i1:i2,j1:j2,jk) = ptab(i1:i2,j1:j2,jk) / ( zrhox * e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) )
+         END DO
+      ENDIF
+      !        
+   END SUBROUTINE interpvn
+   
+
+   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 
+         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * un_b(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)
+         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  ***
+      !!----------------------------------------------------------------------  
+      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) ::   zrhox, zrhot, zt0, zt1, ztcoeff   
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      ! 
+      IF( before ) THEN 
+         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * vn_b(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)
+         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
+      !
+   END SUBROUTINE interpvnb
+
+
+   SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before, nb, ndir )
+      !!----------------------------------------------------------------------
+      !!                  ***  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
+      !
+      INTEGER  ::   ji,jj
+      REAL(wp) ::   zrhot, zt0, zt1,zat
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      IF( before ) THEN
+         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(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)
+         zrhot = Agrif_rhot()
          ! 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
-         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
-
-   SUBROUTINE Agrif_ssh( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_DYN  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) ::   kt
-      !!
-      !!----------------------------------------------------------------------  
-
-      IF( Agrif_Root() )   RETURN
-
-
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         ssha(2,:)=ssha(3,:)
-         sshn(2,:)=sshn(3,:)
-      ENDIF
-
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         ssha(nlci-1,:)=ssha(nlci-2,:)
-         sshn(nlci-1,:)=sshn(nlci-2,:)        
-      ENDIF
-
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         ssha(:,2)=ssha(:,3)
-         sshn(:,2)=sshn(:,3)
-      ENDIF
-
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         ssha(:,nlcj-1)=ssha(:,nlcj-2)
-         sshn(:,nlcj-1)=sshn(:,nlcj-2)                
-      ENDIF
-
-   END SUBROUTINE Agrif_ssh
-
-   SUBROUTINE Agrif_ssh_ts( jn )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_ssh_ts  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) ::   jn
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-            ssha_e(2,jj) = hbdy_w(jj)
-         END DO
-      ENDIF
-
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-            ssha_e(nlci-1,jj) = hbdy_e(jj)
-         END DO
-      ENDIF
-
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-            ssha_e(ji,2) = hbdy_s(ji)
-         END DO
-      ENDIF
-
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-            ssha_e(ji,nlcj-1) = hbdy_n(ji)
-         END DO
-      ENDIF
-
-   END SUBROUTINE Agrif_ssh_ts
-
-   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) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      tabres(i1:i2,j1:j2) = sshn(i1:i2,j1:j2)
-
-   END SUBROUTINE interpsshn
-
-   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) :: tabres
-      !!
-      INTEGER :: ji,jj,jk
-      !!----------------------------------------------------------------------  
-
-      DO jk=k1,k2
-         DO jj=j1,j2
-            DO ji=i1,i2
-               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) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      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
-      !!
+         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
+      ! 
+   END SUBROUTINE interpub2b
+   
+
+   SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before, nb, ndir )
+      !!----------------------------------------------------------------------
+      !!                  ***  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
+      !
+      INTEGER ::   ji,jj
+      REAL(wp) ::   zrhot, zt0, zt1,zat
+      LOGICAL ::   western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      !
+      IF( before ) THEN
+         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(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)
+         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
+      !      
+   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                              , INTENT(in   ) :: before
+      INTEGER                              , INTENT(in   ) :: nb , ndir
+      !
       INTEGER :: ji, jj, jk
-      !!----------------------------------------------------------------------  
-
-      DO jk=k1,k2
-         DO jj=j1,j2
-            DO ji=i1,i2
-               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(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpub2b  ***
-      !!----------------------------------------------------------------------  
-      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) = ub2_b(ji,jj) * e2u(ji,jj)
-         END DO
-      END DO
-
-   END SUBROUTINE interpub2b
-
-   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) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      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
+      LOGICAL :: western_side, eastern_side, northern_side, southern_side
+      REAL(wp) :: ztmpmsk      
+      !!----------------------------------------------------------------------  
+      !    
+      IF( before ) THEN
+         ptab(i1:i2,j1:j2,k1:k2) = tmask(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2)
+      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), e3t(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                              , INTENT(in   ) ::   before
+      INTEGER                              , INTENT(in   ) ::   nb , ndir
+      !
+      INTEGER ::   ji, jj, jk
+      LOGICAL ::   western_side, eastern_side   
+      !!----------------------------------------------------------------------  
+      !    
+      IF( before ) THEN
+         ptab(i1:i2,j1:j2,k1:k2) = umask(i1:i2,j1:j2,k1:k2)
+      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                              , INTENT(in   ) ::   before
+      INTEGER                              , INTENT(in   ) :: nb , ndir
+      !
+      INTEGER ::   ji, jj, jk
+      LOGICAL ::   northern_side, southern_side     
+      !!----------------------------------------------------------------------  
+      !    
+      IF( before ) THEN
+         ptab(i1:i2,j1:j2,k1:k2) = vmask(i1:i2,j1:j2,k1:k2)
+      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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 6808)
@@ -1,5 +1,11 @@
 #define SPONGE && define SPONGE_TOP
 
-Module agrif_opa_sponge
+MODULE agrif_opa_sponge
+   !!======================================================================
+   !!                ***  MODULE agrif_opa_update  ***
+   !! AGRIF :   
+   !!======================================================================
+   !! History :  
+   !!----------------------------------------------------------------------
 #if defined key_agrif  && ! defined key_offline
    USE par_oce
@@ -9,19 +15,18 @@
    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, interptsn, interpun, interpvn
-
-  !! * Substitutions
-#  include "domzgr_substitute.h90"
+   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn
+   PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge
+
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
-   CONTAINS
+CONTAINS
 
    SUBROUTINE Agrif_Sponge_Tra
@@ -29,153 +34,49 @@
       !!   *** ROUTINE Agrif_Sponge_Tra ***
       !!---------------------------------------------
-      !!
-      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.
-      ztab = 0.e0
-      CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn)
+      tabspongedone_tsn = .FALSE.
+
+      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge)
+
       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
-
+      !
    END SUBROUTINE Agrif_Sponge_Tra
 
+
    SUBROUTINE Agrif_Sponge_dyn
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Sponge_dyn ***
       !!---------------------------------------------
-      !!
-      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
-      ztab = 0.e0
-      CALL Agrif_Bc_Variable(ztab, ua_id,calledweight=timecoeff,procname=interpun)
+
+      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)
+
       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
-
+      !
    END SUBROUTINE Agrif_Sponge_dyn
+
 
    SUBROUTINE Agrif_Sponge
@@ -199,11 +100,10 @@
          CALL wrk_alloc( jpi, jpj, ztabramp )
 
-         ispongearea  = 2 + 2 * Agrif_irhox()
+         ispongearea  = 2 + nn_sponge_len * Agrif_irhox()
          ilci = nlci - ispongearea
          ilcj = nlcj - ispongearea 
          z1spongearea = 1._wp / REAL( ispongearea - 2 )
-         spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
-
-         ztabramp(:,:) = 0.
+
+         ztabramp(:,:) = 0._wp
 
          IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
@@ -254,54 +154,15 @@
       ! Tracers
       IF( .NOT. spongedoneT ) THEN
-         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
+         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. )
          spongedoneT = .TRUE.
       ENDIF
@@ -309,44 +170,17 @@
       ! Dynamics
       IF( .NOT. spongedoneU ) THEN
-         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
+         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. )
          spongedoneU = .TRUE.
-         spbtr3(:,:) = 1. / ( e1f(:,:) * e2f(:,:) )
       ENDIF
       !
@@ -354,43 +188,254 @@
       !
 #endif
-
+      !
    END SUBROUTINE Agrif_Sponge
 
-   SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
-      !!---------------------------------------------
-      !!   *** ROUTINE interptsn ***
+
+   SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptsn_sponge ***
       !!---------------------------------------------
       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
-
-      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 ***
-      !!---------------------------------------------
+      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) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)
+                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_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) )
+                  END DO
+               END DO
+               !
+               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 )   ztu(ji,jj,jk) = 0._wp
+                        IF( ikv == jk )   ztv(ji,jj,jk) = 0._wp
+                     END DO
+                  END DO
+               ENDIF
+            END DO
+            !
+            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_e1e2t(ji,jj) / e3t_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
+                  END DO
+               END DO
+            END DO
+            !
+         END DO
+         !
+         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 ***
+      !!---------------------------------------------    
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-
-      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 ***
-      !!---------------------------------------------
+      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_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
+                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*e3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) &
+                                     &   -e2u(ji-1,jj)*e3u_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_e1e2f(ji,jj) * e3f_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
+         END DO
+         !
+         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) * e3u_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) * e3v_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 ***
+      !!--------------------------------------------- 
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-
-      tabres(i1:i2,j1:j2,k1:k2) = vn(i1:i2,j1:j2,k1:k2)
-
-   END SUBROUTINE interpvn
+      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_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
+                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  &
+                                     &  -e1v(ji,jj-1) * e3v_n(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_e1e2f(ji,jj) * e3f_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
+         END DO
+
+         !                                                ! ===============
+         !                                                
+
+         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
+                     ua(ji,jj,jk) = ua(ji,jj,jk)                                                               &
+                        & - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )  &
+                        & + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk)) * r1_e1u(ji,jj)
+                  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
+                     va(ji,jj,jk) = va(ji,jj,jk)                                                                  &
+                        &  + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   &
+                        &  + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) * r1_e2v(ji,jj)
+                  END DO
+               ENDIF
+            END DO
+         END DO
+         tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+      ENDIF
+      !
+   END SUBROUTINE interpvn_sponge
 
 #else
 CONTAINS
-
    SUBROUTINE agrif_opa_sponge_empty
       !!---------------------------------------------
@@ -401,3 +446,4 @@
 #endif
 
+   !!======================================================================
 END MODULE agrif_opa_sponge
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 6808)
@@ -1,4 +1,5 @@
-#define TWO_WAY
-
+#define TWO_WAY        /* TWO WAY NESTING */
+#undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/
+ 
 MODULE agrif_opa_update
 #if defined key_agrif  && ! defined key_offline
@@ -10,115 +11,168 @@
    USE lib_mpp
    USE wrk_nemo  
-   USE dynspg_oce
+   USE zdf_oce        ! vertical physics: ocean variables 
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn
-
-   INTEGER, PUBLIC :: nbcline = 0
-
+   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales
+# if defined key_zdftke
+   PUBLIC Agrif_Update_Tke
+# endif
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.6 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
-   SUBROUTINE Agrif_Update_Tra( kt )
+   RECURSIVE SUBROUTINE Agrif_Update_Tra( )
       !!---------------------------------------------
       !!   *** 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
+
+      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
+      !
+      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
+      !
+#endif
+      !
+   END SUBROUTINE Agrif_Update_Tra
+
+
+   RECURSIVE SUBROUTINE Agrif_Update_Dyn( )
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Update_Dyn ***
+      !!---------------------------------------------
+      ! 
+      IF (Agrif_Root()) 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.
+      !     
+      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 ( ln_dynspg_ts.AND.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
+         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
+         ENDIF
+      END IF
+      !
+      nbcline = nbcline + 1
+      !
+      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
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+      ! 
+#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 ***
       !!---------------------------------------------
       !!
       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 )
+      !       
+      IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN
+#  if defined TWO_WAY
 
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
 
-      IF (MOD(nbcline,nbclineupdate) == 0) THEN
-         CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS)
-      ELSE
-         CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS)
-      ENDIF
+      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.
 
-      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab )
-#endif
-
-   END SUBROUTINE Agrif_Update_Tra
-
-   SUBROUTINE Agrif_Update_Dyn( kt )
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_Update_Dyn ***
-      !!---------------------------------------------
-      !!
-      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
-      CALL wrk_alloc( jpi, jpj,      ztab2d )
-      CALL wrk_alloc( jpi, jpj, jpk, ztab   )
-
-      IF (mod(nbcline,nbclineupdate) == 0) THEN
-         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
-            CALL Agrif_Update_Variable(ztab2d,ub2b_id,procname = updateub2b)
-            CALL Agrif_Update_Variable(ztab2d,vb2b_id,procname = updatevb2b)
-         ELSE
-            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
-
-      nbcline = nbcline + 1
-
-      Agrif_UseSpecialValueInUpdate = .TRUE. 
-      Agrif_SpecialValueFineGrid = 0.
-      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
-
-   END SUBROUTINE Agrif_Update_Dyn
-
-   SUBROUTINE recompute_diags( kt )
-      !!---------------------------------------------
-      !!   *** ROUTINE recompute_diags ***
-      !!---------------------------------------------
-      INTEGER, INTENT(in) :: kt
-
-   END SUBROUTINE recompute_diags
+#  endif
+      
+   END SUBROUTINE Agrif_Update_Tke
+   
+# endif /* key_zdftke */
 
    SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
@@ -126,12 +180,11 @@
       !!           *** 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
-
+      LOGICAL, INTENT(in) :: before
+      !!
       INTEGER :: ji,jj,jk,jn
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          DO jn = n1,n2
@@ -146,5 +199,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
@@ -153,6 +206,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
@@ -161,5 +214,4 @@
             ENDDO
          ENDIF
-
          DO jn = n1,n2
             DO jk=k1,k2
@@ -174,40 +226,34 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updateTS
 
+
    SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before )
       !!---------------------------------------------
       !!           *** ROUTINE updateu ***
       !!---------------------------------------------
-#  include "domzgr_substitute.h90"
-
-      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      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
+      LOGICAL                               , INTENT(in   ) :: before
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zrhoy
+      !!---------------------------------------------
+      ! 
+      IF( before ) THEN
          zrhoy = Agrif_Rhoy()
+         DO jk = k1, k2
+            tabres(i1:i2,j1:j2,jk) = zrhoy * e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk)
+         END DO
+      ELSE
          DO jk=k1,k2
             DO jj=j1,j2
                DO ji=i1,i2
-                  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
-         tabres = zrhoy * tabres
-      ELSE
-         DO jk=k1,k2
-            DO jj=j1,j2
-               DO ji=i1,i2
-                  tabres(ji,jj,jk) = tabres(ji,jj,jk) / e2u(ji,jj) / fse3u_n(ji,jj,jk)
+                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk)
                   !
                   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
                   !
@@ -217,20 +263,20 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updateu
 
+
    SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before )
       !!---------------------------------------------
       !!           *** ROUTINE updatev ***
       !!---------------------------------------------
-#  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()
@@ -238,19 +284,17 @@
             DO jj=j1,j2
                DO ji=i1,i2
-                  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
-         tabres = zrhox * tabres
+                  tabres(ji,jj,jk) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk)
+               END DO
+            END DO
+         END DO
       ELSE
          DO jk=k1,k2
             DO jj=j1,j2
                DO ji=i1,i2
-                  tabres(ji,jj,jk) = tabres(ji,jj,jk) / e1v(ji,jj) / fse3v_n(ji,jj,jk)
+                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e1v(ji,jj) / e3v_n(ji,jj,jk)
                   !
                   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
                   !
@@ -260,40 +304,39 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updatev
 
+
    SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before )
       !!---------------------------------------------
       !!          *** ROUTINE updateu2d ***
       !!---------------------------------------------
-#  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()
          DO jj=j1,j2
             DO ji=i1,i2
-               tabres(ji,jj) = un_b(ji,jj) * hu(ji,jj) * e2u(ji,jj)
-            END DO
-         END DO
-         tabres = zrhoy * tabres
-      ELSE
-         DO jj=j1,j2
-            DO ji=i1,i2
-               tabres(ji,jj) =  tabres(ji,jj) * hur(ji,jj) / e2u(ji,jj)  
+               tabres(ji,jj) = zrhoy * un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj)
+            END DO
+         END DO
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) =  tabres(ji,jj) * r1_hu_n(ji,jj) * r1_e2u(ji,jj)  
                !    
                ! Update "now" 3d velocities:
-               spgu(ji,jj) = 0.e0
+               spgu(ji,jj) = 0._wp
                DO jk=1,jpkm1
-                  spgu(ji,jj) = spgu(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk)
-               END DO
-               spgu(ji,jj) = spgu(ji,jj) * hur(ji,jj)
+                  spgu(ji,jj) = spgu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk)
+               END DO
+               spgu(ji,jj) = spgu(ji,jj) * r1_hu_n(ji,jj)
                !
                zcorr = tabres(ji,jj) - spgu(ji,jj)
@@ -303,10 +346,10 @@
                !
                ! Update barotropic velocities:
-#if defined key_dynspg_ts
-               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
-                  zcorr = tabres(ji,jj) - un_b(ji,jj)
-                  ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1)
-               END IF
-#endif               
+               IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN
+                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
+                     zcorr = tabres(ji,jj) - un_b(ji,jj)
+                     ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1)
+                  END IF
+               ENDIF             
                un_b(ji,jj) = tabres(ji,jj) * umask(ji,jj,1)
                !       
@@ -314,7 +357,7 @@
                spgu(ji,jj) = 0.e0
                DO jk=1,jpkm1
-                  spgu(ji,jj) = spgu(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk)
-               END DO
-               spgu(ji,jj) = spgu(ji,jj) * hur_b(ji,jj)
+                  spgu(ji,jj) = spgu(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk)
+               END DO
+               spgu(ji,jj) = spgu(ji,jj) * r1_hu_b(ji,jj)
                !
                zcorr = ub_b(ji,jj) - spgu(ji,jj)
@@ -326,39 +369,39 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE updateu2d
 
+
    SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before )
       !!---------------------------------------------
       !!          *** 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()
          DO jj=j1,j2
             DO ji=i1,i2
-               tabres(ji,jj) = vn_b(ji,jj) * hv(ji,jj) * e1v(ji,jj) 
-            END DO
-         END DO
-         tabres = zrhox * tabres
-      ELSE
-         DO jj=j1,j2
-            DO ji=i1,i2
-               tabres(ji,jj) =  tabres(ji,jj) * hvr(ji,jj) / e1v(ji,jj)  
+               tabres(ji,jj) = zrhox * vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 
+            END DO
+         END DO
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) =  tabres(ji,jj) * r1_hv_n(ji,jj) * r1_e1v(ji,jj)  
                !    
                ! Update "now" 3d velocities:
                spgv(ji,jj) = 0.e0
                DO jk=1,jpkm1
-                  spgv(ji,jj) = spgv(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk)
-               END DO
-               spgv(ji,jj) = spgv(ji,jj) * hvr(ji,jj)
+                  spgv(ji,jj) = spgv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk)
+               END DO
+               spgv(ji,jj) = spgv(ji,jj) * r1_hv_n(ji,jj)
                !
                zcorr = tabres(ji,jj) - spgv(ji,jj)
@@ -368,10 +411,10 @@
                !
                ! Update barotropic velocities:
-#if defined key_dynspg_ts
-               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
-                  zcorr = tabres(ji,jj) - vn_b(ji,jj)
-                  vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1)
-               END IF
-#endif               
+               IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN
+                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
+                     zcorr = tabres(ji,jj) - vn_b(ji,jj)
+                     vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1)
+                  END IF
+               ENDIF              
                vn_b(ji,jj) = tabres(ji,jj) * vmask(ji,jj,1)
                !       
@@ -379,7 +422,7 @@
                spgv(ji,jj) = 0.e0
                DO jk=1,jpkm1
-                  spgv(ji,jj) = spgv(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk)
-               END DO
-               spgv(ji,jj) = spgv(ji,jj) * hvr_b(ji,jj)
+                  spgv(ji,jj) = spgv(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk)
+               END DO
+               spgv(ji,jj) = spgv(ji,jj) * r1_hv_b(ji,jj)
                !
                zcorr = vb_b(ji,jj) - spgv(ji,jj)
@@ -391,19 +434,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
@@ -413,83 +456,191 @@
          END DO
       ELSE
-
-#if ! defined key_dynspg_ts
-         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
+         IF( .NOT.ln_dynspg_ts .OR. ( ln_dynspg_ts .AND. .NOT.ln_bt_fw ) ) THEN
+            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)
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+         !
+         DO jj=j1,j2
+            DO ji=i1,i2
+               sshn(ji,jj) = tabres(ji,jj) * tmask(ji,jj,1)
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE updateSSH
+
+
+   SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before )
+      !!---------------------------------------------
+      !!          *** 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()
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) = ub2_i_b(ji,jj) * e2u(ji,jj)
+            END DO
+         END DO
+         tabres = zrhoy * tabres
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               ub2_b(ji,jj) = tabres(ji,jj) / e2u(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE updateub2b
+
+
+   SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before )
+      !!---------------------------------------------
+      !!          *** 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()
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) = vb2_i_b(ji,jj) * e1v(ji,jj) 
+            END DO
+         END DO
+         tabres = zrhox * tabres
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               vb2_b(ji,jj) = tabres(ji,jj) / e1v(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE updatevb2b
+
+
+   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before )
+      ! currently not used
+      !!---------------------------------------------
+      !!           *** ROUTINE updateT ***
+      !!---------------------------------------------
+      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
-                sshb(ji,jj) =   sshb(ji,jj) &
-                 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)
-               END DO
-            END DO
-         ENDIF
-#endif
-         DO jj=j1,j2
-            DO ji=i1,i2
-               sshn(ji,jj) = tabres(ji,jj) * tmask(ji,jj,1)
-            END DO
-         END DO
-      ENDIF
-
-   END SUBROUTINE updateSSH
-
-   SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before )
-      !!---------------------------------------------
-      !!          *** 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()
-         DO jj=j1,j2
-            DO ji=i1,i2
-               tabres(ji,jj) = ub2_i_b(ji,jj) * e2u(ji,jj)
-            END DO
-         END DO
-         tabres = zrhoy * tabres
-      ELSE
-         DO jj=j1,j2
-            DO ji=i1,i2
-               ub2_b(ji,jj) = tabres(ji,jj) / e2u(ji,jj)
-            END DO
-         END DO
-      ENDIF
-
-   END SUBROUTINE updateub2b
-
-   SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before )
-      !!---------------------------------------------
-      !!          *** 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()
-         DO jj=j1,j2
-            DO ji=i1,i2
-               tabres(ji,jj) = vb2_i_b(ji,jj) * e1v(ji,jj) 
-            END DO
-         END DO
-         tabres = zrhox * tabres
-      ELSE
-         DO jj=j1,j2
-            DO ji=i1,i2
-               vb2_b(ji,jj) = tabres(ji,jj) / e1v(ji,jj)
-            END DO
-         END DO
-      ENDIF
-
-   END SUBROUTINE updatevb2b
+                  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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 6808)
@@ -4,7 +4,7 @@
    USE oce
    USE dom_oce      
-   USE sol_oce
    USE agrif_oce
    USE agrif_top_sponge
+   USE par_trc
    USE trc
    USE lib_mpp
@@ -14,128 +14,173 @@
    PRIVATE
 
-   PUBLIC Agrif_trc
+   PUBLIC Agrif_trc, interptrn
 
-#  include "domzgr_substitute.h90"  
 #  include "vectopt_loop_substitute.h90"
   !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.6 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
-   CONTAINS
+CONTAINS
 
    SUBROUTINE 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
+      !!                  ***  ROUTINE Agrif_trc  ***
       !!----------------------------------------------------------------------
       !
       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( ztra, trn_id, procname=interptrn )
+      CALL Agrif_Bc_variable( trn_id, procname=interptrn )
       Agrif_UseSpecialValue = .FALSE.
+      !
+   END SUBROUTINE Agrif_trc
 
-      zrhox = Agrif_Rhox()
 
-      alpha1 = ( zrhox - 1. ) * 0.5
-      alpha2 = 1. - alpha1
+   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
 
-      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)
+      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
                      ENDIF
-                  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
                END DO
             END DO
-         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
+         !
+         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
                      ENDIF
-                  ENDIF
+                  END DO
                END DO
-            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
+            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
+         !
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )
-      !
-
-   END SUBROUTINE Agrif_trc
+   END SUBROUTINE interptrn
 
 #else
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 6808)
@@ -1,13 +1,26 @@
 #define SPONGE_TOP
 
-Module agrif_top_sponge
+MODULE agrif_top_sponge
+   !!======================================================================
+   !!                ***  MODULE agrif_top_sponge  ***
+   !! AGRIF :   define in memory AGRIF variables for sea-ice
+   !!======================================================================
+   !! History :  2.0  ! 2006-08  (R. Benshila, L. Debreu)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   Agrif_Sponge_trc : 
+   !!   interptrn_sponge :  
+   !!----------------------------------------------------------------------
 #if defined key_agrif && defined key_top
    USE par_oce
+   USE par_trc
    USE oce
+   USE trc
    USE dom_oce
-   USE in_out_manager
    USE agrif_oce
    USE agrif_opa_sponge
-   USE trc
+   !
+   USE in_out_manager
    USE lib_mpp
    USE wrk_nemo  
@@ -16,97 +29,89 @@
    PRIVATE
 
-   PUBLIC Agrif_Sponge_Trc, interptrn
+   PUBLIC Agrif_Sponge_trc, interptrn_sponge
 
-  !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
+CONTAINS
 
-   CONTAINS
+   SUBROUTINE Agrif_Sponge_trc
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE Agrif_Sponge_Trc ***
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   timecoeff
+      !!----------------------------------------------------------------------
+      !
+#if defined SPONGE_TOP
+      timecoeff = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot()
+      CALL Agrif_sponge
+      Agrif_SpecialValue    = 0._wp
+      Agrif_UseSpecialValue = .TRUE.
+      tabspongedone_trn     = .FALSE.
+      CALL Agrif_Bc_Variable( trn_sponge_id, calledweight=timecoeff, procname=interptrn_sponge )
+      Agrif_UseSpecialValue = .FALSE.
+#endif
+      !
+   END 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()
-
-      Agrif_SpecialValue=0.
-      Agrif_UseSpecialValue = .TRUE.
-      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
+   SUBROUTINE interptrn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE interptrn_sponge ***
+      !!----------------------------------------------------------------------
+      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
+      REAL(wp) ::   zabe1, zabe2
+      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      
+!!gm line below use of :,:  versus i1:i2,j1:j2  ....   strange, not wrong.    ===>> to be corrected
+         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) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk)
+                     zabe2 = fsaht_spv(ji,jj) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(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) )
+                  END DO
+               END DO
+               !
+               DO jj = j1+1,j2-1
+                  DO ji = i1+1,i2-1
+                     IF( .NOT. tabspongedone_trn(ji,jj) ) THEN 
+                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + (  ztu(ji,jj) - ztu(ji-1,jj  )     &
+                           &                                   + ztv(ji,jj) - ztv(ji  ,jj-1)  )  &
+                           &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                     ENDIF
+                  END DO
                END DO
             END DO
             !
-         ENDDO
-      ENDDO
- 
-      CALL wrk_dealloc( jpi, jpj, ztru, ztrv )
-      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr )
-
-#endif
-
-   END SUBROUTINE Agrif_Sponge_Trc
-
-   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
-      !!---------------------------------------------
-      !!   *** 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
-      !
-      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
-
-   END SUBROUTINE interptrn
+         END DO
+         !
+         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+      ENDIF
+      !                 
+   END SUBROUTINE interptrn_sponge
 
 #else
+
 CONTAINS
-
    SUBROUTINE agrif_top_sponge_empty
-      !!---------------------------------------------
-      !!   *** ROUTINE agrif_top_sponge_empty ***
-      !!---------------------------------------------
       WRITE(*,*)  'agrif_top_sponge : You should not have seen this print! error?'
    END SUBROUTINE agrif_top_sponge_empty
 #endif
 
+   !!======================================================================
 END MODULE agrif_top_sponge
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 6808)
@@ -1,12 +1,20 @@
 #define TWO_WAY
+#undef DECAL_FEEDBACK
 
 MODULE agrif_top_update
+   !!======================================================================
+   !!                ***  MODULE agrif_top_update  ***
+   !! AGRIF :   
+   !!----------------------------------------------------------------------
+   !! History :  
+   !!----------------------------------------------------------------------
 
 #if defined key_agrif && defined key_top
    USE par_oce
    USE oce
+   USE par_trc
+   USE trc
    USE dom_oce
    USE agrif_oce
-   USE trc
    USE wrk_nemo  
 
@@ -16,96 +24,89 @@
    PUBLIC Agrif_Update_Trc
 
-   INTEGER, PUBLIC :: nbcline_trc = 0
+   INTEGER, PUBLIC ::   nbcline_trc = 0   !: ???
 
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
-   CONTAINS
+CONTAINS
 
    SUBROUTINE Agrif_Update_Trc( kt )
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_Update_Trc ***
-      !!---------------------------------------------
-      !!
-      INTEGER, INTENT(in) :: kt
-      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 )
-
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE Agrif_Update_Trc ***
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt
+      !!----------------------------------------------------------------------
+      ! 
+      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
+#if defined TWO_WAY   
       Agrif_UseSpecialValueInUpdate = .TRUE.
-      Agrif_SpecialValueFineGrid = 0.
- 
-     IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN
-         CALL Agrif_Update_Variable(ztra,trn_id, procname=updateTRC)
+      Agrif_SpecialValueFineGrid    = 0._wp
+      ! 
+      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
       ELSE
-         CALL Agrif_Update_Variable(ztra,trn_id,locupdate=(/0,2/), procname=updateTRC)
+# 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
       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(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
-      !!---------------------------------------------
-      !!   *** ROUTINE UpdateTrc ***
-      !!---------------------------------------------
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
-      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
+   SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )
+      !!----------------------------------------------------------------------
+      !!                      *** ROUTINE updateT ***
+      !!----------------------------------------------------------------------
+      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
+      LOGICAL                                    , INTENT(in   ) ::   before
+      !!
+      INTEGER ::   ji, jj, jk, jn
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN
+         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      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
-                        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( 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)
+                        IF( ptab(ji,jj,jk,jn) /= 0._wp ) 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)
                         ENDIF
-                     ENDDO
-                  ENDDO
-               ENDDO
-            ENDDO
+                     END DO
+                  END DO
+               END DO
+            END DO
          ENDIF
-
+         DO jn = n1, n2
+            DO jk = k1, k2
+               DO jj = j1, j2
+                  DO ji = i1, i2
+                     IF( ptab(ji,jj,jk,jn) /= 0._wp ) 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
 
@@ -119,3 +120,5 @@
    END SUBROUTINE agrif_top_update_empty
 #endif
-END Module agrif_top_update
+
+   !!======================================================================
+END MODULE agrif_top_update
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 6808)
@@ -1,5 +1,5 @@
 #if defined key_agrif
 !!----------------------------------------------------------------------
-!! NEMO/NST 3.4 , NEMO Consortium (2012)
+!! NEMO/NST 3.7 , NEMO Consortium (2015)
 !! $Id$
 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
@@ -17,5 +17,4 @@
    USE par_oce
    USE dom_oce
-   USE Agrif_Util
    USE nemogcm
    !
@@ -31,5 +30,9 @@
       jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
       jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
-      jpk     = jpkdta 
+! 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 
       jpim1   = jpi-1 
       jpjm1   = jpj-1 
@@ -64,7 +67,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"
@@ -101,5 +104,4 @@
    USE dom_oce
    USE nemogcm
-   USE sol_oce
    USE in_out_manager
    USE agrif_opa_update
@@ -120,10 +122,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       !   ONLY : jpts
+   USE par_oce       
    USE oce
    IMPLICIT NONE
@@ -132,23 +134,26 @@
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   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)
-
+   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)
 
    ! 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)
-
+   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)
+    !
 END SUBROUTINE agrif_declare_var_dom
 
@@ -166,5 +171,5 @@
    USE dom_oce
    USE nemogcm
-   USE sol_oce
+   USE lib_mpp
    USE in_out_manager
    USE agrif_opa_update
@@ -174,14 +179,7 @@
    IMPLICIT NONE
    !
-   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp
-   REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp
-   REAL(wp), DIMENSION(:,:    ), ALLOCATABLE :: tab2d
    LOGICAL :: check_namelist
-   !!----------------------------------------------------------------------
-
-   ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) )
-   ALLOCATE( tabuvtemp(jpi, jpj, jpk)       )
-   ALLOCATE( tab2d(jpi, jpj)                )
-
+   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3
+   !!----------------------------------------------------------------------
 
    ! 1. Declaration of the type of variable which have to be interpolated
@@ -193,44 +191,69 @@
    Agrif_SpecialValue=0.
    Agrif_UseSpecialValue = .TRUE.
-   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.
+   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)
+
+   Agrif_UseSpecialValue = .TRUE.
+   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
+
+   IF ( ln_dynspg_ts ) THEN
+      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.
 
    ! 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) /= 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
+      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()
       ENDIF
 
       ! Check run length
       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
-           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
+            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()
       ENDIF
 
@@ -238,5 +261,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)
@@ -253,14 +276,60 @@
          ENDIF
       ENDIF
+
+      ! Check free surface scheme
+      IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
+         & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
+         WRITE(*,*) 'incompatible free surface scheme between grids'
+         WRITE(*,*) 'parent grid ln_dynspg_ts  :', Agrif_Parent(ln_dynspg_ts )
+         WRITE(*,*) 'parent grid ln_dynspg_exp :', Agrif_Parent(ln_dynspg_exp)
+         WRITE(*,*) 'child grid  ln_dynspg_ts  :', ln_dynspg_ts
+         WRITE(*,*) 'child grid  ln_dynspg_exp :', ln_dynspg_exp
+         WRITE(*,*) 'those logicals should be identical'                  
+         STOP
+      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
-
-   CALL Agrif_Update_tra(0)
-   CALL Agrif_Update_dyn(0)
-
+   ! 
+   ! 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.
    nbcline = 0
-   !
-   DEALLOCATE(tabtstemp)
-   DEALLOCATE(tabuvtemp)
-   DEALLOCATE(tab2d)
+   lk_agrif_doupd = .FALSE.
    !
 END SUBROUTINE Agrif_InitValues_cont
@@ -276,4 +345,5 @@
    USE par_oce       !   ONLY : jpts
    USE oce
+   USE agrif_oce
    IMPLICIT NONE
    !!----------------------------------------------------------------------
@@ -281,68 +351,120 @@
    ! 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/),(/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)
+   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
 
    ! 2. Type of interpolation
    !-------------------------
    CALL Agrif_Set_bcinterp(tsn_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(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(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_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   Call Agrif_Set_bcinterp(vb2b_id,interp1=AGRIF_ppm,interp2=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
+
 
    ! 3. Location of interpolation
    !-----------------------------
-   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/))
+   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
 
    ! 5. Update type
    !--------------- 
-   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)
-
+   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)
+ 
+   !
 END SUBROUTINE agrif_declare_var
 # endif
@@ -365,9 +487,5 @@
    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
@@ -401,6 +519,4 @@
    CALL Agrif_Update_lim2(0)
    !
-   DEALLOCATE( zvel, zadv )
-   !
 END SUBROUTINE Agrif_InitValues_cont_lim2
 
@@ -431,19 +547,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
@@ -462,6 +578,8 @@
    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
@@ -470,9 +588,7 @@
    IMPLICIT NONE
    !
-   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp
+   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
    LOGICAL :: check_namelist
    !!----------------------------------------------------------------------
-
-   ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) )
 
 
@@ -485,35 +601,42 @@
    Agrif_SpecialValue=0.
    Agrif_UseSpecialValue = .TRUE.
-   Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn)
-   Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn)
+   CALL Agrif_Bc_variable(trn_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 offline     
+# if defined key_offline
       ! Check time steps
-      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
+      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()
       ENDIF
 
       ! Check run length
       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
-           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
+            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()
       ENDIF
 
@@ -521,5 +644,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)
@@ -528,5 +651,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)
@@ -538,13 +661,13 @@
 #  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
 
-!ch   CALL Agrif_Update_trc(0)
+   CALL Agrif_Update_trc(0)
+   !
+   Agrif_UseSpecialValueInUpdate = .FALSE.
    nbcline_trc = 0
-   !
-   DEALLOCATE(tabtrtemp)
    !
 END SUBROUTINE Agrif_InitValues_cont_top
@@ -558,4 +681,5 @@
    !!----------------------------------------------------------------------
    USE agrif_util
+   USE agrif_oce
    USE dom_oce
    USE trc
@@ -565,24 +689,26 @@
    ! 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/),(/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)
+   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)
 
    ! 2. Type of interpolation
    !-------------------------
    CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
-   CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear)
+   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
 
    ! 3. Location of interpolation
    !-----------------------------
-   Call Agrif_Set_bc(trn_id,(/0,1/))
-   Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/))
+   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/))
 
    ! 5. Update type
    !--------------- 
-   Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
-   Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average)
-
-
+   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
+
+!   Higher order update
+!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
+
+   !
 END SUBROUTINE agrif_declare_var_top
 # endif
@@ -592,5 +718,4 @@
    !!   *** ROUTINE Agrif_detect ***
    !!----------------------------------------------------------------------
-   USE Agrif_Types
    !
    INTEGER, DIMENSION(2) :: ksizex
@@ -614,15 +739,16 @@
    !
    INTEGER  ::   ios                 ! Local integer output status for namelist read
-   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 )
+   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 )
    !
    IF(lwp) THEN                    ! control print
@@ -635,4 +761,5 @@
       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
@@ -643,5 +770,10 @@
    visc_dyn      = rn_sponge_dyn
    !
-   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed')
+   ! 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 defined key_lim2
    IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed')
@@ -664,10 +796,45 @@
    SELECT CASE( i )
    CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
-   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
-   CASE(3)   ;   indglob = indloc
-   CASE(4)   ;   indglob = indloc
+   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
+   CASE DEFAULT
+      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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OFF_SRC/domrea.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OFF_SRC/domrea.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OFF_SRC/domrea.F90	(revision 6808)
@@ -4,4 +4,11 @@
    !! Ocean initialization : domain initialization
    !!==============================================================================
+   !! History :  OPA  ! 1990-10  (C. Levy - G. Madec)  Original code
+   !!                 ! 1992-01  (M. Imbard) insert time step initialization
+   !!                 ! 1996-06  (G. Madec) generalized vertical coordinate 
+   !!                 ! 1997-02  (G. Madec) creation of domwri.F
+   !!                 ! 2001-05  (E.Durand - G. Madec) insert closed sea
+   !!  NEMO      1.0  ! 2002-08  (G. Madec)  F90: Free form and module
+   !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
@@ -10,15 +17,13 @@
    !!   dom_ctl        : control print for the ocean domain
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! 
+   USE trc_oce         ! shared ocean/biogeochemical variables
    USE dom_oce         ! ocean space and time domain
    USE phycst          ! physical constants
+   USE domstp          ! domain: set the time-step
+   !
    USE in_out_manager  ! I/O manager
    USE lib_mpp         ! distributed memory computing library
-
-   USE domstp          ! domain: set the time-step
-
    USE lbclnk          ! lateral boundary condition - MPP exchanges
-   USE trc_oce         ! shared ocean/biogeochemical variables
    USE wrk_nemo  
    
@@ -26,16 +31,13 @@
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC dom_rea       ! called by opa.F90
+   PUBLIC   dom_rea    ! called by nemogcm.F90
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! NEMO/OFF 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -51,19 +53,9 @@
       !!      - dom_stp: defined the model time step
       !!      - dom_rea: read the meshmask file if nmsh=1
-      !!
-      !! History :
-      !!        !  90-10  (C. Levy - G. Madec)  Original code
-      !!        !  91-11  (G. Madec)
-      !!        !  92-01  (M. Imbard) insert time step initialization
-      !!        !  96-06  (G. Madec) generalized vertical coordinate 
-      !!        !  97-02  (G. Madec) creation of domwri.F
-      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
-      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER ::   jk                ! dummy loop argument
-      INTEGER ::   iconf = 0         ! temporary integers
-      !!----------------------------------------------------------------------
-
+      !!----------------------------------------------------------------------
+      INTEGER ::   jk          ! dummy loop index
+      INTEGER ::   iconf = 0   ! local integers
+      !!----------------------------------------------------------------------
+      !
       IF(lwp) THEN
          WRITE(numout,*)
@@ -71,39 +63,41 @@
          WRITE(numout,*) '~~~~~~~~'
       ENDIF
-
-      CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
+      !
+      CALL dom_nam      ! read namelist ( namrun, namdom )
       CALL dom_zgr      ! Vertical mesh and bathymetry option
       CALL dom_grd      ! Create a domain file
-
-     !
-      ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines
-      !        but could be usefull in many other routines
-      e12t    (:,:) = e1t(:,:) * e2t(:,:)
-      e1e2t   (:,:) = e1t(:,:) * e2t(:,:)
-      e12u    (:,:) = e1u(:,:) * e2u(:,:)
-      e12v    (:,:) = e1v(:,:) * e2v(:,:)
-      e12f    (:,:) = e1f(:,:) * e2f(:,:)
-      r1_e12t (:,:) = 1._wp    / e12t(:,:)
-      r1_e12u (:,:) = 1._wp    / e12u(:,:)
-      r1_e12v (:,:) = 1._wp    / e12v(:,:)
-      r1_e12f (:,:) = 1._wp    / e12f(:,:)
-      re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)
-      re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)
-      !
-      hu(:,:) = 0._wp                          ! Ocean depth at U- and V-points
-      hv(:,:) = 0._wp
-      DO jk = 1, jpk
-         hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
-         hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
+      !
+      !                                      ! associated horizontal metrics
+      !
+      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:)
+      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:)
+      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:)
+      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:)
+      !
+!!gm BUG if scale factor reduction !!!!
+      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:)
+      e1e2u (:,:) = e1u(:,:) * e2u(:,:)   ;   r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)
+      e1e2v (:,:) = e1v(:,:) * e2v(:,:)   ;   r1_e1e2v(:,:) = 1._wp / e1e2v(:,:)
+      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:)
+      !   
+      e2_e1u(:,:) = e2u(:,:) / e1u(:,:)
+      e1_e2v(:,:) = e1v(:,:) / e2v(:,:)
+      !
+      hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1)     ! Ocean depth at U- and V-points
+      hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1)
+      DO jk = 2, jpk
+         hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
+         hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
       END DO
       !                                        ! Inverse of the local depth
-      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)
-      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)
-
+      r1_hu_n(:,:) = 1._wp / ( hu_n(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)
+      r1_hv_n(:,:) = 1._wp / ( hv_n(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)
+      !
       CALL dom_stp      ! Time step
       CALL dom_msk      ! Masks
       CALL dom_ctl      ! Domain control
-
+      !
    END SUBROUTINE dom_rea
+
 
    SUBROUTINE dom_nam
@@ -115,20 +109,17 @@
       !! ** input   : - namrun namelist
       !!              - namdom namelist
-      !!              - namcla namelist
       !!----------------------------------------------------------------------
       USE ioipsl
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               &
-         &             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
-      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
-         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
-         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea , ln_crs, &
-         &             jphgr_msh, &
+      INTEGER  ::   ios   ! Local integer output status for namelist read
+      !
+      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                         &
+         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,             &
+         &             nn_it000, nn_itend  , nn_date0    , nn_time0, nn_leapy     , nn_istate , nn_stock ,   &
+         &             nn_write, ln_iscpl  , ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler
+      NAMELIST/namdom/ nn_bathy , rn_bathy , rn_e3zps_min, rn_e3zps_rat , nn_msh    , rn_hmin   , rn_isfhmin,&
+         &             rn_atfp  , rn_rdt   , nn_baro     , nn_closea    , ln_crs    , jphgr_msh,             &
          &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
          &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
          &             ppa2, ppkth2, ppacr2
-      NAMELIST/namcla/ nn_cla
 #if defined key_netcdf4
       NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
@@ -161,5 +152,4 @@
          WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
          WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
-         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
          WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
          WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
@@ -178,6 +168,5 @@
       nstocklist = nn_stocklist
       nwrite = nn_write
-
-
+      !
       !                             ! control of output frequency
       IF ( nstock == 0 .OR. nstock > nitend ) THEN
@@ -194,5 +183,5 @@
       ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
       ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
-      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+      adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
 
 #if defined key_agrif
@@ -239,8 +228,4 @@
          WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
          WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
-         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
-         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
-         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
-         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
          WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
          WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
@@ -268,26 +253,6 @@
       e3zps_rat = rn_e3zps_rat
       nmsh      = nn_msh
-      nacc      = nn_acc
       atfp      = rn_atfp
       rdt       = rn_rdt
-      rdtmin    = rn_rdtmin
-      rdtmax    = rn_rdtmin
-      rdth      = rn_rdth
-
-      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection
-      READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
-905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection
-      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
-906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
-      IF(lwm) WRITE( numond, namcla )
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namcla'
-         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
-      ENDIF
-
 #if defined key_netcdf4
       !                             ! NetCDF 4 case   ("key_netcdf4" defined)
@@ -321,4 +286,5 @@
    END SUBROUTINE dom_nam
 
+
    SUBROUTINE dom_zgr
       !!----------------------------------------------------------------------
@@ -341,5 +307,5 @@
       INTEGER ::   ios
       !!
-      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh
       !!----------------------------------------------------------------------
 
@@ -362,4 +328,5 @@
          WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
          WRITE(numout,*) '             ice shelf cavity               ln_isfcav = ', ln_isfcav
+         WRITE(numout,*) '             Linear free surface            ln_linssh = ', ln_linssh
       ENDIF
 
@@ -374,4 +341,5 @@
    END SUBROUTINE dom_zgr
 
+
    SUBROUTINE dom_ctl
       !!----------------------------------------------------------------------
@@ -382,8 +350,5 @@
       !! ** Method  :   compute and print extrema of masked scale factors
       !!
-      !! History :
-      !!   8.5  !  02-08  (G. Madec)    Original code
-      !!----------------------------------------------------------------------
-      !! * Local declarations
+      !!----------------------------------------------------------------------
       INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
       INTEGER, DIMENSION(2) ::   iloc      ! 
@@ -421,5 +386,5 @@
          ijma2 = iloc(2) + njmpp - 1
       ENDIF
-
+      !
       IF(lwp) THEN
          WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
@@ -428,6 +393,7 @@
          WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
       ENDIF
-
+      !
    END SUBROUTINE dom_ctl
+
 
    SUBROUTINE dom_grd
@@ -538,5 +504,4 @@
          CALL iom_get( inum2, jpdom_data, 'facvolt', facvol )
 #endif
-
          !                                                         ! horizontal mesh (inum3)
          CALL iom_get( inum3, jpdom_data, 'glamt', glamt )
@@ -578,8 +543,8 @@
             CALL iom_get( inum4, jpdom_unknown, 'esigw', esigw )
 
-            CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) ) ! scale factors
-            CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) )
-            CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) )
-            CALL iom_get( inum4, jpdom_data, 'e3w_0', fse3w_n(:,:,:) )
+            CALL iom_get( inum4, jpdom_data, 'e3t_0', e3t_0(:,:,:) ) ! scale factors
+            CALL iom_get( inum4, jpdom_data, 'e3u_0', e3u_0(:,:,:) )
+            CALL iom_get( inum4, jpdom_data, 'e3v_0', e3v_0(:,:,:) )
+            CALL iom_get( inum4, jpdom_data, 'e3w_0', e3w_0(:,:,:) )
 
             CALL iom_get( inum4, jpdom_unknown, 'gdept_1d', gdept_1d ) ! depth
@@ -595,8 +560,8 @@
             !
             IF( nmsh <= 6 ) THEN                                        ! 3D vertical scale factors
-               CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) )
-               CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) )
-               CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) )
-               CALL iom_get( inum4, jpdom_data, 'e3w_0', fse3w_n(:,:,:) )
+               CALL iom_get( inum4, jpdom_data, 'e3t_0', e3t_0(:,:,:) )
+               CALL iom_get( inum4, jpdom_data, 'e3u_0', e3u_0(:,:,:) )
+               CALL iom_get( inum4, jpdom_data, 'e3v_0', e3v_0(:,:,:) )
+               CALL iom_get( inum4, jpdom_data, 'e3w_0', e3w_0(:,:,:) )
             ELSE                                                        ! 2D bottom scale factors
                CALL iom_get( inum4, jpdom_data, 'e3t_ps', e3tp )
@@ -604,14 +569,14 @@
                !                                                        ! deduces the 3D scale factors
                DO jk = 1, jpk
-                  fse3t_n(:,:,jk) = e3t_1d(jk)                                    ! set to the ref. factors
-                  fse3u_n(:,:,jk) = e3t_1d(jk)
-                  fse3v_n(:,:,jk) = e3t_1d(jk)
-                  fse3w_n(:,:,jk) = e3w_1d(jk)
+                  e3t_0(:,:,jk) = e3t_1d(jk)                                    ! set to the ref. factors
+                  e3u_0(:,:,jk) = e3t_1d(jk)
+                  e3v_0(:,:,jk) = e3t_1d(jk)
+                  e3w_0(:,:,jk) = e3w_1d(jk)
                END DO
                DO jj = 1,jpj                                                  ! adjust the deepest values
                   DO ji = 1,jpi
                      ik = mbkt(ji,jj)
-                     fse3t_n(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_1d(1) * ( 1._wp - tmask(ji,jj,1) )
-                     fse3w_n(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_1d(1) * ( 1._wp - tmask(ji,jj,1) )
+                     e3t_0(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_1d(1) * ( 1._wp - tmask(ji,jj,1) )
+                     e3w_0(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_1d(1) * ( 1._wp - tmask(ji,jj,1) )
                   END DO
                END DO
@@ -619,21 +584,21 @@
                   DO jj = 1, jpjm1
                      DO ji = 1, jpim1
-                        fse3u_n(ji,jj,jk) = MIN( fse3t_n(ji,jj,jk), fse3t_n(ji+1,jj,jk) )
-                        fse3v_n(ji,jj,jk) = MIN( fse3t_n(ji,jj,jk), fse3t_n(ji,jj+1,jk) )
+                        e3u_0(ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
+                        e3v_0(ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
                      END DO
                   END DO
                END DO
-               CALL lbc_lnk( fse3u_n(:,:,:) , 'U', 1._wp )   ;   CALL lbc_lnk( fse3uw_n(:,:,:), 'U', 1._wp )   ! lateral boundary conditions
-               CALL lbc_lnk( fse3v_n(:,:,:) , 'V', 1._wp )   ;   CALL lbc_lnk( fse3vw_n(:,:,:), 'V', 1._wp )
+               CALL lbc_lnk( e3u_0(:,:,:) , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_0(:,:,:), 'U', 1._wp )   ! lateral boundary conditions
+               CALL lbc_lnk( e3v_0(:,:,:) , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_0(:,:,:), 'V', 1._wp )
                !
                DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
-                  WHERE( fse3u_n(:,:,jk) == 0._wp )   fse3u_n(:,:,jk) = e3t_1d(jk)
-                  WHERE( fse3v_n(:,:,jk) == 0._wp )   fse3v_n(:,:,jk) = e3t_1d(jk)
+                  WHERE( e3u_0(:,:,jk) == 0._wp )   e3u_0(:,:,jk) = e3t_1d(jk)
+                  WHERE( e3v_0(:,:,jk) == 0._wp )   e3v_0(:,:,jk) = e3t_1d(jk)
                END DO
             END IF
 
             IF( iom_varid( inum4, 'gdept_0', ldstop = .FALSE. ) > 0 ) THEN   ! 3D depth of t- and w-level
-               CALL iom_get( inum4, jpdom_data, 'gdept_0', fsdept_n(:,:,:) )
-               CALL iom_get( inum4, jpdom_data, 'gdepw_0', fsdepw_n(:,:,:) )
+               CALL iom_get( inum4, jpdom_data, 'gdept_0', gdept_0(:,:,:) )
+               CALL iom_get( inum4, jpdom_data, 'gdepw_0', gdepw_0(:,:,:) )
             ELSE                                                           ! 2D bottom depth
                CALL iom_get( inum4, jpdom_data, 'hdept', zprt )
@@ -641,6 +606,6 @@
                !
                DO jk = 1, jpk                                              ! deduces the 3D depth
-                  fsdept_n(:,:,jk) = gdept_1d(jk)
-                  fsdepw_n(:,:,jk) = gdepw_1d(jk)
+                  gdept_0(:,:,jk) = gdept_1d(jk)
+                  gdepw_0(:,:,jk) = gdepw_1d(jk)
                END DO
                DO jj = 1, jpj
@@ -648,7 +613,7 @@
                      ik = mbkt(ji,jj)
                      IF( ik > 0 ) THEN
-                        fsdepw_n(ji,jj,ik+1) = zprw(ji,jj)
-                        fsdept_n(ji,jj,ik  ) = zprt(ji,jj)
-                        fsdept_n(ji,jj,ik+1) = fsdept_n(ji,jj,ik) + fse3t_n(ji,jj,ik)
+                        gdepw_0(ji,jj,ik+1) = zprw(ji,jj)
+                        gdept_0(ji,jj,ik  ) = zprt(ji,jj)
+                        gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik)
                      ENDIF
                   END DO
@@ -664,12 +629,29 @@
             CALL iom_get( inum4, jpdom_unknown, 'e3w_1d'  , e3w_1d   )
             DO jk = 1, jpk
-               fse3t_n(:,:,jk) = e3t_1d(jk)                              ! set to the ref. factors
-               fse3u_n(:,:,jk) = e3t_1d(jk)
-               fse3v_n(:,:,jk) = e3t_1d(jk)
-               fse3w_n(:,:,jk) = e3w_1d(jk)
-               fsdept_n(:,:,jk) = gdept_1d(jk)
-               fsdepw_n(:,:,jk) = gdepw_1d(jk)
+               e3t_0(:,:,jk) = e3t_1d(jk)                              ! set to the ref. factors
+               e3u_0(:,:,jk) = e3t_1d(jk)
+               e3v_0(:,:,jk) = e3t_1d(jk)
+               e3w_0(:,:,jk) = e3w_1d(jk)
+               gdept_0(:,:,jk) = gdept_1d(jk)
+               gdepw_0(:,:,jk) = gdepw_1d(jk)
             END DO
          ENDIF
+
+      !
+      !              !==  time varying part of coordinate system  ==!
+      !
+      !       before        !          now          !       after         !
+      ;  gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
+      ;  gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
+      ;                     ;   gde3w_n = gde3w_0   !        ---          !
+      !
+      ;    e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
+      ;    e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
+      ;    e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
+      ;                     ;     e3f_n =   e3f_0   !        ---          !
+      ;    e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
+      ;   e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
+      ;   e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
+      !
 
 !!gm BUG in s-coordinate this does not work!
@@ -701,14 +683,4 @@
             &                     e2t  (1,jj), e2u  (1,jj),   &
             &                     e2v  (1,jj), jj = 1, jpj, 10 )
-      ENDIF
-
-
-      IF( nprint == 1 .AND. lwp ) THEN
-         WRITE(numout,*) '          e1u e2u '
-         CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-         CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-         WRITE(numout,*) '          e1v e2v  '
-         CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-         CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
       ENDIF
 
@@ -756,5 +728,4 @@
       !!                                     (min value = 1 over land)
       !!----------------------------------------------------------------------
-      !
       INTEGER ::   ji, jj   ! dummy loop indices
       REAL(wp), POINTER, DIMENSION(:,:) :: zmbk
@@ -785,4 +756,5 @@
    END SUBROUTINE zgr_bot_level
 
+
    SUBROUTINE dom_msk
       !!---------------------------------------------------------------------
@@ -799,9 +771,7 @@
       !!               tpol     : ???
       !!----------------------------------------------------------------------
-      !
-      INTEGER  ::   ji, jj, jk                   ! dummy loop indices
-      INTEGER  ::   iif, iil, ijf, ijl       ! local integers
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      INTEGER  ::   iif, iil, ijf, ijl   ! local integers
       INTEGER, POINTER, DIMENSION(:,:) ::  imsk 
-      !
       !!---------------------------------------------------------------------
       
@@ -839,41 +809,26 @@
       DO jj = 1, jpjm1
          DO ji = 1, fs_jpim1   ! vector loop
-            umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:)))
-            vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:)))
+            ssumask(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:)))
+            ssvmask(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:)))
          END DO
          DO ji = 1, jpim1      ! NO vector opt.
-            fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   &
+            ssfmask(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   &
                &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:)))
          END DO
       END DO
-      CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions
-      CALL lbc_lnk( vmask_i, 'V', 1._wp )
-      CALL lbc_lnk( fmask_i, 'F', 1._wp )
+      CALL lbc_lnk( ssumask, 'U', 1._wp )      ! Lateral boundary conditions
+      CALL lbc_lnk( ssvmask, 'V', 1._wp )
+      CALL lbc_lnk( ssfmask, 'F', 1._wp )
 
       ! 3. Ocean/land mask at wu-, wv- and w points 
       !----------------------------------------------
-      wmask (:,:,1) = tmask(:,:,1) ! ????????
-      wumask(:,:,1) = umask(:,:,1) ! ????????
-      wvmask(:,:,1) = vmask(:,:,1) ! ????????
-      DO jk=2,jpk
-         wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1)
-         wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1)   
-         wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1)
+      wmask (:,:,1) = tmask(:,:,1)        ! surface value
+      wumask(:,:,1) = umask(:,:,1) 
+      wvmask(:,:,1) = vmask(:,:,1)
+      DO jk = 2, jpk                      ! deeper value
+         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
+         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)   
+         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
       END DO
-      !
-      IF( nprint == 1 .AND. lwp ) THEN    ! Control print
-         imsk(:,:) = INT( tmask_i(:,:) )
-         WRITE(numout,*) ' tmask_i : '
-         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
-         WRITE (numout,*)
-         WRITE (numout,*) ' dommsk: tmask for each level'
-         WRITE (numout,*) ' ----------------------------'
-         DO jk = 1, jpk
-            imsk(:,:) = INT( tmask(:,:,jk) )
-            WRITE(numout,*)
-            WRITE(numout,*) ' level = ',jk
-            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
-         END DO
-      ENDIF
       !
       CALL wrk_dealloc( jpi, jpj, imsk )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 6808)
@@ -26,8 +26,7 @@
    USE trc_oce         ! share ocean/biogeo variables
    USE phycst          ! physical constants
+   USE ldftra          ! lateral diffusivity coefficients
    USE trabbl          ! active tracer: bottom boundary layer
    USE ldfslp          ! lateral diffusion: iso-neutral slopes
-   USE ldfeiv          ! eddy induced velocity coef. 
-   USE ldftra_oce      ! ocean tracer   lateral physics
    USE zdfmxl          ! vertical physics: mixed layer depth
    USE eosbn2          ! equation of state - Brunt Vaisala frequency
@@ -40,4 +39,5 @@
    USE fldread         ! read input fields 
    USE timing          ! Timing
+   USE wrk_nemo
 
    IMPLICIT NONE
@@ -50,8 +50,7 @@
    LOGICAL            ::   ln_dynwzv    !: vertical velocity read in a file (T) or computed from u/v (F)
    LOGICAL            ::   ln_dynbbl    !: bbl coef read in a file (T) or computed (F)
-   LOGICAL            ::   ln_degrad    !: degradation option enabled or not
    LOGICAL            ::   ln_dynrnf    !: read runoff data in file (T) or set to zero (F)
 
-   INTEGER  , PARAMETER ::   jpfld = 21     ! maximum number of fields to read
+   INTEGER  , PARAMETER ::   jpfld = 15     ! maximum number of fields to read
    INTEGER  , SAVE      ::   jf_tem         ! index of temperature
    INTEGER  , SAVE      ::   jf_sal         ! index of salinity
@@ -68,10 +67,4 @@
    INTEGER  , SAVE      ::   jf_ubl         ! index of u-bbl coef
    INTEGER  , SAVE      ::   jf_vbl         ! index of v-bbl coef
-   INTEGER  , SAVE      ::   jf_ahu         ! index of u-diffusivity coef
-   INTEGER  , SAVE      ::   jf_ahv         ! index of v-diffusivity coef 
-   INTEGER  , SAVE      ::   jf_ahw         ! index of w-diffusivity coef
-   INTEGER  , SAVE      ::   jf_eiu         ! index of u-eiv
-   INTEGER  , SAVE      ::   jf_eiv         ! index of v-eiv
-   INTEGER  , SAVE      ::   jf_eiw         ! index of w-eiv
    INTEGER  , SAVE      ::   jf_fmf         ! index of downward salt flux
 
@@ -92,5 +85,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -112,11 +104,15 @@
       !!             - interpolates data if needed
       !!----------------------------------------------------------------------
-      !
-      USE oce, ONLY:  zts    => tsa 
+      USE oce, ONLY:  zts    => tsa
       USE oce, ONLY:  zuslp  => ua   , zvslp  => va
-      USE oce, ONLY:  zwslpi => rotb , zwslpj => rotn
-      USE oce, ONLY:  zu     => ub   , zv     => vb,  zw => hdivb
+      USE oce, ONLY:  zu     => ub   , zv     => vb,  zw => rke
       !
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+       REAL(wp), DIMENSION(jpi,jpj,jpk     )  :: zwslpi, zwslpj
+!      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)  :: zts
+!      REAL(wp), DIMENSION(jpi,jpj,jpk     )  :: zuslp, zvslp, zwslpi, zwslpj
+!      REAL(wp), DIMENSION(jpi,jpj,jpk     )  :: zu, zv, zw
+      !
       !
       INTEGER  ::   ji, jj     ! dummy loop indices
@@ -138,5 +134,5 @@
          CALL fld_read( kt, 1, sf_dyn )      !==   read data at kt time step   ==!
          !
-         IF( lk_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                       
+         IF( l_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                       
             zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:)   ! temperature
             zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:)   ! salinity 
@@ -162,5 +158,5 @@
       ENDIF
       ! 
-      IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)                       
+      IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)                       
          iswap_tem = 0
          IF(  kt /= nit000 .AND. ( sf_dyn(jf_tem)%nrec_a(2) - nrecprev_tem ) /= 0 )  iswap_tem = 1
@@ -267,4 +263,6 @@
       rnf (:,:)        = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1)    ! river runoffs 
 
+      !                                               ! update eddy diffusivity coeff. and/or eiv coeff. at kt
+      IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kt ) 
       !                                                      ! bbl diffusive coef
 #if defined key_trabbl && ! defined key_c1d
@@ -276,27 +274,4 @@
          CALL bbl( kt, nit000, 'TRC')
       END IF
-#endif
-#if ( ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv ) && ! defined key_c1d 
-      aeiw(:,:)        = sf_dyn(jf_eiw)%fnow(:,:,1) * tmask(:,:,1)    ! w-eiv
-      !                                                           ! Computes the horizontal values from the vertical value
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) )  ! Average the diffusive coefficient at u- v- points
-            aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) )  ! at u- v- points
-         END DO
-      END DO
-      CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )    ! lateral boundary condition
-#endif
-      
-#if defined key_degrad && ! defined key_c1d 
-      !                                          ! degrad option : diffusive and eiv coef are 3D
-      ahtu(:,:,:) = sf_dyn(jf_ahu)%fnow(:,:,:) * umask(:,:,:)
-      ahtv(:,:,:) = sf_dyn(jf_ahv)%fnow(:,:,:) * vmask(:,:,:)
-      ahtw(:,:,:) = sf_dyn(jf_ahw)%fnow(:,:,:) * tmask(:,:,:)
-#  if defined key_traldf_eiv 
-      aeiu(:,:,:) = sf_dyn(jf_eiu)%fnow(:,:,:) * umask(:,:,:)
-      aeiv(:,:,:) = sf_dyn(jf_eiv)%fnow(:,:,:) * vmask(:,:,:)
-      aeiw(:,:,:) = sf_dyn(jf_eiw)%fnow(:,:,:) * tmask(:,:,:)
-#  endif
 #endif
       !
@@ -339,12 +314,9 @@
       TYPE(FLD_N), DIMENSION(jpfld) ::  slf_d    ! array of namelist informations on the fields to read
       TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf  ! informations about the fields to be read
-      TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl          !   "                                 "
-      TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf  !   "                                 "
-      !!----------------------------------------------------------------------
-      !
-      NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad, ln_dynrnf,    &
+      TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, sn_fmf          !   "                                 "
+      NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_dynrnf,    &
          &                sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf,  &
-         &                sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl,          &
-         &                sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf
+         &                sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, sn_fmf  
+      !!----------------------------------------------------------------------
       !
       REWIND( numnam_ref )              ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data
@@ -365,13 +337,8 @@
          WRITE(numout,*) '      vertical velocity read from file (T) or computed (F) ln_dynwzv  = ', ln_dynwzv
          WRITE(numout,*) '      bbl coef read from file (T) or computed (F)          ln_dynbbl  = ', ln_dynbbl
-         WRITE(numout,*) '      degradation option enabled (T) or not (F)            ln_degrad  = ', ln_degrad
          WRITE(numout,*) '      river runoff option enabled (T) or not (F)           ln_dynrnf  = ', ln_dynrnf
          WRITE(numout,*)
       ENDIF
       ! 
-      IF( ln_degrad .AND. .NOT.lk_degrad ) THEN
-         CALL ctl_warn( 'dta_dyn_init: degradation option requires key_degrad activated ; force ln_degrad to false' )
-         ln_degrad = .FALSE.
-      ENDIF
       IF( ln_dynbbl .AND. ( .NOT.lk_trabbl .OR. lk_c1d ) ) THEN
          CALL ctl_warn( 'dta_dyn_init: bbl option requires key_trabbl activated ; force ln_dynbbl to false' )
@@ -391,50 +358,31 @@
                 jf_rnf = jfld + 1  ;  jfld  = jf_rnf
          slf_d(jf_rnf) = sn_rnf
+         ! Activate runoff key of sbc_oce
+         ln_rnf = .true.
+         WRITE(numout,*) 'dta_dyn : Activate the runoff data structure from ocean core ( force ln_rnf = .true.) '
+         WRITE(numout,*)
       ELSE
          rnf (:,:) = 0._wp
       ENDIF
 
-      !
-      IF( .NOT.ln_degrad ) THEN     ! no degrad option
-         IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN        ! eiv & bbl
-                 jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;        jf_eiw  = jfld + 3   ;   jfld = jf_eiw
-           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl  ;   slf_d(jf_eiw) = sn_eiw
-         ENDIF
-         IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN   ! no eiv & bbl
+      IF( ln_dynbbl ) THEN         ! eiv & bbl
                  jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;  jfld = jf_vbl
            slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl
-         ENDIF
-         IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN   ! eiv & no bbl
-           jf_eiw = jfld + 1 ; jfld = jf_eiw ; slf_d(jf_eiw) = sn_eiw
-         ENDIF
-      ELSE
-              jf_ahu  = jfld + 1 ;        jf_ahv  = jfld + 2 ;        jf_ahw  = jfld + 3  ;  jfld = jf_ahw
-        slf_d(jf_ahu) = sn_ahu  ;   slf_d(jf_ahv) = sn_ahv  ;   slf_d(jf_ahw) = sn_ahw
-        IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN         ! eiv & bbl
-                 jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;
-           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl
-                 jf_eiu  = jfld + 3 ;        jf_eiv  = jfld + 4 ;    jf_eiw  = jfld + 5   ;  jfld = jf_eiw 
-           slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;    slf_d(jf_eiw) = sn_eiw
-        ENDIF
-        IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN    ! no eiv & bbl
-                 jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;  jfld = jf_vbl
-           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl
-        ENDIF
-        IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN    ! eiv & no bbl
-                 jf_eiu  = jfld + 1 ;         jf_eiv  = jfld + 2 ;    jf_eiw  = jfld + 3   ; jfld = jf_eiw 
-           slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;   slf_d(jf_eiw) = sn_eiw
-        ENDIF
-      ENDIF
-  
+      ENDIF
+
+
       ALLOCATE( sf_dyn(jfld), STAT=ierr )         ! set sf structure
       IF( ierr > 0 ) THEN
          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 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
+         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
          IF( idimv == 3 ) THEN    ! 2D variable
                                       ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 )
@@ -448,8 +396,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 
+      !
+      IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN                  ! slopes 
          IF( sf_dyn(jf_tem)%ln_tint ) THEN      ! time interpolation
             ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    &
@@ -478,4 +424,5 @@
    END SUBROUTINE dta_dyn_init
 
+
    SUBROUTINE dta_dyn_wzv( pu, pv, pw )
       !!----------------------------------------------------------------------
@@ -506,19 +453,20 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu  = pu(ji  ,jj  ,jk) * umask(ji  ,jj  ,jk) * e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk)
-               zu1 = pu(ji-1,jj  ,jk) * umask(ji-1,jj  ,jk) * e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk)
-               zv  = pv(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk)
-               zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk)
-               zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet 
+               zu  = pu(ji  ,jj  ,jk) * umask(ji  ,jj  ,jk) * e2u(ji  ,jj  ) * e3u_n(ji  ,jj  ,jk)
+               zu1 = pu(ji-1,jj  ,jk) * umask(ji-1,jj  ,jk) * e2u(ji-1,jj  ) * e3u_n(ji-1,jj  ,jk)
+               zv  = pv(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * e1v(ji  ,jj  ) * e3v_n(ji  ,jj  ,jk)
+               zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * e3v_n(ji  ,jj-1,jk)
+               zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
             END DO
          END DO
       END DO
+      !                              !  update the horizontal divergence with the runoff inflow
+      IF( ln_dynrnf )   zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / e3t_n(:,:,1)
+      !
       CALL lbc_lnk( zhdiv, 'T', 1. )      ! Lateral boundary conditions on zhdiv
-      !
       ! computation of vertical velocity from the bottom
       pw(:,:,jpk) = 0._wp
       DO jk = jpkm1, 1, -1
-         pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk)
+         pw(:,:,jk) = pw(:,:,jk+1) - e3t_n(:,:,jk) * zhdiv(:,:,jk)
       END DO
       !
@@ -539,8 +487,8 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pwslpj   ! meridional diapycnal slopes
       !!---------------------------------------------------------------------
-#if defined key_ldfslp && ! defined key_c1d
-      CALL eos    ( pts, rhd, rhop, gdept_0(:,:,:) )
-      CALL eos_rab( pts, rab_n )       ! now local thermal/haline expension ratio at T-points
-      CALL bn2    ( pts, rab_n, rn2  ) ! now    Brunt-Vaisala
+      IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)                       
+         CALL eos    ( pts, rhd, rhop, gdept_0(:,:,:) )
+         CALL eos_rab( pts, rab_n )       ! now local thermal/haline expension ratio at T-points
+         CALL bn2    ( pts, rab_n, rn2  ) ! now    Brunt-Vaisala
 
       ! Partial steps: before Horizontal DErivative
@@ -549,21 +497,20 @@
          &                                        rhd, gru , grv    )  ! of t, s, rd at the last ocean level
       IF( ln_zps .AND.        ln_isfcav)                            &
-         &            CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
-         &                                        rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
-         &                                 gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the first ocean level
-
-      rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl
-      CALL zdf_mxl( kt )            ! mixed layer depth
-      CALL ldf_slp( kt, rhd, rn2 )  ! slopes
-      puslp (:,:,:) = uslp (:,:,:) 
-      pvslp (:,:,:) = vslp (:,:,:) 
-      pwslpi(:,:,:) = wslpi(:,:,:) 
-      pwslpj(:,:,:) = wslpj(:,:,:) 
-#else
-      puslp (:,:,:) = 0.            ! to avoid warning when compiling
-      pvslp (:,:,:) = 0.
-      pwslpi(:,:,:) = 0.
-      pwslpj(:,:,:) = 0.
-#endif
+         &            CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF)
+         &                                        rhd, gru , grv , grui, grvi   )  ! of t, s, rd at the first ocean level
+
+         rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl
+         CALL zdf_mxl( kt )            ! mixed layer depth
+         CALL ldf_slp( kt, rhd, rn2 )  ! slopes
+         puslp (:,:,:) = uslp (:,:,:) 
+         pvslp (:,:,:) = vslp (:,:,:) 
+         pwslpi(:,:,:) = wslpi(:,:,:) 
+         pwslpj(:,:,:) = wslpj(:,:,:) 
+     ELSE
+         puslp (:,:,:) = 0.            ! to avoid warning when compiling
+         pvslp (:,:,:) = 0.
+         pwslpi(:,:,:) = 0.
+         pwslpj(:,:,:) = 0.
+     ENDIF
       !
    END SUBROUTINE dta_dyn_slp
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90	(revision 6808)
@@ -26,4 +26,5 @@
    USE traqsr          ! solar radiation penetration    (tra_qsr_init routine)
    USE trabbl          ! bottom boundary layer          (tra_bbl_init routine)
+   USE traldf          ! lateral physics                (tra_ldf_init routine)
    USE zdfini          ! vertical physics: initialization
    USE sbcmod          ! surface boundary condition       (sbc_init     routine)
@@ -51,4 +52,6 @@
    USE trcrst
    USE diaptr         ! Need to initialise this as some variables are used in if statements later
+   USE sbc_oce, ONLY: ln_rnf
+   USE sbcrnf
 
    IMPLICIT NONE
@@ -93,4 +96,7 @@
       !                            !-----------------------!
       istp = nit000
+      !
+      ! Initialize arrays of runoffs structures and read data from the namelist
+      IF ( ln_rnf ) CALL sbc_rnf(istp)
       ! 
       CALL iom_init( cxios_context )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
@@ -147,5 +153,5 @@
       NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
          &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
-         &             nn_bench, nn_timing
+         &             nn_bench, nn_timing, nn_diacfl
       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
          &             jpizoom, jpjzoom, jperio, ln_use_jattr
@@ -283,8 +289,8 @@
                             CALL     sbc_init   ! Forcings : surface module
 
-#if ! defined key_degrad
                             CALL ldf_tra_init   ! Lateral ocean tracer physics
-#endif
-      IF( lk_ldfslp )       CALL ldf_slp_init   ! slope of lateral mixing
+                            CALL ldf_eiv_init   ! Eddy induced velocity param
+                            CALL tra_ldf_init   ! lateral mixing
+      IF( l_ldfslp )        CALL ldf_slp_init   ! slope of lateral mixing
 
                             CALL tra_qsr_init   ! penetrative solar radiation qsr
@@ -444,5 +450,4 @@
       USE dom_oce,      ONLY: dom_oce_alloc
       USE zdf_oce,      ONLY: zdf_oce_alloc
-      USE ldftra_oce,   ONLY: ldftra_oce_alloc
       USE trc_oce,      ONLY: trc_oce_alloc
       !
@@ -453,5 +458,4 @@
       ierr = ierr + dia_wri_alloc   ()
       ierr = ierr + dom_oce_alloc   ()          ! ocean domain
-      ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers
       ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 6808)
@@ -18,6 +18,4 @@
 
    !!----------------------------------------------------------------------
-   !!   'key_asminc' : Switch on the assimilation increment interface
-   !!----------------------------------------------------------------------
    !!   asm_bkg_wri  : Write out the background state
    !!   asm_trj_wri  : Write out the model state trajectory (used with 4D-Var)
@@ -27,6 +25,6 @@
    USE zdf_oce            ! Vertical mixing variables
    USE zdfddm             ! Double diffusion mixing parameterization
-   USE ldftra_oce         ! Lateral tracer mixing coefficient defined in memory
-   USE ldfslp             ! Slopes of neutral surfaces
+   USE ldftra             ! Lateral diffusion: eddy diffusivity coefficients
+   USE ldfslp             ! Lateral diffusion: slopes of neutral surfaces
    USE tradmp             ! Tracer damping
 #if defined key_zdftke
@@ -35,13 +33,9 @@
    USE eosbn2             ! Equation of state (eos_bn2 routine)
    USE zdfmxl             ! Mixed layer depth
-   USE dom_oce, ONLY :   ndastp
-   USE sol_oce, ONLY :   gcx   ! Solver variables defined in memory
+   USE dom_oce     , ONLY :   ndastp
    USE in_out_manager     ! I/O manager
    USE iom                ! I/O module
    USE asmpar             ! Parameters for the assmilation interface
    USE zdfmxl             ! mixed layer depth
-#if defined key_traldf_c2d
-   USE ldfeiv             ! eddy induced velocity coef.      (ldf_eiv routine)
-#endif
 #if defined key_lim2
    USE ice_2
@@ -50,4 +44,5 @@
    USE ice
 #endif
+
    IMPLICIT NONE
    PRIVATE
@@ -119,5 +114,4 @@
             CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                )
 #endif
-            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               )
             !
             CALL iom_close( inum )
@@ -155,10 +149,10 @@
             CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              )
 #if defined key_lim2 || defined key_lim3
-            IF(( nn_ice == 2 ) .OR. ( nn_ice == 3 )) THEN
-	       IF(ALLOCATED(frld)) THEN
-                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1.0 - frld(:,:)   )
+            IF( nn_ice == 2  .OR.  nn_ice == 3 ) THEN
+	            IF( ALLOCATED(frld) ) THEN
+                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1._wp - frld(:,:)   )
                ELSE
-		  CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep')
-	       ENDIF
+		            CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep')
+	            ENDIF
             ENDIF
 #endif
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 6808)
@@ -11,11 +11,10 @@
    !!             -   ! 2010-05  (D. Lea)  add calc_month_len routine based on day_init 
    !!            3.4  ! 2012-10  (A. Weaver and K. Mogensen) Fix for direct initialization
+   !!                 ! 2014-09  (D. Lea)  Local calc_date removed use routine from OBS
+   !!                 ! 2015-11  (D. Lea)  Handle non-zero initial time of day
    !!----------------------------------------------------------------------
 
-   !!----------------------------------------------------------------------
-   !!   'key_asminc'   : Switch on the assimilation increment interface
    !!----------------------------------------------------------------------
    !!   asm_inc_init   : Initialize the increment arrays and IAU weights
-   !!   calc_date      : Compute the calendar date YYYYMMDD on a given step
    !!   tra_asm_inc    : Apply the tracer (T and S) increments
    !!   dyn_asm_inc    : Apply the dynamic (u and v) increments
@@ -28,5 +27,5 @@
    USE domvvl           ! domain: variable volume level
    USE oce              ! Dynamics and active tracers defined in memory
-   USE ldfdyn_oce       ! ocean dynamics: lateral physics
+   USE ldfdyn           ! lateral diffusion: eddy viscosity coefficients
    USE eosbn2           ! Equation of state - in situ and potential density
    USE zpshde           ! Partial step : Horizontal Derivative
@@ -40,4 +39,5 @@
 #endif
    USE sbc_oce          ! Surface boundary condition variables.
+   USE diaobs, ONLY: calc_date     ! Compute the calendar date on a given step
 
    IMPLICIT NONE
@@ -45,5 +45,4 @@
    
    PUBLIC   asm_inc_init   !: Initialize the increment arrays and IAU weights
-   PUBLIC   calc_date      !: Compute the calendar date YYYYMMDD on a given step
    PUBLIC   tra_asm_inc    !: Apply the tracer (T and S) increments
    PUBLIC   dyn_asm_inc    !: Apply the dynamic (u and v) increments
@@ -56,14 +55,14 @@
     LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .FALSE.  !: No assimilation increments
 #endif
-   LOGICAL, PUBLIC :: ln_bkgwri = .FALSE.      !: No output of the background state fields
-   LOGICAL, PUBLIC :: ln_asmiau = .FALSE.      !: No applying forcing with an assimilation increment
-   LOGICAL, PUBLIC :: ln_asmdin = .FALSE.      !: No direct initialization
-   LOGICAL, PUBLIC :: ln_trainc = .FALSE.      !: No tracer (T and S) assimilation increments
-   LOGICAL, PUBLIC :: ln_dyninc = .FALSE.      !: No dynamics (u and v) assimilation increments
-   LOGICAL, PUBLIC :: ln_sshinc = .FALSE.      !: No sea surface height assimilation increment
-   LOGICAL, PUBLIC :: ln_seaiceinc             !: No sea ice concentration increment
-   LOGICAL, PUBLIC :: ln_salfix = .FALSE.      !: Apply minimum salinity check
+   LOGICAL, PUBLIC :: ln_bkgwri     !: No output of the background state fields
+   LOGICAL, PUBLIC :: ln_asmiau     !: No applying forcing with an assimilation increment
+   LOGICAL, PUBLIC :: ln_asmdin     !: No direct initialization
+   LOGICAL, PUBLIC :: ln_trainc     !: No tracer (T and S) assimilation increments
+   LOGICAL, PUBLIC :: ln_dyninc     !: No dynamics (u and v) assimilation increments
+   LOGICAL, PUBLIC :: ln_sshinc     !: No sea surface height assimilation increment
+   LOGICAL, PUBLIC :: ln_seaiceinc  !: No sea ice concentration increment
+   LOGICAL, PUBLIC :: ln_salfix     !: Apply minimum salinity check
    LOGICAL, PUBLIC :: ln_temnofreeze = .FALSE. !: Don't allow the temperature to drop below freezing
-   INTEGER, PUBLIC :: nn_divdmp                !: Apply divergence damping filter nn_divdmp times
+   INTEGER, PUBLIC :: nn_divdmp     !: Apply divergence damping filter nn_divdmp times
 
    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   t_bkg   , s_bkg      !: Background temperature and salinity
@@ -89,9 +88,7 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldfdyn_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -114,10 +111,10 @@
       INTEGER :: iiauper         ! Number of time steps in the IAU period
       INTEGER :: icycper         ! Number of time steps in the cycle
-      INTEGER :: iitend_date     ! Date YYYYMMDD of final time step
-      INTEGER :: iitbkg_date     ! Date YYYYMMDD of background time step for Jb term
-      INTEGER :: iitdin_date     ! Date YYYYMMDD of background time step for DI
-      INTEGER :: iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step
-      INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step
-      !
+      REAL(KIND=dp) :: ditend_date     ! Date YYYYMMDD.HHMMSS of final time step
+      REAL(KIND=dp) :: ditbkg_date     ! Date YYYYMMDD.HHMMSS of background time step for Jb term
+      REAL(KIND=dp) :: ditdin_date     ! Date YYYYMMDD.HHMMSS of background time step for DI
+      REAL(KIND=dp) :: ditiaustr_date  ! Date YYYYMMDD.HHMMSS of IAU interval start time step
+      REAL(KIND=dp) :: ditiaufin_date  ! Date YYYYMMDD.HHMMSS of IAU interval final time step
+
       REAL(wp) :: znorm        ! Normalization factor for IAU weights
       REAL(wp) :: ztotwgt      ! Value of time-integrated IAU weights (should be equal to one)
@@ -139,5 +136,5 @@
       ! Read Namelist nam_asminc : assimilation increment interface
       !-----------------------------------------------------------------------
-      ln_seaiceinc = .FALSE.
+      ln_seaiceinc   = .FALSE.
       ln_temnofreeze = .FALSE.
 
@@ -181,10 +178,19 @@
       icycper = nitend      - nit000      + 1  ! Cycle interval length
 
-      CALL calc_date( nit000, nitend     , ndate0, iitend_date    )     ! Date of final time step
-      CALL calc_date( nit000, nitbkg_r   , ndate0, iitbkg_date    )     ! Background time for Jb referenced to ndate0
-      CALL calc_date( nit000, nitdin_r   , ndate0, iitdin_date    )     ! Background time for DI referenced to ndate0
-      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
-      !
+      ! Date of final time step
+      CALL calc_date( nitend, ditend_date )
+
+      ! Background time for Jb referenced to ndate0
+      CALL calc_date( nitbkg_r, ditbkg_date )
+
+      ! Background time for DI referenced to ndate0
+      CALL calc_date( nitdin_r, ditdin_date )
+
+      ! IAU start time referenced to ndate0
+      CALL calc_date( nitiaustr_r, ditiaustr_date )
+
+      ! IAU end time referenced to ndate0
+      CALL calc_date( nitiaufin_r, ditiaufin_date )
+
       IF(lwp) THEN
          WRITE(numout,*)
@@ -201,15 +207,12 @@
          WRITE(numout,*) '       ndastp         = ', ndastp
          WRITE(numout,*) '       ndate0         = ', ndate0
-         WRITE(numout,*) '       iitend_date    = ', iitend_date
-         WRITE(numout,*) '       iitbkg_date    = ', iitbkg_date
-         WRITE(numout,*) '       iitdin_date    = ', iitdin_date
-         WRITE(numout,*) '       iitiaustr_date = ', iitiaustr_date
-         WRITE(numout,*) '       iitiaufin_date = ', iitiaufin_date
+         WRITE(numout,*) '       nn_time0       = ', nn_time0
+         WRITE(numout,*) '       ditend_date    = ', ditend_date
+         WRITE(numout,*) '       ditbkg_date    = ', ditbkg_date
+         WRITE(numout,*) '       ditdin_date    = ', ditdin_date
+         WRITE(numout,*) '       ditiaustr_date = ', ditiaustr_date
+         WRITE(numout,*) '       ditiaufin_date = ', ditiaufin_date
       ENDIF
 
-      IF ( nacc /= 0 ) &
-         & CALL ctl_stop( ' nacc /= 0 and key_asminc :',  &
-         &                ' Assimilation increments have only been implemented', &
-         &                ' for synchronous time stepping' )
 
       IF ( ( ln_asmdin ).AND.( ln_asmiau ) )   &
@@ -363,15 +366,15 @@
             WRITE(numout,*) 
             WRITE(numout,*) 'asm_inc_init : Assimilation increments valid ', &
-               &            ' between dates ', NINT( z_inc_dateb ),' and ',  &
-               &            NINT( z_inc_datef )
+               &            ' between dates ', z_inc_dateb,' and ',  &
+               &            z_inc_datef
             WRITE(numout,*) '~~~~~~~~~~~~'
          ENDIF
 
-         IF (     ( NINT( z_inc_dateb ) < ndastp      ) &
-            & .OR.( NINT( z_inc_datef ) > iitend_date ) ) &
+         IF (     ( z_inc_dateb < ndastp + nn_time0*0.0001_wp ) &
+            & .OR.( z_inc_datef > ditend_date ) ) &
             & CALL ctl_warn( ' Validity time of assimilation increments is ', &
             &                ' outside the assimilation interval' )
 
-         IF ( ( ln_asmdin ).AND.( NINT( zdate_inc ) /= iitdin_date ) ) &
+         IF ( ( ln_asmdin ).AND.( zdate_inc /= ditdin_date ) ) &
             & CALL ctl_warn( ' Validity time of assimilation increments does ', &
             &                ' not agree with Direct Initialization time' )
@@ -428,46 +431,36 @@
 
       IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN
-
-         CALL wrk_alloc(jpi,jpj,hdiv) 
-
-         DO  jt = 1, nn_divdmp
-
-            DO jk = 1, jpkm1
-
+         !
+         CALL wrk_alloc( jpi,jpj,   hdiv ) 
+         !
+         DO jt = 1, nn_divdmp
+            !
+            DO jk = 1, jpkm1           ! hdiv = e1e1 * div
                hdiv(:,:) = 0._wp
-
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     hdiv(ji,jj) =   &
-                        (  e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk) * u_bkginc(ji  ,jj  ,jk)     &
-                         - e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk) * u_bkginc(ji-1,jj  ,jk)     &
-                         + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * v_bkginc(ji  ,jj  ,jk)     &
-                         - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * v_bkginc(ji  ,jj-1,jk)  )  &
-                         / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                     hdiv(ji,jj) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * u_bkginc(ji  ,jj,jk)    &
+                        &           - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * u_bkginc(ji-1,jj,jk)    &
+                        &           + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * v_bkginc(ji,jj  ,jk)    &
+                        &           - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * v_bkginc(ji,jj-1,jk)  ) / e3t_n(ji,jj,jk)
                   END DO
                END DO
-
                CALL lbc_lnk( hdiv, 'T', 1. )   ! lateral boundary cond. (no sign change)
-
+               !
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1t(ji+1,jj)*e2t(ji+1,jj) * hdiv(ji+1,jj)   &
-                                                                        - e1t(ji  ,jj)*e2t(ji  ,jj) * hdiv(ji  ,jj) ) &
-                                                                      / e1u(ji,jj) * umask(ji,jj,jk) 
-                     v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1t(ji,jj+1)*e2t(ji,jj+1) * hdiv(ji,jj+1)   &
-                                                                        - e1t(ji,jj  )*e2t(ji,jj  ) * hdiv(ji,jj  ) ) &
-                                                                      / e2v(ji,jj) * vmask(ji,jj,jk) 
+                     u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk)                         &
+                        &               + 0.2_wp * ( hdiv(ji+1,jj) - hdiv(ji  ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
+                     v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk)                         &
+                        &               + 0.2_wp * ( hdiv(ji,jj+1) - hdiv(ji,jj  ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
                   END DO
                END DO
-
             END DO
-
+            !
          END DO
-
-         CALL wrk_dealloc(jpi,jpj,hdiv) 
-
+         !
+         CALL wrk_dealloc( jpi,jpj,   hdiv ) 
+         !
       ENDIF
-
-
 
       !-----------------------------------------------------------------------
@@ -476,5 +469,5 @@
 
       IF ( ln_asmdin ) THEN
-
+         !
          ALLOCATE( t_bkg(jpi,jpj,jpk) )
          ALLOCATE( s_bkg(jpi,jpj,jpk) )
@@ -482,30 +475,30 @@
          ALLOCATE( v_bkg(jpi,jpj,jpk) )
          ALLOCATE( ssh_bkg(jpi,jpj)   )
-
-         t_bkg(:,:,:) = 0.0
-         s_bkg(:,:,:) = 0.0
-         u_bkg(:,:,:) = 0.0
-         v_bkg(:,:,:) = 0.0
-         ssh_bkg(:,:) = 0.0
-
+         !
+         t_bkg(:,:,:) = 0._wp
+         s_bkg(:,:,:) = 0._wp
+         u_bkg(:,:,:) = 0._wp
+         v_bkg(:,:,:) = 0._wp
+         ssh_bkg(:,:) = 0._wp
+         !
          !--------------------------------------------------------------------
          ! Read from file the background state at analysis time
          !--------------------------------------------------------------------
-
+         !
          CALL iom_open( c_asmdin, inum )
-
+         !
          CALL iom_get( inum, 'rdastp', zdate_bkg ) 
-        
+         !
          IF(lwp) THEN
             WRITE(numout,*) 
             WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', &
-               &  NINT( zdate_bkg )
+               &  zdate_bkg
             WRITE(numout,*) '~~~~~~~~~~~~'
          ENDIF
-
-         IF ( NINT( zdate_bkg ) /= iitdin_date ) &
+         !
+         IF ( zdate_bkg /= ditdin_date ) &
             & CALL ctl_warn( ' Validity time of assimilation background state does', &
             &                ' not agree with Direct Initialization time' )
-
+         !
          IF ( ln_trainc ) THEN   
             CALL iom_get( inum, jpdom_autoglo, 'tn', t_bkg )
@@ -514,5 +507,5 @@
             s_bkg(:,:,:) = s_bkg(:,:,:) * tmask(:,:,:)
          ENDIF
-
+         !
          IF ( ln_dyninc ) THEN   
             CALL iom_get( inum, jpdom_autoglo, 'un', u_bkg )
@@ -521,119 +514,15 @@
             v_bkg(:,:,:) = v_bkg(:,:,:) * vmask(:,:,:)
          ENDIF
-        
+         !
          IF ( ln_sshinc ) THEN
             CALL iom_get( inum, jpdom_autoglo, 'sshn', ssh_bkg )
             ssh_bkg(:,:) = ssh_bkg(:,:) * tmask(:,:,1)
          ENDIF
-
+         !
          CALL iom_close( inum )
-
+         !
       ENDIF
       !
    END SUBROUTINE asm_inc_init
-
-
-   SUBROUTINE calc_date( kit000, kt, kdate0, kdate )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE calc_date  ***
-      !!          
-      !! ** Purpose : Compute the calendar date YYYYMMDD at a given time step.
-      !!
-      !! ** Method  : Compute the calendar date YYYYMMDD at a given time step.
-      !!
-      !! ** Action  : 
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(IN) :: kit000  ! Initial time step
-      INTEGER, INTENT(IN) :: kt      ! Current time step referenced to kit000
-      INTEGER, INTENT(IN) :: kdate0  ! Initial date
-      INTEGER, INTENT(OUT) :: kdate  ! Current date reference to kdate0
-      !
-      INTEGER :: iyea0    ! Initial year
-      INTEGER :: imon0    ! Initial month
-      INTEGER :: iday0    ! Initial day
-      INTEGER :: iyea     ! Current year
-      INTEGER :: imon     ! Current month
-      INTEGER :: iday     ! Current day
-      INTEGER :: idaystp  ! Number of days between initial and current date
-      INTEGER :: idaycnt  ! Day counter
-
-      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
-
-      !-----------------------------------------------------------------------
-      ! Compute the calendar date YYYYMMDD
-      !-----------------------------------------------------------------------
-
-      ! Initial date
-      iyea0 =   kdate0 / 10000
-      imon0 = ( kdate0 - ( iyea0 * 10000 ) ) / 100
-      iday0 =   kdate0 - ( iyea0 * 10000 ) - ( imon0 * 100 ) 
-
-      ! Check that kt >= kit000 - 1
-      IF ( kt < kit000 - 1 ) CALL ctl_stop( ' kt must be >= kit000 - 1')
-
-      ! If kt = kit000 - 1 then set the date to the restart date
-      IF ( kt == kit000 - 1 ) THEN
-
-         kdate = ndastp
-         RETURN
-
-      ENDIF
-
-      ! Compute the number of days from the initial date
-      idaystp = INT( REAL( kt - kit000 ) * rdt / 86400. )
-   
-      iday    = iday0
-      imon    = imon0
-      iyea    = iyea0
-      idaycnt = 0
-
-      CALL calc_month_len( iyea, imonth_len )
-
-      DO WHILE ( idaycnt < idaystp )
-         iday = iday + 1
-         IF ( iday > imonth_len(imon) )  THEN
-            iday = 1
-            imon = imon + 1
-         ENDIF
-         IF ( imon > 12 ) THEN
-            imon = 1
-            iyea = iyea + 1
-            CALL calc_month_len( iyea, imonth_len )  ! update month lengths
-         ENDIF                 
-         idaycnt = idaycnt + 1
-      END DO
-      !
-      kdate = iyea * 10000 + imon * 100 + iday
-      !
-   END SUBROUTINE
-
-
-   SUBROUTINE calc_month_len( iyear, imonth_len )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE calc_month_len  ***
-      !!          
-      !! ** Purpose : Compute the number of days in a months given a year.
-      !!
-      !! ** Method  : 
-      !!----------------------------------------------------------------------
-      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
-      INTEGER :: iyear         !: year
-      !!----------------------------------------------------------------------
-      !
-      ! length of the month of the current year (from nleapy, read in namelist)
-      IF ( nleapy < 2 ) THEN 
-         imonth_len(:) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
-         IF ( nleapy == 1 ) THEN   ! we are using calendar with leap years
-            IF ( MOD(iyear, 4) == 0 .AND. ( MOD(iyear, 400) == 0 .OR. MOD(iyear, 100) /= 0 ) ) THEN
-               imonth_len(2) = 29
-            ENDIF
-         ENDIF
-      ELSE
-         imonth_len(:) = nleapy   ! all months with nleapy days per year
-      ENDIF
-      !
-   END SUBROUTINE
-
-
    SUBROUTINE tra_asm_inc( kt )
       !!----------------------------------------------------------------------
@@ -646,30 +535,27 @@
       !! ** Action  : 
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(IN) :: kt               ! Current time step
-      !
-      INTEGER :: ji,jj,jk
-      INTEGER :: it
+      INTEGER, INTENT(IN) ::   kt   ! Current time step
+      !
+      INTEGER  :: ji, jj, jk
+      INTEGER  :: it
       REAL(wp) :: zincwgt  ! IAU weight for current time step
       REAL (wp), DIMENSION(jpi,jpj,jpk) :: fzptnz ! 3d freezing point values
       !!----------------------------------------------------------------------
-
+      !
       ! freezing point calculation taken from oc_fz_pt (but calculated for all depths) 
       ! used to prevent the applied increments taking the temperature below the local freezing point 
-
       DO jk = 1, jpkm1
-        CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), fsdept(:,:,jk) )
+        CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), gdept_n(:,:,jk) )
       END DO
-
-      IF ( ln_asmiau ) THEN
-
-         !--------------------------------------------------------------------
-         ! Incremental Analysis Updating
-         !--------------------------------------------------------------------
-
+         !
+         !                             !--------------------------------------
+      IF ( ln_asmiau ) THEN            ! Incremental Analysis Updating
+         !                             !--------------------------------------
+         !
          IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
-
+            !
             it = kt - nit000 + 1
             zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
-
+            !
             IF(lwp) THEN
                WRITE(numout,*) 
@@ -677,5 +563,5 @@
                WRITE(numout,*) '~~~~~~~~~~~~'
             ENDIF
-
+            !
             ! Update the tracer tendencies
             DO jk = 1, jpkm1
@@ -700,23 +586,19 @@
                ENDIF
             END DO
-
-         ENDIF
-
+            !
+         ENDIF
+         !
          IF ( kt == nitiaufin_r + 1  ) THEN   ! For bias crcn to work
             DEALLOCATE( t_bkginc )
             DEALLOCATE( s_bkginc )
          ENDIF
-
-
-      ELSEIF ( ln_asmdin ) THEN
-
-         !--------------------------------------------------------------------
-         ! Direct Initialization
-         !--------------------------------------------------------------------
-            
+         !                             !--------------------------------------
+      ELSEIF ( ln_asmdin ) THEN        ! Direct Initialization
+         !                             !--------------------------------------
+         !            
          IF ( kt == nitdin_r ) THEN
-
+            !
             neuler = 0  ! Force Euler forward step
-
+            !
             ! Initialize the now fields with the background + increment
             IF (ln_temnofreeze) THEN
@@ -745,17 +627,10 @@
 !!gm
 
-
             IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)      &
                &  CALL zps_hde    ( kt, jpts, tsb, gtsu, gtsv,        &  ! Partial steps: before horizontal gradient
                &                              rhd, gru , grv          )  ! of t, s, rd at the last ocean level
             IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)      &
-               &  CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv,    &    ! Partial steps for top cell (ISF)
-               &                                  rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
-               &                           gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
-
-#if defined key_zdfkpp
-            CALL eos( tsn, rhd, fsdept_n(:,:,:) )                      ! Compute rhd
-!!gm fabien            CALL eos( tsn, rhd )                      ! Compute rhd
-#endif
+               &  CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, gtui, gtvi,    &    ! Partial steps for top cell (ISF)
+               &                                  rhd, gru , grv , grui, grvi     )    ! of t, s, rd at the last ocean level
 
             DEALLOCATE( t_bkginc )
@@ -767,5 +642,5 @@
       ENDIF
       ! Perhaps the following call should be in step
-      IF   ( ln_seaiceinc  )   CALL seaice_asm_inc ( kt )   ! apply sea ice concentration increment
+      IF ( ln_seaiceinc  )   CALL seaice_asm_inc ( kt )   ! apply sea ice concentration increment
       !
    END SUBROUTINE tra_asm_inc
@@ -788,23 +663,20 @@
       REAL(wp) :: zincwgt  ! IAU weight for current time step
       !!----------------------------------------------------------------------
-
-      IF ( ln_asmiau ) THEN
-
-         !--------------------------------------------------------------------
-         ! Incremental Analysis Updating
-         !--------------------------------------------------------------------
-
+      !
+      !                          !--------------------------------------------
+      IF ( ln_asmiau ) THEN      ! Incremental Analysis Updating
+         !                       !--------------------------------------------
+         !
          IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
-
+            !
             it = kt - nit000 + 1
             zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
-
+            !
             IF(lwp) THEN
                WRITE(numout,*) 
-               WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', &
-                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', kt,' with IAU weight = ', wgtiau(it)
                WRITE(numout,*) '~~~~~~~~~~~~'
             ENDIF
-
+            !
             ! Update the dynamic tendencies
             DO jk = 1, jpkm1
@@ -812,29 +684,26 @@
                va(:,:,jk) = va(:,:,jk) + v_bkginc(:,:,jk) * zincwgt
             END DO
-           
+            !
             IF ( kt == nitiaufin_r ) THEN
                DEALLOCATE( u_bkginc )
                DEALLOCATE( v_bkginc )
             ENDIF
-
-         ENDIF
-
-      ELSEIF ( ln_asmdin ) THEN 
-
-         !--------------------------------------------------------------------
-         ! Direct Initialization
-         !--------------------------------------------------------------------
-         
+            !
+         ENDIF
+         !                          !-----------------------------------------
+      ELSEIF ( ln_asmdin ) THEN     ! Direct Initialization
+         !                          !-----------------------------------------
+         !         
          IF ( kt == nitdin_r ) THEN
-
+            !
             neuler = 0                    ! Force Euler forward step
-
+            !
             ! Initialize the now fields with the background + increment
             un(:,:,:) = u_bkg(:,:,:) + u_bkginc(:,:,:)
             vn(:,:,:) = v_bkg(:,:,:) + v_bkginc(:,:,:)  
-
+            !
             ub(:,:,:) = un(:,:,:)         ! Update before fields
             vb(:,:,:) = vn(:,:,:)
- 
+            !
             DEALLOCATE( u_bkg    )
             DEALLOCATE( v_bkg    )
@@ -864,16 +733,14 @@
       REAL(wp) :: zincwgt  ! IAU weight for current time step
       !!----------------------------------------------------------------------
-
-      IF ( ln_asmiau ) THEN
-
-         !--------------------------------------------------------------------
-         ! Incremental Analysis Updating
-         !--------------------------------------------------------------------
-
+      !
+      !                             !-----------------------------------------
+      IF ( ln_asmiau ) THEN         ! Incremental Analysis Updating
+         !                          !-----------------------------------------
+         !
          IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
-
+            !
             it = kt - nit000 + 1
             zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
-
+            !
             IF(lwp) THEN
                WRITE(numout,*) 
@@ -882,5 +749,5 @@
                WRITE(numout,*) '~~~~~~~~~~~~'
             ENDIF
-
+            !
             ! Save the tendency associated with the IAU weighted SSH increment
             ! (applied in dynspg.*)
@@ -891,32 +758,23 @@
                DEALLOCATE( ssh_bkginc )
             ENDIF
-
-         ENDIF
-
-      ELSEIF ( ln_asmdin ) THEN
-
-         !--------------------------------------------------------------------
-         ! Direct Initialization
-         !--------------------------------------------------------------------
-
+            !
+         ENDIF
+         !                          !-----------------------------------------
+      ELSEIF ( ln_asmdin ) THEN     ! Direct Initialization
+         !                          !-----------------------------------------
+         !
          IF ( kt == nitdin_r ) THEN
-
-            neuler = 0                    ! Force Euler forward step
-
-            ! Initialize the now fields the background + increment
-            sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:)  
-
-            ! Update before fields
-            sshb(:,:) = sshn(:,:)         
-
-            IF( lk_vvl ) THEN
-               DO jk = 1, jpk
-                  fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
-               END DO
-            ENDIF
-
+            !
+            neuler = 0                                   ! Force Euler forward step
+            !
+            sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:)   ! Initialize the now fields the background + increment
+            !
+            sshb(:,:) = sshn(:,:)                        ! Update before fields
+            e3t_b(:,:,:) = e3t_n(:,:,:)
+!!gm why not e3u_b, e3v_b, gdept_b ????
+            !
             DEALLOCATE( ssh_bkg    )
             DEALLOCATE( ssh_bkginc )
-
+            !
          ENDIF
          !
@@ -937,7 +795,5 @@
       !!
       !!----------------------------------------------------------------------
-      IMPLICIT NONE
-      !
-      INTEGER, INTENT(in)           ::   kt   ! Current time step
+      INTEGER, INTENT(in)           ::   kt       ! Current time step
       INTEGER, INTENT(in), OPTIONAL ::   kindic   ! flag for disabling the deallocation
       !
@@ -949,26 +805,23 @@
 #endif
       !!----------------------------------------------------------------------
-
-      IF ( ln_asmiau ) THEN
-
-         !--------------------------------------------------------------------
-         ! Incremental Analysis Updating
-         !--------------------------------------------------------------------
-
+      !
+      !                             !-----------------------------------------
+      IF ( ln_asmiau ) THEN         ! Incremental Analysis Updating
+         !                          !-----------------------------------------
+         !
          IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
-
+            !
             it = kt - nit000 + 1
             zincwgt = wgtiau(it)      ! IAU weight for the current time step 
             ! note this is not a tendency so should not be divided by rdt (as with the tracer and other increments)
-
+            !
             IF(lwp) THEN
                WRITE(numout,*) 
-               WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', &
-                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it)
                WRITE(numout,*) '~~~~~~~~~~~~'
             ENDIF
-
+            !
             ! Sea-ice : LIM-3 case (to add)
-
+            !
 #if defined key_lim2
             ! Sea-ice : LIM-2 case
@@ -1008,22 +861,18 @@
 
 #if defined key_cice && defined key_asminc
-            ! Sea-ice : CICE case. Zero ice increment tendency into CICE
-            ndaice_da(:,:) = 0.0_wp
-#endif
-
-         ENDIF
-
-      ELSEIF ( ln_asmdin ) THEN
-
-         !--------------------------------------------------------------------
-         ! Direct Initialization
-         !--------------------------------------------------------------------
-
+            ndaice_da(:,:) = 0._wp        ! Sea-ice : CICE case. Zero ice increment tendency into CICE
+#endif
+
+         ENDIF
+         !                          !-----------------------------------------
+      ELSEIF ( ln_asmdin ) THEN     ! Direct Initialization
+         !                          !-----------------------------------------
+         !
          IF ( kt == nitdin_r ) THEN
-
+            !
             neuler = 0                    ! Force Euler forward step
-
+            !
             ! Sea-ice : LIM-3 case (to add)
-
+            !
 #if defined key_lim2
             ! Sea-ice : LIM-2 case.
@@ -1041,5 +890,5 @@
                zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt    
             ELSEWHERE
-               zhicifinc(:,:) = 0.0_wp
+               zhicifinc(:,:) = 0._wp
             END WHERE
             !
@@ -1050,20 +899,20 @@
             ! seaice salinity balancing (to add)
 #endif
- 
+            !
 #if defined key_cice && defined key_asminc
             ! Sea-ice : CICE case. Pass ice increment tendency into CICE
            ndaice_da(:,:) = seaice_bkginc(:,:) / rdt
 #endif
-           IF ( .NOT. PRESENT(kindic) ) THEN
-              DEALLOCATE( seaice_bkginc )
-           END IF
-
+            IF ( .NOT. PRESENT(kindic) ) THEN
+               DEALLOCATE( seaice_bkginc )
+            END IF
+            !
          ELSE
-
+            !
 #if defined key_cice && defined key_asminc
-            ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
-            ndaice_da(:,:) = 0.0_wp
-#endif
-         
+            ndaice_da(:,:) = 0._wp     ! Sea-ice : CICE case. Zero ice increment tendency into CICE
+
+#endif
+            !
          ENDIF
 
@@ -1142,7 +991,7 @@
 !
 !#endif
-
+         !
       ENDIF
-
+      !
    END SUBROUTINE seaice_asm_inc
    
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 6808)
@@ -6,27 +6,19 @@
 
    IMPLICIT NONE
-
-   !! * Routine accessibility
    PRIVATE
 
-   !! * Shared Modules variables
-   CHARACTER (LEN=40), PUBLIC, PARAMETER :: &
-      & c_asmbkg = 'assim_background_state_Jb',  & !: Filename for storing the 
-                                                   !: background state for use 
-                                                   !: in the Jb term
-      & c_asmdin = 'assim_background_state_DI',  & !: Filename for storing the 
-                                                   !: background state for direct 
-                                                   !: initialization
-      & c_asmtrj = 'assim_trj',                  & !: Filename for storing the 
-                                                   !: reference trajectory
-      & c_asminc = 'assim_background_increments'   !: Filename for storing the 
-                                                   !: increments to the background
-                                                   !: state
+   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmbkg = 'assim_background_state_Jb'   !: Filename for storing the background state
+   !                                                                                  !  for use in the Jb term
+   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmdin = 'assim_background_state_DI'   !: Filename for storing the background state
+   !                                                                                  !  for direct initialization
+   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmtrj = 'assim_trj'                   !: Filename for storing the reference trajectory
+   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asminc = 'assim_background_increments' !: Filename for storing the increments 
+   !                                                                                  !  to the background state
 
-   INTEGER, PUBLIC :: nitbkg_r      !: Background time step referenced to nit000
-   INTEGER, PUBLIC :: nitdin_r      !: Direct Initialization time step referenced to nit000
-   INTEGER, PUBLIC :: nitiaustr_r   !: IAU starting time step referenced to nit000
-   INTEGER, PUBLIC :: nitiaufin_r   !: IAU final time step referenced to nit000
-   INTEGER, PUBLIC :: nittrjfrq     !: Frequency of trajectory output for 4D-VAR
+   INTEGER, PUBLIC ::   nitbkg_r      !: Background time step referenced to nit000
+   INTEGER, PUBLIC ::   nitdin_r      !: Direct Initialization time step referenced to nit000
+   INTEGER, PUBLIC ::   nitiaustr_r   !: IAU starting time step referenced to nit000
+   INTEGER, PUBLIC ::   nitiaufin_r   !: IAU final time step referenced to nit000
+   INTEGER, PUBLIC ::   nittrjfrq     !: Frequency of trajectory output for 4D-VAR
 
    !!----------------------------------------------------------------------
@@ -34,5 +26,4 @@
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !!======================================================================
 END MODULE asmpar
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 6808)
@@ -8,5 +8,5 @@
    !!            3.3  !  2010-09  (D. Storkey) add ice boundary conditions
    !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
-   !!            3.6  !  2012-01  (C. Rousset) add ice boundary conditions for lim3
+   !!            3.6  !  2014-01  (C. Rousset) add ice boundary conditions for lim3
    !!----------------------------------------------------------------------
 #if defined key_bdy 
@@ -22,15 +22,15 @@
 
    TYPE, PUBLIC ::   OBC_INDEX    !: Indices and weights which define the open boundary
-      INTEGER,          DIMENSION(jpbgrd) ::  nblen
-      INTEGER,          DIMENSION(jpbgrd) ::  nblenrim
-      INTEGER, POINTER, DIMENSION(:,:)   ::  nbi
-      INTEGER, POINTER, DIMENSION(:,:)   ::  nbj
-      INTEGER, POINTER, DIMENSION(:,:)   ::  nbr
-      INTEGER, POINTER, DIMENSION(:,:)   ::  nbmap
-      REAL(wp)   , POINTER, DIMENSION(:,:)   ::  nbw
-      REAL(wp)   , POINTER, DIMENSION(:,:)   ::  nbd
-      REAL(wp)   , POINTER, DIMENSION(:,:)   ::  nbdout
-      REAL(wp)   , POINTER, DIMENSION(:,:)   ::  flagu
-      REAL(wp)   , POINTER, DIMENSION(:,:)   ::  flagv
+      INTEGER ,          DIMENSION(jpbgrd) ::  nblen
+      INTEGER ,          DIMENSION(jpbgrd) ::  nblenrim
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbi
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbj
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbr
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbmap
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbw
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbd
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbdout
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagu
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagv
    END TYPE OBC_INDEX
 
@@ -41,33 +41,39 @@
 
    TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data
-      INTEGER,       DIMENSION(2)     ::  nread
-      LOGICAL                         ::  ll_ssh
-      LOGICAL                         ::  ll_u2d
-      LOGICAL                         ::  ll_v2d
-      LOGICAL                         ::  ll_u3d
-      LOGICAL                         ::  ll_v3d
-      LOGICAL                         ::  ll_tem
-      LOGICAL                         ::  ll_sal
-      REAL(wp), POINTER, DIMENSION(:)     ::  ssh
-      REAL(wp), POINTER, DIMENSION(:)     ::  u2d
-      REAL(wp), POINTER, DIMENSION(:)     ::  v2d
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  u3d
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  v3d
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  tem
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  sal
+      INTEGER          , DIMENSION(2)   ::  nread
+      LOGICAL                           ::  ll_ssh
+      LOGICAL                           ::  ll_u2d
+      LOGICAL                           ::  ll_v2d
+      LOGICAL                           ::  ll_u3d
+      LOGICAL                           ::  ll_v3d
+      LOGICAL                           ::  ll_tem
+      LOGICAL                           ::  ll_sal
+      REAL(wp), POINTER, DIMENSION(:)   ::  ssh
+      REAL(wp), POINTER, DIMENSION(:)   ::  u2d
+      REAL(wp), POINTER, DIMENSION(:)   ::  v2d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  u3d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  v3d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  tem
+      REAL(wp), POINTER, DIMENSION(:,:) ::  sal
 #if defined key_lim2
-      LOGICAL                         ::  ll_frld
-      LOGICAL                         ::  ll_hicif
-      LOGICAL                         ::  ll_hsnif
-      REAL(wp), POINTER, DIMENSION(:)     ::  frld
-      REAL(wp), POINTER, DIMENSION(:)     ::  hicif
-      REAL(wp), POINTER, DIMENSION(:)     ::  hsnif
+      LOGICAL                           ::   ll_frld
+      LOGICAL                           ::   ll_hicif
+      LOGICAL                           ::   ll_hsnif
+      REAL(wp), POINTER, DIMENSION(:)   ::   frld
+      REAL(wp), POINTER, DIMENSION(:)   ::   hicif
+      REAL(wp), POINTER, DIMENSION(:)   ::   hsnif
 #elif defined key_lim3
-      LOGICAL                         ::  ll_a_i
-      LOGICAL                         ::  ll_ht_i
-      LOGICAL                         ::  ll_ht_s
-      REAL, POINTER, DIMENSION(:,:)   ::  a_i   !: now ice leads fraction climatology
-      REAL, POINTER, DIMENSION(:,:)   ::  ht_i  !: Now ice  thickness climatology
-      REAL, POINTER, DIMENSION(:,:)   ::  ht_s  !: now snow thickness
+      LOGICAL                           ::   ll_a_i
+      LOGICAL                           ::   ll_ht_i
+      LOGICAL                           ::   ll_ht_s
+      REAL(wp), POINTER, DIMENSION(:,:) ::   a_i    !: now ice leads fraction climatology
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ht_i   !: Now ice  thickness climatology
+      REAL(wp), 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
@@ -99,15 +105,15 @@
    INTEGER, DIMENSION(jp_bdy)           ::   nn_tra_dta     !: = 0 use the initial state as bdy dta ; 
                                                             !: = 1 read it in a NetCDF file
-   LOGICAL, DIMENSION(jp_bdy) ::   ln_tra_dmp               !: =T Tracer damping
-   LOGICAL, DIMENSION(jp_bdy) ::   ln_dyn3d_dmp             !: =T Baroclinic velocity damping
-   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
+   LOGICAL , DIMENSION(jp_bdy) ::   ln_tra_dmp              !: =T Tracer damping
+   LOGICAL , DIMENSION(jp_bdy) ::   ln_dyn3d_dmp            !: =T Baroclinic velocity damping
+   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
 
    CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_ice_lim       ! Choice of boundary condition for sea ice variables 
-   INTEGER, DIMENSION(jp_bdy)           ::   nn_ice_lim_dta   !: = 0 use the initial state as bdy dta ; 
+   INTEGER , DIMENSION(jp_bdy)          ::   nn_ice_lim_dta   !: = 0 use the initial state as bdy dta ; 
                                                               !: = 1 read it in a NetCDF file
-   REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_tem             !: choice of the temperature of incoming sea ice
-   REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_sal             !: choice of the salinity    of incoming sea ice
-   REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_age             !: choice of the age         of incoming sea ice
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_tem              !: choice of the temperature of incoming sea ice
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_sal              !: choice of the salinity    of incoming sea ice
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_age              !: choice of the age         of incoming sea ice
    !
    
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 6808)
@@ -29,5 +29,4 @@
    USE iom             ! IOM library
    USE in_out_manager  ! I/O logical units
-   USE dynspg_oce, ONLY: lk_dynspg_ts ! Split-explicit free surface flag
 #if defined key_lim2
    USE ice_2
@@ -46,5 +45,4 @@
    INTEGER, ALLOCATABLE, DIMENSION(:)   ::   nb_bdy_fld        ! Number of fields to update for each boundary set.
    INTEGER                              ::   nb_bdy_fld_sum    ! Total number of fields to update for all boundary sets.
-
    LOGICAL,           DIMENSION(jp_bdy) ::   ln_full_vel_array ! =T => full velocities in 3D boundary conditions
                                                                ! =F => baroclinic velocities in 3D boundary conditions
@@ -59,5 +57,4 @@
 #endif
 
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -76,26 +73,24 @@
       !!                
       !!----------------------------------------------------------------------
-      !!
-      INTEGER, INTENT( in )           ::   kt    ! ocean time-step index 
-      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option)
-      INTEGER, INTENT( in ), OPTIONAL ::   time_offset  ! time offset in units of timesteps. NB. if jit
-                                                        ! is present then units = subcycle timesteps.
-                                                        ! time_offset = 0 => get data at "now" time level
-                                                        ! time_offset = -1 => get data at "before" time level
-                                                        ! time_offset = +1 => get data at "after" time level
-                                                        ! etc.
-      !!
-      INTEGER     ::  ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd, jl  ! local indices
+      INTEGER, INTENT(in)           ::   kt           ! ocean time-step index 
+      INTEGER, INTENT(in), OPTIONAL ::   jit          ! subcycle time-step index (for timesplitting option)
+      INTEGER, INTENT(in), OPTIONAL ::   time_offset  ! time offset in units of timesteps. NB. if jit
+      !                                               ! is present then units = subcycle timesteps.
+      !                                               ! time_offset = 0 => get data at "now" time level
+      !                                               ! time_offset = -1 => get data at "before" time level
+      !                                               ! time_offset = +1 => get data at "after" time level
+      !                                               ! etc.
+      !
+      INTEGER ::  ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd, jl  ! local indices
       INTEGER,          DIMENSION(jpbgrd) ::   ilen1 
       INTEGER, POINTER, DIMENSION(:)      ::   nblen, nblenrim  ! short cuts
       TYPE(OBC_DATA), POINTER             ::   dta              ! short cut
-      !!
       !!---------------------------------------------------------------------------
-      !!
-      IF( nn_timing == 1 ) CALL timing_start('bdy_dta')
-
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_dta')
+      !
       ! Initialise data arrays once for all from initial conditions where required
       !---------------------------------------------------------------------------
-      IF( kt .eq. nit000 .and. .not. PRESENT(jit) ) THEN
+      IF( kt == nit000 .AND. .NOT.PRESENT(jit) ) THEN
 
          ! Calculate depth-mean currents
@@ -103,10 +98,10 @@
          
          DO ib_bdy = 1, nb_bdy
-
+            !
             nblen => idx_bdy(ib_bdy)%nblen
             nblenrim => idx_bdy(ib_bdy)%nblenrim
             dta => dta_bdy(ib_bdy)
 
-            IF( nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN 
+            IF( nn_dyn2d_dta(ib_bdy) == 0 ) THEN 
                ilen1(:) = nblen(:)
                IF( dta%ll_ssh ) THEN 
@@ -136,5 +131,5 @@
             ENDIF
 
-            IF( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 
+            IF( nn_dyn3d_dta(ib_bdy) == 0 ) THEN 
                ilen1(:) = nblen(:)
                IF( dta%ll_u3d ) THEN 
@@ -160,5 +155,5 @@
             ENDIF
 
-            IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 
+            IF( nn_tra_dta(ib_bdy) == 0 ) THEN 
                ilen1(:) = nblen(:)
                IF( dta%ll_tem ) THEN
@@ -185,5 +180,5 @@
 
 #if defined key_lim2
-            IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN 
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
                ilen1(:) = nblen(:)
                IF( dta%ll_frld ) THEN
@@ -213,5 +208,5 @@
             ENDIF
 #elif defined key_lim3
-            IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN 
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
                ilen1(:) = nblen(:)
                IF( dta%ll_a_i ) THEN
@@ -247,9 +242,7 @@
             ENDIF
 #endif
-
-         ENDDO ! ib_bdy
-
-
-      ENDIF ! kt .eq. nit000
+         END DO ! ib_bdy
+         !
+      ENDIF ! kt == nit000
 
       ! update external data from files
@@ -259,5 +252,5 @@
       DO ib_bdy = 1, nb_bdy   
          dta => dta_bdy(ib_bdy)
-         IF( nn_dta(ib_bdy) .eq. 1 ) THEN ! skip this bit if no external data required
+         IF( nn_dta(ib_bdy) == 1 ) THEN ! skip this bit if no external data required
       
             IF( PRESENT(jit) ) THEN
@@ -265,11 +258,11 @@
                ! jit is optional argument for fld_read and bdytide_update
                IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN
-                  IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
-                     IF( dta%ll_ssh ) dta%ssh(:) = 0.0
-                     IF( dta%ll_u2d ) dta%u2d(:) = 0.0
-                     IF( dta%ll_u3d ) dta%v2d(:) = 0.0
+                  IF( nn_dyn2d_dta(ib_bdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
+                     IF( dta%ll_ssh ) dta%ssh(:) = 0._wp
+                     IF( dta%ll_u2d ) dta%u2d(:) = 0._wp
+                     IF( dta%ll_u3d ) dta%v2d(:) = 0._wp
                   ENDIF
                   IF (cn_tra(ib_bdy) /= 'runoff') THEN
-                     IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 ) THEN
+                     IF( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 ) THEN
 
                         jend = jstart + dta%nread(2) - 1
@@ -279,9 +272,9 @@
                         ! If full velocities in boundary data then extract barotropic velocities from 3D fields
                         IF( ln_full_vel_array(ib_bdy) .AND.                                             &
-                          &    ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR.  &
-                          &      nn_dyn3d_dta(ib_bdy) .EQ. 1 ) )THEN
+                          &    ( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 .OR.  &
+                          &      nn_dyn3d_dta(ib_bdy) == 1 ) )THEN
 
                            igrd = 2                      ! zonal velocity
-                           dta%u2d(:) = 0.0
+                           dta%u2d(:) = 0._wp
                            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
                               ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
@@ -289,10 +282,10 @@
                               DO ik = 1, jpkm1
                                  dta%u2d(ib) = dta%u2d(ib) &
-                       &                          + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)
+                       &                          + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)
                               END DO
-                              dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij)
+                              dta%u2d(ib) =  dta%u2d(ib) * r1_hu_n(ii,ij)
                            END DO
                            igrd = 3                      ! meridional velocity
-                           dta%v2d(:) = 0.0
+                           dta%v2d(:) = 0._wp
                            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
                               ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
@@ -300,7 +293,7 @@
                               DO ik = 1, jpkm1
                                  dta%v2d(ib) = dta%v2d(ib) &
-                       &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)
+                       &                       + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)
                               END DO
-                              dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij)
+                              dta%v2d(ib) =  dta%v2d(ib) * r1_hv_n(ii,ij)
                            END DO
                         ENDIF                    
@@ -332,8 +325,8 @@
                   END DO
                ELSE
-                  IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
-                     IF( dta%ll_ssh ) dta%ssh(:) = 0.0
-                     IF( dta%ll_u2d ) dta%u2d(:) = 0.0
-                     IF( dta%ll_v2d ) dta%v2d(:) = 0.0
+                  IF( nn_dyn2d_dta(ib_bdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
+                     IF( dta%ll_ssh ) dta%ssh(:) = 0._wp
+                     IF( dta%ll_u2d ) dta%u2d(:) = 0._wp
+                     IF( dta%ll_v2d ) dta%v2d(:) = 0._wp
                   ENDIF
                   IF( dta%nread(1) .gt. 0 ) THEN ! update external data
@@ -344,8 +337,8 @@
                   ! If full velocities in boundary data then split into barotropic and baroclinic data
                   IF( ln_full_vel_array(ib_bdy) .and.                                             &
-                    & ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR. &
-                    &   nn_dyn3d_dta(ib_bdy) .EQ. 1 ) ) THEN
+                    & ( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 .OR. &
+                    &   nn_dyn3d_dta(ib_bdy) == 1 ) ) THEN
                      igrd = 2                      ! zonal velocity
-                     dta%u2d(:) = 0.0
+                     dta%u2d(:) = 0._wp
                      DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
                         ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
@@ -353,7 +346,7 @@
                         DO ik = 1, jpkm1
                            dta%u2d(ib) = dta%u2d(ib) &
-                 &                       + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)
+                 &                       + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)
                         END DO
-                        dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij)
+                        dta%u2d(ib) =  dta%u2d(ib) * r1_hu_n(ii,ij)
                         DO ik = 1, jpkm1
                            dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib)
@@ -361,5 +354,5 @@
                      END DO
                      igrd = 3                      ! meridional velocity
-                     dta%v2d(:) = 0.0
+                     dta%v2d(:) = 0._wp
                      DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
                         ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
@@ -367,7 +360,7 @@
                         DO ik = 1, jpkm1
                            dta%v2d(ib) = dta%v2d(ib) &
-                 &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)
+                 &                       + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)
                         END DO
-                        dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij)
+                        dta%v2d(ib) =  dta%v2d(ib) * r1_hv_n(ii,ij)
                         DO ik = 1, jpkm1
                            dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib)
@@ -388,10 +381,21 @@
       END DO  ! ib_bdy
 
-      ! bg jchanut tschanges
 #if defined key_tide
-      ! Add tides if not split-explicit free surface else this is done in ts loop
-      IF (.NOT.lk_dynspg_ts) CALL bdy_dta_tides( kt=kt, time_offset=time_offset )
-#endif
-      ! end jchanut tschanges
+      IF (ln_dynspg_ts) THEN      ! Fill temporary arrays with slow-varying bdy data                           
+         DO ib_bdy = 1, nb_bdy    ! Tidal component added in ts loop
+            IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN
+               nblen => idx_bdy(ib_bdy)%nblen
+               nblenrim => idx_bdy(ib_bdy)%nblenrim
+               IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF 
+               IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen1(1)) = dta_bdy(ib_bdy)%ssh(1:ilen1(1))
+               IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen1(2)) = dta_bdy(ib_bdy)%u2d(1:ilen1(2))
+               IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen1(3)) = dta_bdy(ib_bdy)%v2d(1:ilen1(3))
+            ENDIF
+         END DO
+      ELSE ! Add tides if not split-explicit free surface else this is done in ts loop
+         !
+         CALL bdy_dta_tides( kt=kt, time_offset=time_offset )
+      ENDIF
+#endif
 
       IF ( ln_apr_obc ) THEN
@@ -403,15 +407,15 @@
                   ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
                   dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + ssh_ib(ii,ij)
-               ENDDO
-            ENDIF
-         ENDDO
+               END DO
+            ENDIF
+         END DO
       ENDIF
-
+      !
       IF( nn_timing == 1 ) CALL timing_stop('bdy_dta')
-
-      END SUBROUTINE bdy_dta
-
-
-      SUBROUTINE bdy_dta_init
+      !
+   END SUBROUTINE bdy_dta
+
+
+   SUBROUTINE bdy_dta_init
       !!----------------------------------------------------------------------
       !!                   ***  SUBROUTINE bdy_dta_init  ***
@@ -423,11 +427,9 @@
       !!                
       !!----------------------------------------------------------------------
-      USE dynspg_oce, ONLY: lk_dynspg_ts
-      !!
-      INTEGER     ::  ib_bdy, jfld, jstart, jend, ierror  ! local indices
-      INTEGER      ::   ios                               ! Local integer output status for namelist read
-      !!
+      INTEGER ::   ib_bdy, jfld, jstart, jend, ierror, ios     ! Local integers
+      !
       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
@@ -459,7 +461,7 @@
       NAMELIST/nambdy_dta/ ln_full_vel
       !!---------------------------------------------------------------------------
-
-      IF( nn_timing == 1 ) CALL timing_start('bdy_dta_init')
-
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_dta_init')
+      !
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries'
@@ -476,5 +478,5 @@
 #endif
                               )
-         IF(nn_dta(ib_bdy) .gt. 1) nn_dta(ib_bdy) = 1
+         IF(nn_dta(ib_bdy) > 1) nn_dta(ib_bdy) = 1
       END DO
 
@@ -484,20 +486,20 @@
       nb_bdy_fld(:) = 0
       DO ib_bdy = 1, nb_bdy         
-         IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN
+         IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) THEN
             nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3
          ENDIF
-         IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN
+         IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) == 1 ) THEN
             nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2
          ENDIF
-         IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) .eq. 1  ) THEN
+         IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) == 1  ) THEN
             nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2
          ENDIF
 #if ( defined key_lim2 || defined key_lim3 )
-         IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) .eq. 1  ) THEN
+         IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) == 1  ) THEN
             nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3
          ENDIF
 #endif               
          IF(lwp) WRITE(numout,*) 'Maximum number of files to open =',nb_bdy_fld(ib_bdy)
-      ENDDO            
+      END DO            
 
       nb_bdy_fld_sum = SUM( nb_bdy_fld )
@@ -525,11 +527,11 @@
       jfld = 0 
       DO ib_bdy = 1, nb_bdy         
-         IF( nn_dta(ib_bdy) .eq. 1 ) THEN
+         IF( nn_dta(ib_bdy) == 1 ) THEN
             READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901)
-901         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp )
+901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp )
 
             READ  ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 )
-902         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp )
-            IF(lwm) WRITE ( numond, nambdy_dta )
+902         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp )
+            IF(lwm) WRITE( numond, nambdy_dta )
 
             cn_dir_array(ib_bdy) = cn_dir
@@ -543,5 +545,5 @@
             ! Only read in necessary fields for this set.
             ! Important that barotropic variables come first.
-            IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN 
+            IF( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) THEN 
 
                IF( dta%ll_ssh ) THEN 
@@ -582,8 +584,8 @@
             ! read 3D velocities if baroclinic velocities require OR if
             ! barotropic velocities required and ln_full_vel set to .true.
-            IF( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. &
-           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN
-
-               IF( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN
+            IF( nn_dyn3d_dta(ib_bdy) == 1 .OR. &
+           &  ( ln_full_vel_array(ib_bdy) .AND. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) ) THEN
+
+               IF( dta%ll_u3d .OR. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN
                   if(lwp) write(numout,*) '++++++ reading in u3d field'
                   jfld = jfld + 1
@@ -596,5 +598,5 @@
                ENDIF
 
-               IF( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN
+               IF( dta%ll_v3d .OR. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN
                   if(lwp) write(numout,*) '++++++ reading in v3d field'
                   jfld = jfld + 1
@@ -610,5 +612,5 @@
 
             ! temperature and salinity
-            IF( nn_tra_dta(ib_bdy) .eq. 1 ) THEN
+            IF( nn_tra_dta(ib_bdy) == 1 ) THEN
 
                IF( dta%ll_tem ) THEN
@@ -636,5 +638,5 @@
 #if defined key_lim2
             ! sea ice
-            IF( nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN
+            IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN
 
                IF( dta%ll_frld ) THEN
@@ -668,13 +670,21 @@
 #elif defined key_lim3
             ! sea ice
-            IF( nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN
-
+            IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN
                ! 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. )
+               ! 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. )
                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
@@ -715,5 +725,5 @@
             ! Recalculate field counts
             !-------------------------
-            IF( ib_bdy .eq. 1 ) THEN 
+            IF( ib_bdy == 1 ) THEN 
                nb_bdy_fld_sum = 0
                nb_bdy_fld(ib_bdy) = jfld
@@ -726,5 +736,5 @@
             dta%nread(1) = nb_bdy_fld(ib_bdy)
 
-         ENDIF ! nn_dta .eq. 1
+         ENDIF ! nn_dta == 1
       ENDDO ! ib_bdy
 
@@ -767,5 +777,5 @@
          endif
 
-         IF ( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN
+         IF ( nn_dyn2d_dta(ib_bdy) == 0 .or. nn_dyn2d_dta(ib_bdy) == 2 ) THEN
             if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space'
             IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) )
@@ -773,5 +783,5 @@
             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
+         IF ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) THEN
             IF( dta%ll_ssh ) THEN
                if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow'
@@ -801,11 +811,11 @@
          ENDIF
 
-         IF ( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN
+         IF ( nn_dyn3d_dta(ib_bdy) == 0 ) THEN
             if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space'
             IF( dta%ll_u3d ) ALLOCATE( dta_bdy(ib_bdy)%u3d(nblen(2),jpk) )
             IF( dta%ll_v3d ) ALLOCATE( dta_bdy(ib_bdy)%v3d(nblen(3),jpk) )
          ENDIF
-         IF ( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. &
-           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN
+         IF ( nn_dyn3d_dta(ib_bdy) == 1 .or. &
+           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) ) THEN
             IF ( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN
                if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow'
@@ -820,5 +830,5 @@
          ENDIF
 
-         IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN
+         IF( nn_tra_dta(ib_bdy) == 0 ) THEN
             if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space'
             IF( dta%ll_tem ) ALLOCATE( dta_bdy(ib_bdy)%tem(nblen(1),jpk) )
@@ -839,5 +849,5 @@
 #if defined key_lim2
          IF (cn_ice_lim(ib_bdy) /= 'none') THEN
-            IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN
                ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) )
                ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) )
@@ -854,5 +864,5 @@
 #elif defined key_lim3
          IF (cn_ice_lim(ib_bdy) /= 'none') THEN
-            IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN
                ALLOCATE( dta_bdy(ib_bdy)%a_i (nblen(1),jpl) )
                ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) )
@@ -874,18 +884,18 @@
                   ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) )
                   ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) )
-                  dta_bdy(ib_bdy)%a_i (:,:) = 0.0
-                  dta_bdy(ib_bdy)%ht_i(:,:) = 0.0
-                  dta_bdy(ib_bdy)%ht_s(:,:) = 0.0
-               ENDIF
-
-            ENDIF
-         ENDIF
-#endif
-
-      ENDDO ! ib_bdy 
-
+                  dta_bdy(ib_bdy)%a_i (:,:) = 0._wp
+                  dta_bdy(ib_bdy)%ht_i(:,:) = 0._wp
+                  dta_bdy(ib_bdy)%ht_s(:,:) = 0._wp
+               ENDIF
+
+            ENDIF
+         ENDIF
+#endif
+         !
+      END DO ! ib_bdy 
+      !
       IF( nn_timing == 1 ) CALL timing_stop('bdy_dta_init')
-
-      END SUBROUTINE bdy_dta_init
+      !
+   END SUBROUTINE bdy_dta_init
 
 #else
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90	(revision 6808)
@@ -24,5 +24,4 @@
    USE oce             ! ocean dynamics and tracers 
    USE dom_oce         ! ocean space and time domain
-   USE dynspg_oce      
    USE bdy_oce         ! ocean open boundary conditions
    USE bdydyn2d        ! open boundary conditions for barotropic solution
@@ -35,8 +34,6 @@
    PRIVATE
 
-   PUBLIC   bdy_dyn     ! routine called in dynspg_flt (if lk_dynspg_flt) or 
-                        ! dyn_nxt (if lk_dynspg_ts or lk_dynspg_exp)
+   PUBLIC   bdy_dyn    ! routine called in dyn_nxt
 
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -53,27 +50,26 @@
       !!
       !!----------------------------------------------------------------------
-      !!
-      INTEGER, INTENT( in )           :: kt               ! Main time step counter
-      LOGICAL, INTENT( in ), OPTIONAL :: dyn3d_only       ! T => only update baroclinic velocities
-      !!
-      INTEGER               :: jk,ii,ij,ib_bdy,ib,igrd     ! Loop counter
-      LOGICAL               :: ll_dyn2d, ll_dyn3d, ll_orlanski
-      !!
+      INTEGER, INTENT(in)           ::   kt           ! Main time step counter
+      LOGICAL, INTENT(in), OPTIONAL ::   dyn3d_only   ! T => only update baroclinic velocities
+      !
+      INTEGER ::   jk, ii, ij, ib_bdy, ib, igrd     ! Loop counter
+      LOGICAL ::   ll_dyn2d, ll_dyn3d, ll_orlanski
       REAL(wp), POINTER, DIMENSION(:,:) :: pua2d, pva2d     ! after barotropic velocities
-
-      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn')
-
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_dyn')
+      !
       ll_dyn2d = .true.
       ll_dyn3d = .true.
-
+      !
       IF( PRESENT(dyn3d_only) ) THEN
-         IF( dyn3d_only ) ll_dyn2d = .false.
+         IF( dyn3d_only )   ll_dyn2d = .false.
       ENDIF
-
+      !
       ll_orlanski = .false.
       DO ib_bdy = 1, nb_bdy
-         IF ( cn_dyn2d(ib_bdy) == 'orlanski' .or. cn_dyn2d(ib_bdy) == 'orlanski_npo' &
-     &   .or. cn_dyn3d(ib_bdy) == 'orlanski' .or. cn_dyn3d(ib_bdy) == 'orlanski_npo') ll_orlanski = .true.
-      ENDDO
+         IF ( cn_dyn2d(ib_bdy) == 'orlanski' .OR. cn_dyn2d(ib_bdy) == 'orlanski_npo' &
+     &   .OR. cn_dyn3d(ib_bdy) == 'orlanski' .OR. cn_dyn3d(ib_bdy) == 'orlanski_npo')   ll_orlanski = .true.
+      END DO
 
       !-------------------------------------------------------
@@ -81,5 +77,5 @@
       !-------------------------------------------------------
 
-      CALL wrk_alloc(jpi,jpj,pua2d,pva2d) 
+      CALL wrk_alloc( jpi,jpj,   pua2d, pva2d ) 
 
       !-------------------------------------------------------
@@ -87,29 +83,26 @@
       !-------------------------------------------------------
 
-      ! "After" velocities: 
+      !                          ! "After" velocities: 
+      pua2d(:,:) = 0._wp
+      pva2d(:,:) = 0._wp     
+      DO jk = 1, jpkm1
+         pua2d(:,:) = pua2d(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)
+         pva2d(:,:) = pva2d(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)
+      END DO
+      pua2d(:,:) = pua2d(:,:) * r1_hu_a(:,:)
+      pva2d(:,:) = pva2d(:,:) * r1_hv_a(:,:)
 
-      pua2d(:,:) = 0.e0
-      pva2d(:,:) = 0.e0      
-      DO jk = 1, jpkm1
-         pua2d(:,:) = pua2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk)
-         pva2d(:,:) = pva2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk)
+      DO jk = 1 , jpkm1
+         ua(:,:,jk) = ( ua(:,:,jk) - pua2d(:,:) ) * umask(:,:,jk)
+         va(:,:,jk) = ( va(:,:,jk) - pva2d(:,:) ) * vmask(:,:,jk)
       END DO
 
-      pua2d(:,:) = pua2d(:,:) * hur_a(:,:)
-      pva2d(:,:) = pva2d(:,:) * hvr_a(:,:)
 
-      DO jk = 1 , jpkm1
-         ua(:,:,jk) = (ua(:,:,jk) - pua2d(:,:)) * umask(:,:,jk)
-         va(:,:,jk) = (va(:,:,jk) - pva2d(:,:)) * vmask(:,:,jk)
-      END DO
-
-      ! "Before" velocities (required for Orlanski condition): 
-
-      IF ( ll_orlanski ) THEN          
+      IF( ll_orlanski ) THEN     ! "Before" velocities (Orlanski condition only) 
          DO jk = 1 , jpkm1
-            ub(:,:,jk) = (ub(:,:,jk) - ub_b(:,:)) * umask(:,:,jk)
-            vb(:,:,jk) = (vb(:,:,jk) - vb_b(:,:)) * vmask(:,:,jk)
+            ub(:,:,jk) = ( ub(:,:,jk) - ub_b(:,:) ) * umask(:,:,jk)
+            vb(:,:,jk) = ( vb(:,:,jk) - vb_b(:,:) ) * vmask(:,:,jk)
          END DO
-      END IF
+      ENDIF
 
       !-------------------------------------------------------
@@ -118,17 +111,17 @@
       !-------------------------------------------------------
 
-      IF( ll_dyn2d ) CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, hur_a(:,:), hvr_a(:,:), ssha )
+      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, r1_hu_a(:,:), r1_hv_a(:,:), ssha )
 
-      IF( ll_dyn3d ) CALL bdy_dyn3d( kt )
+      IF( ll_dyn3d )   CALL bdy_dyn3d( kt )
 
       !-------------------------------------------------------
       ! Recombine velocities
       !-------------------------------------------------------
-
+      !
       DO jk = 1 , jpkm1
          ua(:,:,jk) = ( ua(:,:,jk) + pua2d(:,:) ) * umask(:,:,jk)
          va(:,:,jk) = ( va(:,:,jk) + pva2d(:,:) ) * vmask(:,:,jk)
       END DO
-
+      !
       IF ( ll_orlanski ) THEN
          DO jk = 1 , jpkm1
@@ -137,9 +130,9 @@
          END DO
       END IF
-
-      CALL wrk_dealloc(jpi,jpj,pua2d,pva2d) 
-
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn')
-
+      !
+      CALL wrk_dealloc( jpi,jpj,  pua2d, pva2d ) 
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn')
+      !
    END SUBROUTINE bdy_dyn
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 6808)
@@ -23,5 +23,4 @@
    USE bdy_oce         ! ocean open boundary conditions
    USE bdylib          ! BDY library routines
-   USE dynspg_oce      ! for barotropic variables
    USE phycst          ! physical constants
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90	(revision 6808)
@@ -29,6 +29,4 @@
    PUBLIC   bdy_dyn3d_dmp ! routine called by step
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -45,34 +43,26 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) :: kt     ! Main time step counter
-      !!
-      INTEGER               :: ib_bdy ! loop index
-      !!
-
+      INTEGER, INTENT(in) ::   kt   ! Main time step counter
+      !
+      INTEGER ::   ib_bdy   ! loop index
+      !!----------------------------------------------------------------------
+      !
       DO ib_bdy=1, nb_bdy
-
+         !
          SELECT CASE( cn_dyn3d(ib_bdy) )
-         CASE('none')
-            CYCLE
-         CASE('frs')
-            CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
-         CASE('specified')
-            CALL bdy_dyn3d_spe( 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('zero')
-            CALL bdy_dyn3d_zro( 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. )
-         CASE('orlanski_npo')
-            CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. )
-         CASE DEFAULT
-            CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' )
+         CASE('none')        ;   CYCLE
+         CASE('frs' )        ;   CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+         CASE('specified')   ;   CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+         CASE('zero')        ;   CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+         CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. )
+         CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. )
+         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 DEFAULT        ;   CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' )
          END SELECT
-      ENDDO
-
+      END DO
+      !
    END SUBROUTINE bdy_dyn3d
+
 
    SUBROUTINE bdy_dyn3d_spe( idx, dta, kt , ib_bdy )
@@ -82,4 +72,49 @@
       !! ** Purpose : - Apply a specified value for baroclinic velocities
       !!                at open boundaries.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER        , INTENT(in) ::   kt      ! time step index
+      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
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_spe')
+      !
+      igrd = 2                      ! Relaxation of zonal velocity
+      DO jb = 1, idx%nblenrim(igrd)
+         DO jk = 1, jpkm1
+            ii   = idx%nbi(jb,igrd)
+            ij   = idx%nbj(jb,igrd)
+            ua(ii,ij,jk) = dta%u3d(jb,jk) * umask(ii,ij,jk)
+         END DO
+      END DO
+      !
+      igrd = 3                      ! Relaxation of meridional velocity
+      DO jb = 1, idx%nblenrim(igrd)
+         DO jk = 1, jpkm1
+            ii   = idx%nbi(jb,igrd)
+            ij   = idx%nbj(jb,igrd)
+            va(ii,ij,jk) = dta%v3d(jb,jk) * vmask(ii,ij,jk)
+         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 == nit000 )   CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_spe')
+      !
+   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
       !!
       !!----------------------------------------------------------------------
@@ -92,49 +127,4 @@
       INTEGER  ::   ii, ij, igrd   ! local integers
       REAL(wp) ::   zwgt           ! boundary weight
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_spe')
-      !
-      igrd = 2                      ! Relaxation of zonal velocity
-      DO jb = 1, idx%nblenrim(igrd)
-         DO jk = 1, jpkm1
-            ii   = idx%nbi(jb,igrd)
-            ij   = idx%nbj(jb,igrd)
-            ua(ii,ij,jk) = dta%u3d(jb,jk) * umask(ii,ij,jk)
-         END DO
-      END DO
-      !
-      igrd = 3                      ! Relaxation of meridional velocity
-      DO jb = 1, idx%nblenrim(igrd)
-         DO jk = 1, jpkm1
-            ii   = idx%nbi(jb,igrd)
-            ij   = idx%nbj(jb,igrd)
-            va(ii,ij,jk) = dta%v3d(jb,jk) * vmask(ii,ij,jk)
-         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_spe')
-
-   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
       !!----------------------------------------------------------------------
@@ -179,11 +169,11 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER                     ::   kt
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
+      INTEGER        , INTENT(in) ::   kt      ! time step index
+      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  ::   ib, ik         ! dummy loop indices
-      INTEGER  ::   ii, ij, igrd, zcoef   ! local integers
+      INTEGER  ::   ii, ij, igrd   ! local integers
       REAL(wp) ::   zwgt           ! boundary weight
       !!----------------------------------------------------------------------
@@ -211,9 +201,10 @@
       CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy )   ! Boundary points should be updated
       !
-      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
-
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zro')
-
+      IF( kt == nit000 )   CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn3d_zro')
+      !
    END SUBROUTINE bdy_dyn3d_zro
+
 
    SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy )
@@ -228,9 +219,9 @@
       !!               topography. Tellus, 365-382.
       !!----------------------------------------------------------------------
-      INTEGER                     ::   kt
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
+      INTEGER        , INTENT(in) ::   kt      ! time step index
+      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
@@ -262,9 +253,10 @@
       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_frs')
-
+      IF( kt == nit000 )   CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn3d_frs')
+      !
    END SUBROUTINE bdy_dyn3d_frs
+
 
    SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll_npo )
@@ -313,16 +305,14 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER                     ::   kt
-      !!
+      INTEGER, INTENT(in) ::   kt   ! time step index
+      !
       INTEGER  ::   jb, jk         ! dummy loop indices
-      INTEGER  ::   ii, ij, igrd   ! local integers
-      REAL(wp) ::   zwgt           ! boundary weight
-      INTEGER  ::  ib_bdy          ! loop index
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_dmp')
-      !
-      !-------------------------------------------------------
-
+      INTEGER  ::   ib_bdy         ! loop index
+      INTEGER  ::   ii, ij, igrd   ! local integers
+      REAL(wp) ::   zwgt           ! boundary weight
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_dyn3d_dmp')
+      !
       DO ib_bdy=1, nb_bdy
          IF ( ln_dyn3d_dmp(ib_bdy) .and. cn_dyn3d(ib_bdy) /= 'none' ) THEN
@@ -349,10 +339,10 @@
             END DO
          ENDIF
-      ENDDO
+      END DO
       !
       CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated
       !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_dmp')
-
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn3d_dmp')
+      !
    END SUBROUTINE bdy_dyn3d_dmp
 
@@ -399,9 +389,7 @@
       WRITE(*,*) 'bdy_dyn3d: You should not have seen this print! error?', kt
    END SUBROUTINE bdy_dyn3d
-
    SUBROUTINE bdy_dyn3d_dmp( kt )      ! Empty routine
       WRITE(*,*) 'bdy_dyn3d_dmp: You should not have seen this print! error?', kt
    END SUBROUTINE bdy_dyn3d_dmp
-
 #endif
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90	(revision 6808)
@@ -59,13 +59,15 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) :: kt     ! Main time step counter
-      INTEGER               :: ib_bdy ! Loop index
-
+      INTEGER, INTENT( in ) ::   kt   ! Main time step counter
+      !
+      INTEGER ::   ib_bdy   ! Loop index
+      !!----------------------------------------------------------------------
+      !
 #if defined key_lim3
       CALL lim_var_glo2eqv
 #endif
-
+      !
       DO ib_bdy=1, nb_bdy
-
+         !
          SELECT CASE( cn_ice_lim(ib_bdy) )
          CASE('none')
@@ -76,13 +78,14 @@
             CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' )
          END SELECT
-
+         !
       END DO
-
+      !
 #if defined key_lim3
       CALL lim_var_zapsmall
       CALL lim_var_agg(1)
 #endif
-
+      !
    END SUBROUTINE bdy_ice_lim
+
 
    SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy )
@@ -96,19 +99,22 @@
       !!             dimensional baroclinic ocean model with realistic topography. Tellus, 365-382.
       !!------------------------------------------------------------------------------
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
-      INTEGER,         INTENT(in) ::   kt   ! main time-step counter
+      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
+      TYPE(OBC_DATA),  INTENT(in) ::   dta     ! OBC external data
+      INTEGER,         INTENT(in) ::   kt      ! main time-step counter
       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
-
+      !
       INTEGER  ::   jpbound            ! 0 = incoming ice
-                                       ! 1 = outgoing ice
+      !                                ! 1 = outgoing ice
       INTEGER  ::   jb, jk, jgrd, jl   ! dummy loop indices
       INTEGER  ::   ji, jj, ii, ij     ! local scalar
       REAL(wp) ::   zwgt, zwgt1        ! local scalar
       REAL(wp) ::   ztmelts, zdh
-
-      !!------------------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('bdy_ice_frs')
+#if  defined key_lim2 && ! defined key_lim2_vp && defined key_agrif
+     USE ice_2, vt_s => hsnm
+     USE ice_2, vt_i => hicm
+#endif
+      !!------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_ice_frs')
       !
       jgrd = 1      ! Everything is at T-points here
@@ -177,30 +183,29 @@
             ! condition on ice thickness depends on the ice velocity
             ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values
-            jpbound = 0; ii = ji; ij = jj;
-
+            jpbound = 0   ;   ii = ji   ;   ij = jj
+            !
             IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj
             IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj
             IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1
             IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1
-
+            !
             IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj   ! case ice boundaries = initial conditions
-                                                                              !      do not make state variables dependent on velocity
-               
-
+            !                                                                 !      do not make state variables dependent on velocity
+            !
             rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice
-
+            !
             ! concentration and thickness
             a_i (ji,jj,jl) = a_i (ii,ij,jl) * rswitch
             ht_i(ji,jj,jl) = ht_i(ii,ij,jl) * rswitch
             ht_s(ji,jj,jl) = ht_s(ii,ij,jl) * rswitch
-
+            !
             ! Ice and snow volumes
             v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl)
             v_s(ji,jj,jl) = ht_s(ji,jj,jl) * a_i(ji,jj,jl)
-
+            !
             SELECT CASE( jpbound )
-
-            CASE( 0 ) ! velocity is inward
-
+            !
+            CASE( 0 )   ! velocity is inward
+               !
                ! Ice salinity, age, temperature
                sm_i(ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * rn_simin
@@ -214,7 +219,7 @@
                   s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin
                END DO
-               
-            CASE( 1 ) ! velocity is outward
- 
+               !
+            CASE( 1 )   ! velocity is outward
+               !
                ! Ice salinity, age, temperature
                sm_i(ji,jj,jl)   = rswitch * sm_i(ii,ij,jl)  + ( 1.0 - rswitch ) * rn_simin
@@ -228,13 +233,12 @@
                   s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin
                END DO
-
+               !
             END SELECT
-
-            ! if salinity is constant, then overwrite rn_ice_sal
-            IF( nn_icesal == 1 ) THEN
-               sm_i(ji,jj,jl)   = rn_icesal
+            !
+            IF( nn_icesal == 1 ) THEN     ! constant salinity : overwrite rn_ice_sal
+               sm_i(ji,jj  ,jl) = rn_icesal
                s_i (ji,jj,:,jl) = rn_icesal
             ENDIF
-
+            !
             ! contents
             smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl)
@@ -255,7 +259,7 @@
                e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i
             END DO
-
+            !
          END DO
- 
+         !
          CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy )
          CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy )
@@ -263,5 +267,5 @@
          CALL lbc_bdy_lnk(  v_i(:,:,jl), 'T', 1., ib_bdy )
          CALL lbc_bdy_lnk(  v_s(:,:,jl), 'T', 1., ib_bdy )
- 
+         !
          CALL lbc_bdy_lnk( smv_i(:,:,jl), 'T', 1., ib_bdy )
          CALL lbc_bdy_lnk(  sm_i(:,:,jl), 'T', 1., ib_bdy )
@@ -276,10 +280,10 @@
             CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy )
          END DO
-
+         !
       END DO !jl
-    
+      !
 #endif
       !      
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_frs')
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_ice_frs')
       !
    END SUBROUTINE bdy_ice_frs
@@ -296,11 +300,11 @@
       !! 2013-06 : C. Rousset
       !!------------------------------------------------------------------------------
-      !!
       CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points
+      !
       INTEGER  ::   jb, jgrd           ! dummy loop indices
       INTEGER  ::   ji, jj             ! local scalar
       INTEGER  ::   ib_bdy             ! Loop index
       REAL(wp) ::   zmsk1, zmsk2, zflag
-     !!------------------------------------------------------------------------------
+      !!------------------------------------------------------------------------------
       !
       IF( nn_timing == 1 ) CALL timing_start('bdy_ice_lim_dyn')
@@ -309,18 +313,15 @@
          !
          SELECT CASE( cn_ice_lim(ib_bdy) )
-
+         !
          CASE('none')
-
             CYCLE
-            
+            !
          CASE('frs')
-            
+            !
             IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions 
-                                                               !      do not change ice velocity (it is only computed by rheology)
- 
+            !                                                  !      do not change ice velocity (it is only computed by rheology)
             SELECT CASE ( cd_type )
-               
-            CASE ( 'U' )
-               
+            !     
+            CASE ( 'U' )  
                jgrd = 2      ! u velocity
                DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd)
@@ -328,10 +329,10 @@
                   jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
                   zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd)
-                  
+                  !
                   IF ( ABS( zflag ) == 1. ) THEN  ! eastern and western boundaries
                      ! one of the two zmsk is always 0 (because of zflag)
                      zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji+1,jj) ) ) ! 0 if no ice
                      zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji-1,jj) ) ) ! 0 if no ice
-                     
+                     !  
                      ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
                      u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
@@ -345,11 +346,9 @@
                   rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice
                   u_ice(ji,jj) = rswitch * u_ice(ji,jj)
-                  
-               ENDDO
-               
+                  !
+               END DO
                CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy )
-               
+               !
             CASE ( 'V' )
-               
                jgrd = 3      ! v velocity
                DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd)
@@ -357,10 +356,10 @@
                   jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
                   zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd)
-                  
+                  !
                   IF ( ABS( zflag ) == 1. ) THEN  ! northern and southern boundaries
                      ! one of the two zmsk is always 0 (because of zflag)
                      zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj+1) ) ) ! 0 if no ice
                      zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj-1) ) ) ! 0 if no ice
-                     
+                     !  
                      ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
                      v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
@@ -374,19 +373,18 @@
                   rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice
                   v_ice(ji,jj) = rswitch * v_ice(ji,jj)
-                  
-               ENDDO
-               
+                  !
+               END DO
                CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy )
-                  
+               !
             END SELECT
-            
+            !
          CASE DEFAULT
             CALL ctl_stop( 'bdy_ice_lim_dyn : unrecognised option for open boundaries for ice fields' )
          END SELECT
-         
-      ENDDO
-
+         !
+      END DO
+      !
       IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_lim_dyn')
-      
+      !
     END SUBROUTINE bdy_ice_lim_dyn
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 6808)
@@ -12,6 +12,5 @@
    !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
    !!            3.4  !  2012     (J. Chanut) straight open boundary case update
-   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Updates for the 
-   !!                             optimization of BDY communications
+   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) optimization of BDY communications
    !!----------------------------------------------------------------------
 #if defined key_bdy
@@ -19,17 +18,18 @@
    !!   'key_bdy'                     Unstructured Open Boundary Conditions
    !!----------------------------------------------------------------------
-   !!   bdy_init       : Initialization of unstructured open boundaries
+   !!   bdy_init      : Initialization of unstructured open boundaries
    !!----------------------------------------------------------------------
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain
-   USE bdy_oce         ! unstructured open boundary conditions
-   USE in_out_manager  ! I/O units
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! for mpp_sum  
-   USE iom             ! I/O
-   USE sbctide, ONLY: lk_tide ! Tidal forcing or not
-   USE phycst, ONLY: rday
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain
+   USE bdy_oce        ! unstructured open boundary conditions
+   USE sbctide  , ONLY: lk_tide ! Tidal forcing or not
+   USE phycst   , ONLY: rday
+   !
+   USE in_out_manager ! I/O units
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! for mpp_sum  
+   USE iom            ! I/O
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -38,15 +38,15 @@
    PUBLIC   bdy_init   ! routine called in nemo_init
 
-   INTEGER, PARAMETER          :: jp_nseg = 100
-   INTEGER, PARAMETER          :: nrimmax = 20 ! maximum rimwidth in structured
+   INTEGER, PARAMETER ::   jp_nseg = 100   ! 
+   INTEGER, PARAMETER ::   nrimmax =  20   ! maximum rimwidth in structured
                                                ! open boundary data files
    ! Straight open boundary segment parameters:
-   INTEGER  :: nbdysege, nbdysegw, nbdysegn, nbdysegs 
-   INTEGER, DIMENSION(jp_nseg) :: jpieob, jpjedt, jpjeft, npckge
-   INTEGER, DIMENSION(jp_nseg) :: jpiwob, jpjwdt, jpjwft, npckgw
-   INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft, npckgn
-   INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft, npckgs
+   INTEGER  ::   nbdysege, nbdysegw, nbdysegn, nbdysegs 
+   INTEGER, DIMENSION(jp_nseg) ::   jpieob, jpjedt, jpjeft, npckge   !
+   INTEGER, DIMENSION(jp_nseg) ::   jpiwob, jpjwdt, jpjwft, npckgw   !
+   INTEGER, DIMENSION(jp_nseg) ::   jpjnob, jpindt, jpinft, npckgn   !
+   INTEGER, DIMENSION(jp_nseg) ::   jpjsob, jpisdt, jpisft, npckgs   !
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -66,9 +66,4 @@
       !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries
       !!----------------------------------------------------------------------      
-      ! namelist variables
-      !-------------------
-      CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile
-      CHARACTER(LEN=1)   ::   ctypebdy
-      INTEGER :: nbdyind, nbdybeg, nbdyend
 
       ! local variables
@@ -76,10 +71,10 @@
       INTEGER  ::   ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices
       INTEGER  ::   icount, icountr, ibr_max, ilen1, ibm1  ! local integers
-      INTEGER  ::   iw, ie, is, in, inum, id_dummy         !   -       -
+      INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy     !   -       -
       INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       -
       INTEGER  ::   jpbdtau, jpbdtas                       !   -       -
       INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       -
       INTEGER  ::   i_offset, j_offset                     !   -       -
-      INTEGER, POINTER  ::  nbi, nbj, nbr                  ! short cuts
+      INTEGER , POINTER  ::  nbi, nbj, nbr                 ! short cuts
       REAL(wp), POINTER  ::  flagu, flagv                  !    -   -
       REAL(wp), POINTER, DIMENSION(:,:)       ::   pmask    ! pointer to 2D mask fields
@@ -94,5 +89,8 @@
       INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates
       REAL(wp), POINTER, DIMENSION(:,:)       ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat)
-
+      !!
+      CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile     ! Namelist variables
+      CHARACTER(LEN=1)                     ::   ctypebdy   !     -        - 
+      INTEGER                              ::   nbdyind, nbdybeg, nbdyend
       !!
       NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file,                 &
@@ -103,32 +101,30 @@
          &             rn_ice_tem, rn_ice_sal, rn_ice_age,                 &
          &             ln_vol, nn_volctl, nn_rimwidth
-      !!
+         !
       NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend
       INTEGER  ::   ios                 ! Local integer output status for namelist read
       !!----------------------------------------------------------------------
-
-      IF( nn_timing == 1 ) CALL timing_start('bdy_init')
-
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_init')
+      !
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries'
       IF(lwp) WRITE(numout,*) '~~~~~~~~'
       !
-
       IF( jperio /= 0 )   CALL ctl_stop( 'Cyclic or symmetric,',   &
          &                               ' and general open boundary condition are not compatible' )
 
-      cgrid= (/'t','u','v'/)
+      cgrid = (/'t','u','v'/)
       
       ! ------------------------
       ! Read namelist parameters
       ! ------------------------
-
       REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries  
       READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp )
-
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp )
+      !
       REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries
       READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, nambdy )
 
@@ -137,10 +133,10 @@
       ! -----------------------------------------
       !                                   ! control prints
-      IF(lwp) WRITE(numout,*) '         nambdy'
-
-      IF( nb_bdy .eq. 0 ) THEN 
+      IF(lwp) WRITE(numout,*) '   nambdy'
+
+      IF( nb_bdy == 0 ) THEN 
         IF(lwp) WRITE(numout,*) 'nb_bdy = 0, NO OPEN BOUNDARIES APPLIED.'
       ELSE
-        IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ',nb_bdy
+        IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ', nb_bdy
       ENDIF
 
@@ -158,25 +154,25 @@
         IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution:  '
         SELECT CASE( cn_dyn2d(ib_bdy) )                  
-          CASE('none')         
+          CASE( 'none' )         
              IF(lwp) WRITE(numout,*) '      no open boundary condition'        
              dta_bdy(ib_bdy)%ll_ssh = .false.
              dta_bdy(ib_bdy)%ll_u2d = .false.
              dta_bdy(ib_bdy)%ll_v2d = .false.
-          CASE('frs')          
+          CASE( 'frs' )          
              IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
              dta_bdy(ib_bdy)%ll_ssh = .false.
              dta_bdy(ib_bdy)%ll_u2d = .true.
              dta_bdy(ib_bdy)%ll_v2d = .true.
-          CASE('flather')      
+          CASE( 'flather' )      
              IF(lwp) WRITE(numout,*) '      Flather radiation condition'
              dta_bdy(ib_bdy)%ll_ssh = .true.
              dta_bdy(ib_bdy)%ll_u2d = .true.
              dta_bdy(ib_bdy)%ll_v2d = .true.
-          CASE('orlanski')     
+          CASE( 'orlanski' )     
              IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging'
              dta_bdy(ib_bdy)%ll_ssh = .false.
              dta_bdy(ib_bdy)%ll_u2d = .true.
              dta_bdy(ib_bdy)%ll_v2d = .true.
-          CASE('orlanski_npo') 
+          CASE( 'orlanski_npo' ) 
              IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging'
              dta_bdy(ib_bdy)%ll_ssh = .false.
@@ -400,8 +396,4 @@
       REWIND( numnam_cfg )     
 
-      !!----------------------------------------------------------------------
-
-              
-               
       nblendta(:,:) = 0
       nbdysege = 0
@@ -500,10 +492,10 @@
                nblendta(igrd,ib_bdy) = MAXVAL(kdimsz)
                jpbdtau = MAX(jpbdtau, MAXVAL(kdimsz))
-            ENDDO
+            END DO
             CALL iom_close( inum )
-
+            !
          ENDIF 
-
-      ENDDO ! ib_bdy
+         !
+      END DO ! ib_bdy
 
       IF (nb_bdy>0) THEN
@@ -522,5 +514,5 @@
       ! Now look for crossings in user (namelist) defined open boundary segments:
       !--------------------------------------------------------------------------
-      IF ( icount>0 ) CALL bdy_ctl_seg
+      IF( icount>0 )   CALL bdy_ctl_seg
 
       ! Calculate global boundary index arrays or read in from file
@@ -528,7 +520,7 @@
       ! 1. Read global index arrays from boundary coordinates file.
       DO ib_bdy = 1, nb_bdy
-
+         !
          IF( ln_coords_file(ib_bdy) ) THEN
-
+            !
             CALL iom_open( cn_coords_file(ib_bdy), inum )
             DO igrd = 1, jpbgrd
@@ -545,5 +537,5 @@
                   nbrdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) )
                END DO
-
+               !
                ibr_max = MAXVAL( nbrdta(:,igrd,ib_bdy) )
                IF(lwp) WRITE(numout,*)
@@ -554,8 +546,8 @@
             END DO
             CALL iom_close( inum )
-
+            !
          ENDIF 
-
-      ENDDO      
+         !
+      END DO      
     
       ! 2. Now fill indices corresponding to straight open boundary arrays:
@@ -785,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      
-      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
+      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
 
       ALLOCATE( nbondi_bdy(nb_bdy))
@@ -800,5 +792,5 @@
 
       ! Work out dimensions of boundary data on each neighbour process
-      IF(nbondi .eq. 0) THEN
+      IF(nbondi == 0) THEN
          iw_b(1) = jpizoom + nimppt(nowe+1)
          ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3
@@ -810,10 +802,10 @@
          is_b(2) = jpjzoom + njmppt(noea+1)
          in_b(2) = jpjzoom + njmppt(noea+1)+nlcjt(noea+1)-3
-      ELSEIF(nbondi .eq. 1) THEN
+      ELSEIF(nbondi == 1) THEN
          iw_b(1) = jpizoom + nimppt(nowe+1)
          ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3
          is_b(1) = jpjzoom + njmppt(nowe+1)
          in_b(1) = jpjzoom + njmppt(nowe+1)+nlcjt(nowe+1)-3
-      ELSEIF(nbondi .eq. -1) THEN
+      ELSEIF(nbondi == -1) THEN
          iw_b(2) = jpizoom + nimppt(noea+1)
          ie_b(2) = jpizoom + nimppt(noea+1)+nlcit(noea+1)-3
@@ -822,5 +814,5 @@
       ENDIF
 
-      IF(nbondj .eq. 0) THEN
+      IF(nbondj == 0) THEN
          iw_b(3) = jpizoom + nimppt(noso+1)
          ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3
@@ -832,10 +824,10 @@
          is_b(4) = jpjzoom + njmppt(nono+1)
          in_b(4) = jpjzoom + njmppt(nono+1)+nlcjt(nono+1)-3
-      ELSEIF(nbondj .eq. 1) THEN
+      ELSEIF(nbondj == 1) THEN
          iw_b(3) = jpizoom + nimppt(noso+1)
          ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3
          is_b(3) = jpjzoom + njmppt(noso+1)
          in_b(3) = jpjzoom + njmppt(noso+1)+nlcjt(noso+1)-3
-      ELSEIF(nbondj .eq. -1) THEN
+      ELSEIF(nbondj == -1) THEN
          iw_b(4) = jpizoom + nimppt(nono+1)
          ie_b(4) = jpizoom + nimppt(nono+1)+nlcit(nono+1)-3
@@ -861,6 +853,6 @@
                ENDIF
                ! check if point is in local domain
-               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
+               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
                   !
                   icount = icount  + 1
@@ -875,27 +867,28 @@
          ! Allocate index arrays for this boundary set
          !--------------------------------------------
-         ilen1 = MAXVAL(idx_bdy(ib_bdy)%nblen(:))
-         ALLOCATE( idx_bdy(ib_bdy)%nbi(ilen1,jpbgrd) )
-         ALLOCATE( idx_bdy(ib_bdy)%nbj(ilen1,jpbgrd) )
-         ALLOCATE( idx_bdy(ib_bdy)%nbr(ilen1,jpbgrd) )
-         ALLOCATE( idx_bdy(ib_bdy)%nbd(ilen1,jpbgrd) )
+         ilen1 = MAXVAL( idx_bdy(ib_bdy)%nblen(:) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbi   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbj   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbr   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbd   (ilen1,jpbgrd) )
          ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) )
-         ALLOCATE( idx_bdy(ib_bdy)%nbmap(ilen1,jpbgrd) )
-         ALLOCATE( idx_bdy(ib_bdy)%nbw(ilen1,jpbgrd) )
-         ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1,jpbgrd) )
-         ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbw   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) )
 
          ! Dispatch mapping indices and discrete distances on each processor
          ! -----------------------------------------------------------------
 
-         com_east = 0
-         com_west = 0
+         com_east  = 0
+         com_west  = 0
          com_south = 0
          com_north = 0
 
-         com_east_b = 0
-         com_west_b = 0
+         com_east_b  = 0
+         com_west_b  = 0
          com_south_b = 0
          com_north_b = 0
+
          DO igrd = 1, jpbgrd
             icount  = 0
@@ -904,6 +897,6 @@
                DO ib = 1, nblendta(igrd,ib_bdy)
                   ! check if point is in local domain and equals ir
-                  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.   &
+                  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.   &
                      & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
                      !
@@ -919,12 +912,12 @@
                      ii = idx_bdy(ib_bdy)%nbi(icount,igrd)
                      ij = idx_bdy(ib_bdy)%nbj(icount,igrd)
-                     if((com_east .ne. 1) .and. (ii .eq. (nlci-1)) .and. (nbondi .le. 0)) then
+                     if((com_east .ne. 1) .and. (ii == (nlci-1)) .and. (nbondi .le. 0)) then
                         com_east = 1
-                     elseif((com_west .ne. 1) .and. (ii .eq. 2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then
+                     elseif((com_west .ne. 1) .and. (ii == 2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then
                         com_west = 1
                      endif 
-                     if((com_south .ne. 1) .and. (ij .eq. 2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then
+                     if((com_south .ne. 1) .and. (ij == 2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then
                         com_south = 1
-                     elseif((com_north .ne. 1) .and. (ij .eq. (nlcj-1)) .and. (nbondj .le. 0)) then
+                     elseif((com_north .ne. 1) .and. (ij == (nlcj-1)) .and. (nbondj .le. 0)) then
                         com_north = 1
                      endif 
@@ -933,14 +926,14 @@
                   ENDIF
                   ! check if point has to be received from a neighbour
-                  IF(nbondi .eq. 0) THEN
+                  IF(nbondi == 0) THEN
                      IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   &
                        & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   &
                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
                        ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2
-                       if((com_west_b .ne. 1) .and. (ii .eq. (nlcit(nowe+1)-1))) then
+                       if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then
                           ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2
-                          if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then
+                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then
                             com_south = 1
-                          elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then
+                          elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then
                             com_north = 1
                           endif
@@ -952,9 +945,9 @@
                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
                        ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2
-                       if((com_east_b .ne. 1) .and. (ii .eq. 2)) then
+                       if((com_east_b .ne. 1) .and. (ii == 2)) then
                           ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2
-                          if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then
+                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then
                             com_south = 1
-                          elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then
+                          elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then
                             com_north = 1
                           endif
@@ -962,14 +955,14 @@
                        endif 
                      ENDIF
-                  ELSEIF(nbondi .eq. 1) THEN
+                  ELSEIF(nbondi == 1) THEN
                      IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   &
                        & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   &
                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
                        ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2
-                       if((com_west_b .ne. 1) .and. (ii .eq. (nlcit(nowe+1)-1))) then
+                       if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then
                           ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2
-                          if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then
+                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then
                             com_south = 1
-                          elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then
+                          elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then
                             com_north = 1
                           endif
@@ -977,14 +970,14 @@
                        endif 
                      ENDIF
-                  ELSEIF(nbondi .eq. -1) THEN
+                  ELSEIF(nbondi == -1) THEN
                      IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND.   &
                        & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND.   &
                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
                        ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2
-                       if((com_east_b .ne. 1) .and. (ii .eq. 2)) then
+                       if((com_east_b .ne. 1) .and. (ii == 2)) then
                           ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2
-                          if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then
+                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then
                             com_south = 1
-                          elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then
+                          elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then
                             com_north = 1
                           endif
@@ -993,5 +986,5 @@
                      ENDIF
                   ENDIF
-                  IF(nbondj .eq. 0) THEN
+                  IF(nbondj == 0) THEN
                      IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  &
                        & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. &
@@ -1008,5 +1001,5 @@
                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
                        ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2
-                       if((com_south_b .ne. 1) .and. (ij .eq. (nlcjt(noso+1)-1))) then
+                       if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then
                           com_south_b = 1
                        endif 
@@ -1016,9 +1009,9 @@
                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
                        ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2
-                       if((com_north_b .ne. 1) .and. (ij .eq. 2)) then
+                       if((com_north_b .ne. 1) .and. (ij == 2)) then
                           com_north_b = 1
                        endif 
                      ENDIF
-                  ELSEIF(nbondj .eq. 1) THEN
+                  ELSEIF(nbondj == 1) THEN
                      IF( com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1 .OR. &
                        & nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. &
@@ -1030,9 +1023,9 @@
                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
                        ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2
-                       if((com_south_b .ne. 1) .and. (ij .eq. (nlcjt(noso+1)-1))) then
+                       if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then
                           com_south_b = 1
                        endif 
                      ENDIF
-                  ELSEIF(nbondj .eq. -1) THEN
+                  ELSEIF(nbondj == -1) THEN
                      IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  &
                        & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. &
@@ -1044,5 +1037,5 @@
                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
                        ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2
-                       if((com_north_b .ne. 1) .and. (ij .eq. 2)) then
+                       if((com_north_b .ne. 1) .and. (ij == 2)) then
                           com_north_b = 1
                        endif 
@@ -1053,38 +1046,22 @@
          ENDDO 
 
-         ! definition of the i- and j- direction local boundaries arrays
-         ! used for sending the boudaries
-         IF((com_east .eq. 1) .and. (com_west .eq. 1)) THEN
-            nbondi_bdy(ib_bdy) = 0
-         ELSEIF ((com_east .eq. 1) .and. (com_west .eq. 0)) THEN
-            nbondi_bdy(ib_bdy) = -1
-         ELSEIF ((com_east .eq. 0) .and. (com_west .eq. 1)) THEN
-            nbondi_bdy(ib_bdy) = 1
+         ! definition of the i- and j- direction local boundaries arrays used for sending the boundaries
+         IF(     (com_east  == 1) .and. (com_west  == 1) ) THEN   ;   nbondi_bdy(ib_bdy) =  0
+         ELSEIF( (com_east  == 1) .and. (com_west  == 0) ) THEN   ;   nbondi_bdy(ib_bdy) = -1
+         ELSEIF( (com_east  == 0) .and. (com_west  == 1) ) THEN   ;   nbondi_bdy(ib_bdy) =  1
          ENDIF
-
-         IF((com_north .eq. 1) .and. (com_south .eq. 1)) THEN
-            nbondj_bdy(ib_bdy) = 0
-         ELSEIF ((com_north .eq. 1) .and. (com_south .eq. 0)) THEN
-            nbondj_bdy(ib_bdy) = -1
-         ELSEIF ((com_north .eq. 0) .and. (com_south .eq. 1)) THEN
-            nbondj_bdy(ib_bdy) = 1
+         IF(     (com_north == 1) .and. (com_south == 1) ) THEN   ;   nbondj_bdy(ib_bdy) =  0
+         ELSEIF( (com_north == 1) .and. (com_south == 0) ) THEN   ;   nbondj_bdy(ib_bdy) = -1
+         ELSEIF( (com_north == 0) .and. (com_south == 1) ) THEN   ;   nbondj_bdy(ib_bdy) =  1
          ENDIF
 
-         ! definition of the i- and j- direction local boundaries arrays
-         ! used for receiving the boudaries
-         IF((com_east_b .eq. 1) .and. (com_west_b .eq. 1)) THEN
-            nbondi_bdy_b(ib_bdy) = 0
-         ELSEIF ((com_east_b .eq. 1) .and. (com_west_b .eq. 0)) THEN
-            nbondi_bdy_b(ib_bdy) = -1
-         ELSEIF ((com_east_b .eq. 0) .and. (com_west_b .eq. 1)) THEN
-            nbondi_bdy_b(ib_bdy) = 1
+         ! definition of the i- and j- direction local boundaries arrays used for receiving the boundaries
+         IF(     (com_east_b  == 1) .and. (com_west_b  == 1) ) THEN   ;   nbondi_bdy_b(ib_bdy) =  0
+         ELSEIF( (com_east_b  == 1) .and. (com_west_b  == 0) ) THEN   ;   nbondi_bdy_b(ib_bdy) = -1
+         ELSEIF( (com_east_b  == 0) .and. (com_west_b  == 1) ) THEN   ;   nbondi_bdy_b(ib_bdy) =  1
          ENDIF
-
-         IF((com_north_b .eq. 1) .and. (com_south_b .eq. 1)) THEN
-            nbondj_bdy_b(ib_bdy) = 0
-         ELSEIF ((com_north_b .eq. 1) .and. (com_south_b .eq. 0)) THEN
-            nbondj_bdy_b(ib_bdy) = -1
-         ELSEIF ((com_north_b .eq. 0) .and. (com_south_b .eq. 1)) THEN
-            nbondj_bdy_b(ib_bdy) = 1
+         IF(     (com_north_b == 1) .and. (com_south_b == 1) ) THEN   ;   nbondj_bdy_b(ib_bdy) =  0
+         ELSEIF( (com_north_b == 1) .and. (com_south_b == 0) ) THEN   ;   nbondj_bdy_b(ib_bdy) = -1
+         ELSEIF( (com_north_b == 0) .and. (com_south_b == 1) ) THEN   ;   nbondj_bdy_b(ib_bdy) =  1
          ENDIF
 
@@ -1094,7 +1071,7 @@
             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 )      ! 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
+               idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( REAL( nbr - 1 ) *0.5 )      ! tanh formulation
+!               idx_bdy(ib_bdy)%nbw(ib,igrd) = (REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.  ! quadratic
+!               idx_bdy(ib_bdy)%nbw(ib,igrd) =  REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy))       ! linear
             END DO
          END DO 
@@ -1106,7 +1083,7 @@
                nbr => idx_bdy(ib_bdy)%nbr(ib,igrd)
                idx_bdy(ib_bdy)%nbd(ib,igrd) = 1. / ( rn_time_dmp(ib_bdy) * rday ) & 
-               & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.   ! quadratic
+               & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic
                idx_bdy(ib_bdy)%nbdout(ib,igrd) = 1. / ( rn_time_dmp_out(ib_bdy) * rday ) & 
-               & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.   ! quadratic
+               & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic
             END DO
          END DO 
@@ -1129,10 +1106,10 @@
 
          ! Derive mask on U and V grid from mask on T grid
-         bdyumask(:,:) = 0.e0
-         bdyvmask(:,:) = 0.e0
+         bdyumask(:,:) = 0._wp
+         bdyvmask(:,:) = 0._wp
          DO ij=1, jpjm1
             DO ii=1, jpim1
-               bdyumask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii+1, ij )
-               bdyvmask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii  ,ij+1)  
+               bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij )
+               bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)  
             END DO
          END DO
@@ -1148,10 +1125,6 @@
                   umask(ii,ij,ik) = umask(ii,ij,ik) * bdyumask(ii,ij)
                   vmask(ii,ij,ik) = vmask(ii,ij,ik) * bdyvmask(ii,ij)
-                  bmask(ii,ij)    = bmask(ii,ij)    * bdytmask(ii,ij)
                END DO      
             END DO
-         END DO
-
-         DO ik = 1, jpkm1
             DO ij = 2, jpjm1
                DO ii = 2, jpim1
@@ -1161,19 +1134,17 @@
             END DO
          END DO
-
          tmask_i (:,:) = ssmask(:,:) * tmask_i(:,:)
-
+         !
       ENDIF ! ln_mask_file=.TRUE.
       
       bdytmask(:,:) = ssmask(:,:)
-      IF( .not. ln_mask_file ) THEN
-         ! If .not. ln_mask_file then we need to derive mask on U and V grid 
-         ! from mask on T grid here.
-         bdyumask(:,:) = 0.e0
-         bdyvmask(:,:) = 0.e0
-         DO ij=1, jpjm1
-            DO ii=1, jpim1
-               bdyumask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii+1, ij )
-               bdyvmask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii  ,ij+1)  
+      IF( .NOT.ln_mask_file ) THEN
+         ! If .not. ln_mask_file then we need to derive mask on U and V grid from mask on T grid here.
+         bdyumask(:,:) = 0._wp
+         bdyvmask(:,:) = 0._wp
+         DO ij = 1, jpjm1
+            DO ii = 1, jpim1
+               bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij )
+               bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)  
             END DO
          END DO
@@ -1181,30 +1152,24 @@
       ENDIF
 
-      ! bdy masks and bmask are now set to zero on boundary points:
-      igrd = 1       ! In the free surface case, bmask is at T-points
-      DO ib_bdy = 1, nb_bdy
-        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)     
-          bmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0
-        ENDDO
-      ENDDO
+      ! bdy masks are now set to zero on boundary points:
       !
       igrd = 1
       DO ib_bdy = 1, nb_bdy
         DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)      
-          bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0
-        ENDDO
-      ENDDO
+          bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp
+        END DO
+      END DO
       !
       igrd = 2
       DO ib_bdy = 1, nb_bdy
         DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
-          bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0
-        ENDDO
-      ENDDO
+          bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp
+        END DO
+      END DO
       !
       igrd = 3
       DO ib_bdy = 1, nb_bdy
         DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
-          bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0
+          bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp
         ENDDO
       ENDDO
@@ -1212,5 +1177,5 @@
       ! For the flagu/flagv calculation below we require a version of fmask without
       ! the land boundary condition (shlat) included:
-      CALL wrk_alloc(jpi,jpj,zfmask) 
+      CALL wrk_alloc(jpi,jpj,  zfmask ) 
       DO ij = 2, jpjm1
          DO ii = 2, jpim1
@@ -1227,6 +1192,6 @@
       DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components
 
-         idx_bdy(ib_bdy)%flagu(:,:) = 0.e0
-         idx_bdy(ib_bdy)%flagv(:,:) = 0.e0
+         idx_bdy(ib_bdy)%flagu(:,:) = 0._wp
+         idx_bdy(ib_bdy)%flagv(:,:) = 0._wp
          icount = 0 
 
@@ -1238,13 +1203,7 @@
          DO igrd = 1,jpbgrd 
             SELECT CASE( igrd )
-               CASE( 1 )
-                  pmask => umask(:,:,1)
-                  i_offset = 0
-               CASE( 2 ) 
-                  pmask => bdytmask
-                  i_offset = 1
-               CASE( 3 ) 
-                  pmask => zfmask(:,:)
-                  i_offset = 0
+               CASE( 1 )   ;   pmask => umask   (:,:,1)   ;   i_offset = 0
+               CASE( 2 )   ;   pmask => bdytmask(:,:)     ;   i_offset = 1
+               CASE( 3 )   ;   pmask => zfmask  (:,:)     ;   i_offset = 0
             END SELECT 
             icount = 0
@@ -1277,15 +1236,9 @@
          ! flagv =  1 : v is normal to the boundary and is direction is inward
 
-         DO igrd = 1,jpbgrd 
+         DO igrd = 1, jpbgrd 
             SELECT CASE( igrd )
-               CASE( 1 )
-                  pmask => vmask(:,:,1)
-                  j_offset = 0
-               CASE( 2 )
-                  pmask => zfmask(:,:)
-                  j_offset = 0
-               CASE( 3 )
-                  pmask => bdytmask
-                  j_offset = 1
+               CASE( 1 )   ;   pmask => vmask (:,:,1)   ;   j_offset = 0
+               CASE( 2 )   ;   pmask => zfmask(:,:)     ;   j_offset = 0
+               CASE( 3 )   ;   pmask => bdytmask        ;   j_offset = 1
             END SELECT 
             icount = 0
@@ -1293,6 +1246,6 @@
                nbi => idx_bdy(ib_bdy)%nbi(ib,igrd)
                nbj => idx_bdy(ib_bdy)%nbj(ib,igrd)
-               znfl = pmask(nbi,nbj+j_offset-1  )
-               zsfl = pmask(nbi,nbj+j_offset)
+               znfl = pmask(nbi,nbj+j_offset-1)
+               zsfl = pmask(nbi,nbj+j_offset  )
                ! This error check only works if you are using the bdyXmask arrays
                IF( j_offset == 1 .and. znfl + zsfl == 2 ) THEN
@@ -1312,11 +1265,11 @@
             ENDIF 
          END DO
-
+         !
       END DO
 
       ! Compute total lateral surface for volume correction:
       ! ----------------------------------------------------
-      ! JC: this must be done at each time step with key_vvl
-      bdysurftot = 0.e0 
+      ! JC: this must be done at each time step with non-linear free surface
+      bdysurftot = 0._wp 
       IF( ln_vol ) THEN  
          igrd = 2      ! Lateral surface at U-points
@@ -1326,10 +1279,10 @@
                nbj => idx_bdy(ib_bdy)%nbj(ib,igrd)
                flagu => idx_bdy(ib_bdy)%flagu(ib,igrd)
-               bdysurftot = bdysurftot + hu     (nbi  , nbj)                           &
+               bdysurftot = bdysurftot + hu_n   (nbi  , nbj)                           &
                   &                    * e2u    (nbi  , nbj) * ABS( flagu ) &
                   &                    * tmask_i(nbi  , nbj)                           &
                   &                    * tmask_i(nbi+1, nbj)                   
-            ENDDO
-         ENDDO
+            END DO
+         END DO
 
          igrd=3 ! Add lateral surface at V-points
@@ -1339,10 +1292,10 @@
                nbj => idx_bdy(ib_bdy)%nbj(ib,igrd)
                flagv => idx_bdy(ib_bdy)%flagv(ib,igrd)
-               bdysurftot = bdysurftot + hv     (nbi, nbj  )                           &
+               bdysurftot = bdysurftot + hv_n   (nbi, nbj  )                           &
                   &                    * e1v    (nbi, nbj  ) * ABS( flagv ) &
                   &                    * tmask_i(nbi, nbj  )                           &
                   &                    * tmask_i(nbi, nbj+1)
-            ENDDO
-         ENDDO
+            END DO
+         END DO
          !
          IF( lk_mpp )   CALL mpp_sum( bdysurftot )      ! sum over the global domain
@@ -1351,13 +1304,12 @@
       ! Tidy up
       !--------
-      IF (nb_bdy>0) THEN
-         DEALLOCATE(nbidta, nbjdta, nbrdta)
-      ENDIF
-
-      CALL wrk_dealloc(jpi,jpj,zfmask) 
-
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_init')
-
+      IF( nb_bdy>0 )   DEALLOCATE( nbidta, nbjdta, nbrdta )
+      !
+      CALL wrk_dealloc(jpi,jpj,   zfmask ) 
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_init')
+      !
    END SUBROUTINE bdy_init
+
 
    SUBROUTINE bdy_ctl_seg
@@ -1602,5 +1554,5 @@
             ELSE
                ! This is a corner
-               WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)
+               IF(lwp) 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
@@ -1616,5 +1568,5 @@
             ELSE
                ! This is a corner
-               WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)
+               IF(lwp) 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
@@ -1646,5 +1598,5 @@
             ELSE
                ! This is a corner
-               WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)
+               IF(lwp) 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
@@ -1660,5 +1612,5 @@
             ELSE
                ! This is a corner
-               WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)
+               IF(lwp) 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
@@ -1750,15 +1702,15 @@
       itest = 0
 
-      IF (cn_dyn2d(ib1)/=cn_dyn2d(ib2)) itest = itest + 1
-      IF (cn_dyn3d(ib1)/=cn_dyn3d(ib2)) itest = itest + 1
-      IF (cn_tra(ib1)/=cn_tra(ib2)) itest = itest + 1
-      !
-      IF (nn_dyn2d_dta(ib1)/=nn_dyn2d_dta(ib2)) itest = itest + 1
-      IF (nn_dyn3d_dta(ib1)/=nn_dyn3d_dta(ib2)) itest = itest + 1
-      IF (nn_tra_dta(ib1)/=nn_tra_dta(ib2)) itest = itest + 1
-      !
-      IF (nn_rimwidth(ib1)/=nn_rimwidth(ib2)) itest = itest + 1   
-      !
-      IF ( itest>0 ) THEN
+      IF( cn_dyn2d(ib1) /= cn_dyn2d(ib2) )   itest = itest + 1
+      IF( cn_dyn3d(ib1) /= cn_dyn3d(ib2) )   itest = itest + 1
+      IF( cn_tra  (ib1) /= cn_tra  (ib2) )   itest = itest + 1
+      !
+      IF( nn_dyn2d_dta(ib1) /= nn_dyn2d_dta(ib2) )   itest = itest + 1
+      IF( nn_dyn3d_dta(ib1) /= nn_dyn3d_dta(ib2) )   itest = itest + 1
+      IF( nn_tra_dta  (ib1) /= nn_tra_dta  (ib2) )   itest = itest + 1
+      !
+      IF( nn_rimwidth(ib1) /= nn_rimwidth(ib2) )   itest = itest + 1   
+      !
+      IF( itest>0 ) THEN
          IF(lwp) WRITE(numout,*) ' E R R O R : Segments ', ib1, 'and ', ib2
          IF(lwp) WRITE(numout,*) ' ==========  have different open bdy schemes'                                                  
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90	(revision 6808)
@@ -4,5 +4,5 @@
    !! Unstructured Open Boundary Cond. :  Library module of generic boundary algorithms.
    !!======================================================================
-   !! History :  3.6  !  2013     (D. Storkey) new module
+   !! History :  3.6  !  2013     (D. Storkey) original code
    !!----------------------------------------------------------------------
 #if defined key_bdy 
@@ -13,11 +13,12 @@
    !!   bdy_orlanski_3d
    !!----------------------------------------------------------------------
-   USE timing          ! Timing
-   USE oce             ! ocean dynamics and tracers 
-   USE dom_oce         ! ocean space and time domain
-   USE bdy_oce         ! ocean open boundary conditions
-   USE phycst          ! physical constants
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE in_out_manager  !
+   USE oce            ! ocean dynamics and tracers 
+   USE dom_oce        ! ocean space and time domain
+   USE bdy_oce        ! ocean open boundary conditions
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager !
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -46,11 +47,11 @@
       !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)    
       !!----------------------------------------------------------------------
-      TYPE(OBC_INDEX),            INTENT(in)     ::   idx      ! BDY indices
-      INTEGER,                    INTENT(in)     ::   igrd     ! grid index
-      REAL(wp), DIMENSION(:,:),   INTENT(in)     ::   phib     ! model before 2D field
-      REAL(wp), DIMENSION(:,:),   INTENT(inout)  ::   phia     ! model after 2D field (to be updated)
-      REAL(wp), DIMENSION(:),     INTENT(in)     ::   phi_ext  ! external forcing data
-      LOGICAL,                    INTENT(in)     ::   ll_npo   ! switch for NPO version
-
+      TYPE(OBC_INDEX),          INTENT(in   ) ::   idx      ! BDY indices
+      INTEGER ,                 INTENT(in   ) ::   igrd     ! grid index
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   phib     ! model before 2D field
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   phia     ! model after 2D field (to be updated)
+      REAL(wp), DIMENSION(:)  , INTENT(in   ) ::   phi_ext  ! external forcing data
+      LOGICAL ,                 INTENT(in   ) ::   ll_npo   ! switch for NPO version
+      !
       INTEGER  ::   jb                                     ! dummy loop indices
       INTEGER  ::   ii, ij, iibm1, iibm2, ijbm1, ijbm2     ! 2D addresses
@@ -71,7 +72,7 @@
       REAL(wp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives
       !!----------------------------------------------------------------------
-
-      IF( nn_timing == 1 ) CALL timing_start('bdy_orlanski_2d')
-
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_orlanski_2d')
+      !
       ! ----------------------------------!
       ! Orlanski boundary conditions     :!
@@ -80,25 +81,25 @@
       SELECT CASE(igrd)
          CASE(1)
-            pmask => tmask(:,:,1)
+            pmask      => tmask(:,:,1)
             pmask_xdif => umask(:,:,1)
             pmask_ydif => vmask(:,:,1)
-            pe_xdif => e1u(:,:)
-            pe_ydif => e2v(:,:)
+            pe_xdif    => e1u(:,:)
+            pe_ydif    => e2v(:,:)
             ii_offset = 0
             ij_offset = 0
          CASE(2)
-            pmask => umask(:,:,1)
+            pmask      => umask(:,:,1)
             pmask_xdif => tmask(:,:,1)
             pmask_ydif => fmask(:,:,1)
-            pe_xdif => e1t(:,:)
-            pe_ydif => e2f(:,:)
+            pe_xdif    => e1t(:,:)
+            pe_ydif    => e2f(:,:)
             ii_offset = 1
             ij_offset = 0
          CASE(3)
-            pmask => vmask(:,:,1)
+            pmask      => vmask(:,:,1)
             pmask_xdif => fmask(:,:,1)
             pmask_ydif => tmask(:,:,1)
-            pe_xdif => e1f(:,:)
-            pe_ydif => e2t(:,:)
+            pe_xdif    => e1f(:,:)
+            pe_ydif    => e2t(:,:)
             ii_offset = 0
             ij_offset = 1
@@ -189,6 +190,6 @@
       END DO
       !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_orlanski_2d')
-
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_orlanski_2d')
+      !
    END SUBROUTINE bdy_orlanski_2d
 
@@ -205,11 +206,11 @@
       !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)    
       !!----------------------------------------------------------------------
-      TYPE(OBC_INDEX),            INTENT(in)     ::   idx      ! BDY indices
-      INTEGER,                    INTENT(in)     ::   igrd     ! grid index
-      REAL(wp), DIMENSION(:,:,:), INTENT(in)     ::   phib     ! model before 3D field
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated)
-      REAL(wp), DIMENSION(:,:),   INTENT(in)     ::   phi_ext  ! external forcing data
-      LOGICAL,                    INTENT(in)     ::   ll_npo   ! switch for NPO version
-
+      TYPE(OBC_INDEX),            INTENT(in   ) ::   idx      ! BDY indices
+      INTEGER ,                   INTENT(in   ) ::   igrd     ! grid index
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   phib     ! model before 3D field
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phia     ! model after 3D field (to be updated)
+      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   phi_ext  ! external forcing data
+      LOGICAL ,                   INTENT(in   ) ::   ll_npo   ! switch for NPO version
+      !
       INTEGER  ::   jb, jk                                 ! dummy loop indices
       INTEGER  ::   ii, ij, iibm1, iibm2, ijbm1, ijbm2     ! 2D addresses
@@ -230,34 +231,34 @@
       REAL(wp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives
       !!----------------------------------------------------------------------
-
-      IF( nn_timing == 1 ) CALL timing_start('bdy_orlanski_3d')
-
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_orlanski_3d')
+      !
       ! ----------------------------------!
       ! Orlanski boundary conditions     :!
       ! ----------------------------------! 
-     
+      !
       SELECT CASE(igrd)
          CASE(1)
-            pmask => tmask(:,:,:)
+            pmask      => tmask(:,:,:)
             pmask_xdif => umask(:,:,:)
             pmask_ydif => vmask(:,:,:)
-            pe_xdif => e1u(:,:)
-            pe_ydif => e2v(:,:)
+            pe_xdif    => e1u(:,:)
+            pe_ydif    => e2v(:,:)
             ii_offset = 0
             ij_offset = 0
          CASE(2)
-            pmask => umask(:,:,:)
+            pmask      => umask(:,:,:)
             pmask_xdif => tmask(:,:,:)
             pmask_ydif => fmask(:,:,:)
-            pe_xdif => e1t(:,:)
-            pe_ydif => e2f(:,:)
+            pe_xdif    => e1t(:,:)
+            pe_ydif    => e2f(:,:)
             ii_offset = 1
             ij_offset = 0
          CASE(3)
-            pmask => vmask(:,:,:)
+            pmask      => vmask(:,:,:)
             pmask_xdif => fmask(:,:,:)
             pmask_ydif => tmask(:,:,:)
-            pe_xdif => e1f(:,:)
-            pe_ydif => e2t(:,:)
+            pe_xdif    => e1f(:,:)
+            pe_ydif    => e2t(:,:)
             ii_offset = 0
             ij_offset = 1
@@ -350,7 +351,7 @@
          !
       END DO
-
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_orlanski_3d')
-
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_orlanski_3d')
+      !
    END SUBROUTINE bdy_orlanski_3d
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 6808)
@@ -15,23 +15,21 @@
    !!   'key_bdy'     Open Boundary Condition
    !!----------------------------------------------------------------------
-   !!   PUBLIC
-   !!      bdytide_init     : read of namelist and initialisation of tidal harmonics data
-   !!      tide_update   : calculation of tidal forcing at each timestep
-   !!----------------------------------------------------------------------
-   USE timing          ! Timing
-   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 daymod          ! calendar
-   USE wrk_nemo        ! Memory allocation
-   USE tideini
-!   USE tide_mod       ! Useless ??
-   USE fldread
-   USE dynspg_oce, ONLY: lk_dynspg_ts
+   !!   bdytide_init  : read of namelist and initialisation of tidal harmonics data
+   !!   tide_update   : calculation of tidal forcing at each timestep
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers 
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE bdy_par        ! Unstructured boundary parameters
+   USE bdy_oce        ! ocean open boundary conditions
+   USE tideini        ! 
+   USE daymod         ! calendar
+   !
+   USE in_out_manager ! I/O units
+   USE iom            ! xIO server
+   USE fldread        !
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! timing
 
    IMPLICIT NONE
@@ -43,10 +41,8 @@
 
    TYPE, PUBLIC ::   TIDES_DATA     !: Storage for external tidal harmonics data
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh0       !: Tidal constituents : SSH0 (read in file)
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u0         !: Tidal constituents : U0   (read in file)
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v0         !: Tidal constituents : V0   (read in file)
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh        !: Tidal constituents : SSH  (after nodal cor.)
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u          !: Tidal constituents : U    (after nodal cor.)
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v          !: Tidal constituents : V    (after nodal cor.)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh0     !: Tidal constituents : SSH0   (read in file)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u0, v0   !: Tidal constituents : U0, V0 (read in file)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh      !: Tidal constituents : SSH    (after nodal cor.)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u , v    !: Tidal constituents : U , V  (after nodal cor.)
    END TYPE TIDES_DATA
 
@@ -54,9 +50,9 @@
    TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides  !: External tidal harmonics data
 !$AGRIF_END_DO_NOT_TREAT
-   TYPE(OBC_DATA)  , PRIVATE, DIMENSION(jp_bdy) :: dta_bdy_s  !: bdy external data (slow component)
+   TYPE(OBC_DATA)  , PUBLIC, DIMENSION(jp_bdy) :: dta_bdy_s  !: bdy external data (slow component)
 
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -92,7 +88,7 @@
       NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj
       !!----------------------------------------------------------------------
-
-      IF( nn_timing == 1 ) CALL timing_start('bdytide_init')
-
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdytide_init')
+      !
       IF (nb_bdy>0) THEN
          IF(lwp) WRITE(numout,*)
@@ -264,5 +260,5 @@
             ENDIF ! ln_bdytide_2ddta=.true.
             !
-            IF ( ln_bdytide_conj ) THEN ! assume complex conjugate in data files
+            IF( ln_bdytide_conj ) THEN    ! assume complex conjugate in data files
                td%ssh0(:,:,2) = - td%ssh0(:,:,2)
                td%u0  (:,:,2) = - td%u0  (:,:,2)
@@ -270,23 +266,23 @@
             ENDIF
             !
-            IF ( lk_dynspg_ts ) THEN ! Allocate arrays to save slowly varying boundary data during
-                                     ! time splitting integration
-               ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) )
-               ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) )
-               ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) )
-               dta_bdy_s(ib_bdy)%ssh(:) = 0.e0
-               dta_bdy_s(ib_bdy)%u2d(:) = 0.e0
-               dta_bdy_s(ib_bdy)%v2d(:) = 0.e0
-            ENDIF
+            ! Allocate slow varying data in the case of time splitting:
+            ! Do it anyway because at this stage knowledge of free surface scheme is unknown
+            ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) )
+            ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) )
+            ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) )
+            dta_bdy_s(ib_bdy)%ssh(:) = 0._wp
+            dta_bdy_s(ib_bdy)%u2d(:) = 0._wp
+            dta_bdy_s(ib_bdy)%v2d(:) = 0._wp
             !
          ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2
          !
       END DO ! loop on ib_bdy
-
-      IF( nn_timing == 1 ) CALL timing_stop('bdytide_init')
-
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdytide_init')
+      !
    END SUBROUTINE bdytide_init
 
-   SUBROUTINE bdytide_update ( kt, idx, dta, td, jit, time_offset )
+
+   SUBROUTINE bdytide_update( kt, idx, dta, td, jit, time_offset )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdytide_update  ***
@@ -295,25 +291,25 @@
       !!                
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in )            ::   kt          ! Main timestep counter
-      TYPE(OBC_INDEX), INTENT( in )    ::   idx         ! OBC indices
-      TYPE(OBC_DATA),  INTENT(inout)   ::   dta         ! OBC external data
-      TYPE(TIDES_DATA),INTENT( inout ) ::   td          ! tidal harmonics data
-      INTEGER,INTENT(in),OPTIONAL      ::   jit         ! Barotropic timestep counter (for timesplitting option)
-      INTEGER,INTENT( in ), OPTIONAL   ::   time_offset ! time offset in units of timesteps. NB. if jit
-                                                        ! is present then units = subcycle timesteps.
-                                                        ! time_offset = 0  => get data at "now"    time level
-                                                        ! time_offset = -1 => get data at "before" time level
-                                                        ! time_offset = +1 => get data at "after"  time level
-                                                        ! etc.
-      !!
-      INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays)
-      INTEGER                          :: itide, igrd, ib   ! dummy loop indices
-      INTEGER                          :: time_add          ! time offset in units of timesteps
-      REAL(wp)                         :: z_arg, z_sarg, zflag, zramp      
+      INTEGER          , INTENT(in   ) ::   kt          ! Main timestep counter
+      TYPE(OBC_INDEX)  , INTENT(in   ) ::   idx         ! OBC indices
+      TYPE(OBC_DATA)   , INTENT(inout) ::   dta         ! OBC external data
+      TYPE(TIDES_DATA) , INTENT(inout) ::   td          ! tidal harmonics data
+      INTEGER, OPTIONAL, INTENT(in   ) ::   jit         ! Barotropic timestep counter (for timesplitting option)
+      INTEGER, OPTIONAL, INTENT(in   ) ::   time_offset ! time offset in units of timesteps. NB. if jit
+      !                                                 ! is present then units = subcycle timesteps.
+      !                                                 ! time_offset = 0  => get data at "now"    time level
+      !                                                 ! time_offset = -1 => get data at "before" time level
+      !                                                 ! time_offset = +1 => get data at "after"  time level
+      !                                                 ! etc.
+      !
+      INTEGER  ::   itide, igrd, ib       ! dummy loop indices
+      INTEGER  ::   time_add              ! time offset in units of timesteps
+      INTEGER, DIMENSION(3) ::   ilen0    ! length of boundary data (from OBC arrays)
+      REAL(wp) ::   z_arg, z_sarg, zflag, zramp   ! local scalars    
       REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost
       !!----------------------------------------------------------------------
-
-      IF( nn_timing == 1 ) CALL timing_start('bdytide_update')
-
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdytide_update')
+      !
       ilen0(1) =  SIZE(td%ssh(:,1,1))
       ilen0(2) =  SIZE(td%u(:,1,1))
@@ -325,7 +321,7 @@
       ENDIF
 
-      IF ( nsec_day == NINT(0.5_wp * rdttra(1)) .AND. zflag==1 ) THEN
+      IF ( (nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000) .AND. zflag==1 ) THEN
         !
-        kt_tide = kt
+        kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt
         !
         IF(lwp) THEN
@@ -376,5 +372,5 @@
       END DO
       !
-      IF( nn_timing == 1 ) CALL timing_stop('bdytide_update')
+      IF( nn_timing == 1 )   CALL timing_stop('bdytide_update')
       !
    END SUBROUTINE bdytide_update
@@ -387,23 +383,23 @@
       !!                
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in )            ::   kt          ! Main timestep counter
-      INTEGER, INTENT( in ),OPTIONAL   ::   kit         ! Barotropic timestep counter (for timesplitting option)
-      INTEGER, INTENT( in ),OPTIONAL   ::   time_offset ! time offset in units of timesteps. NB. if kit
-                                                        ! is present then units = subcycle timesteps.
-                                                        ! time_offset = 0  => get data at "now"    time level
-                                                        ! time_offset = -1 => get data at "before" time level
-                                                        ! time_offset = +1 => get data at "after"  time level
-                                                        ! etc.
-      !!
-      LOGICAL  :: lk_first_btstp  ! =.TRUE. if time splitting and first barotropic step
-      INTEGER,          DIMENSION(jpbgrd) :: ilen0 
-      INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim  ! short cuts
-      INTEGER  :: itide, ib_bdy, ib, igrd                     ! loop indices
-      INTEGER  :: time_add                                    ! time offset in units of timesteps
-      REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist      
-      !!----------------------------------------------------------------------
-
-      IF( nn_timing == 1 ) CALL timing_start('bdy_dta_tides')
-
+      INTEGER,           INTENT(in) ::   kt          ! Main timestep counter
+      INTEGER, OPTIONAL, INTENT(in) ::   kit         ! Barotropic timestep counter (for timesplitting option)
+      INTEGER, OPTIONAL, INTENT(in) ::   time_offset ! time offset in units of timesteps. NB. if kit
+      !                                              ! is present then units = subcycle timesteps.
+      !                                              ! time_offset = 0  => get data at "now"    time level
+      !                                              ! time_offset = -1 => get data at "before" time level
+      !                                              ! time_offset = +1 => get data at "after"  time level
+      !                                              ! etc.
+      !
+      LOGICAL  ::   lk_first_btstp            ! =.TRUE. if time splitting and first barotropic step
+      INTEGER  ::   itide, ib_bdy, ib, igrd   ! loop indices
+      INTEGER  ::   time_add                  ! time offset in units of timesteps
+      INTEGER, DIMENSION(jpbgrd)   ::   ilen0 
+      INTEGER, DIMENSION(1:jpbgrd) ::   nblen, nblenrim  ! short cuts
+      REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist      
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_dta_tides')
+      !
       lk_first_btstp=.TRUE.
       IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF
@@ -416,5 +412,5 @@
       ! Absolute time from model initialization:   
       IF( PRESENT(kit) ) THEN  
-         z_arg = ( kt + (kit+0.5_wp*(time_add-1)) / REAL(nn_baro,wp) ) * rdt
+         z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt
       ELSE                              
          z_arg = ( kt + time_add ) * rdt
@@ -440,7 +436,7 @@
             ! We refresh nodal factors every day below
             ! This should be done somewhere else
-            IF ( nsec_day == NINT(0.5_wp * rdttra(1)) .AND. lk_first_btstp ) THEN
-               !
-               kt_tide = kt               
+            IF ( ( nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN
+               !
+               kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt
                !
                IF(lwp) THEN
@@ -456,16 +452,9 @@
             zoff = -kt_tide * rdt ! time offset relative to nodal factor computation time
             !
-            ! If time splitting, save data at first barotropic iteration
-            IF ( PRESENT(kit) ) THEN
-               IF ( lk_first_btstp ) THEN ! Save slow varying open boundary data:
-                  IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy(ib_bdy)%ssh(1:ilen0(1))
-                  IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy(ib_bdy)%u2d(1:ilen0(2))
-                  IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy(ib_bdy)%v2d(1:ilen0(3))
-
-               ELSE ! Initialize arrays from slow varying open boundary data:            
-                  IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1))
-                  IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2))
-                  IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3))
-               ENDIF
+            ! If time splitting, initialize arrays from slow varying open boundary data:
+            IF ( PRESENT(kit) ) THEN           
+               IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1))
+               IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2))
+               IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3))
             ENDIF
             !
@@ -511,22 +500,23 @@
    END SUBROUTINE bdy_dta_tides
 
+
    SUBROUTINE tide_init_elevation( idx, td )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE tide_init_elevation  ***
       !!----------------------------------------------------------------------
-      TYPE(OBC_INDEX), INTENT( in )      ::   idx     ! OBC indices
-      TYPE(TIDES_DATA),INTENT( inout )   ::   td      ! tidal harmonics data
-      !! * Local declarations
-      INTEGER, DIMENSION(1)            ::   ilen0       !: length of boundary data (from OBC arrays)
+      TYPE(OBC_INDEX) , INTENT(in   ) ::   idx   ! OBC indices
+      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data
+      !
+      INTEGER ::   itide, igrd, ib       ! dummy loop indices
+      INTEGER, DIMENSION(1) ::   ilen0   ! length of boundary data (from OBC arrays)
       REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
-      INTEGER                            ::   itide, igrd, ib      ! dummy loop indices
-
+      !!----------------------------------------------------------------------
+      !
       igrd=1   
                               ! SSH on tracer grid.
-   
       ilen0(1) =  SIZE(td%ssh0(:,1,1))
-
-      ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
-
+      !
+      ALLOCATE( mod_tide(ilen0(igrd)), phi_tide(ilen0(igrd)) )
+      !
       DO itide = 1, nb_harmo
          DO ib = 1, ilen0(igrd)
@@ -543,27 +533,29 @@
          ENDDO
       END DO
-
-      DEALLOCATE(mod_tide,phi_tide)
-
+      !
+      DEALLOCATE( mod_tide, phi_tide )
+      !
    END SUBROUTINE tide_init_elevation
 
+
    SUBROUTINE tide_init_velocities( idx, td )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE tide_init_elevation  ***
       !!----------------------------------------------------------------------
-      TYPE(OBC_INDEX), INTENT( in )      ::   idx     ! OBC indices
-      TYPE(TIDES_DATA),INTENT( inout )      ::   td      ! tidal harmonics data
-      !! * Local declarations
-      INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays)
+      TYPE(OBC_INDEX) , INTENT(in   ) ::   idx   ! OBC indices
+      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data
+      !
+      INTEGER ::   itide, igrd, ib       ! dummy loop indices
+      INTEGER, DIMENSION(3) ::   ilen0   ! length of boundary data (from OBC arrays)
       REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
-      INTEGER                            ::   itide, igrd, ib      ! dummy loop indices
-
+      !!----------------------------------------------------------------------
+      !
       ilen0(2) =  SIZE(td%u0(:,1,1))
       ilen0(3) =  SIZE(td%v0(:,1,1))
-
+      !
       igrd=2                                 ! U grid.
-
-      ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
-
+      !
+      ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) )
+      !
       DO itide = 1, nb_harmo
          DO ib = 1, ilen0(igrd)
@@ -580,10 +572,10 @@
          ENDDO
       END DO
-
-      DEALLOCATE(mod_tide,phi_tide)
-
+      !
+      DEALLOCATE( mod_tide , phi_tide )
+      !
       igrd=3                                 ! V grid.
-
-      ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
+      !
+      ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) )
 
       DO itide = 1, nb_harmo
@@ -601,8 +593,9 @@
          ENDDO
       END DO
-
-      DEALLOCATE(mod_tide,phi_tide)
-
+      !
+      DEALLOCATE( mod_tide, phi_tide )
+      !
   END SUBROUTINE tide_init_velocities
+
 #else
    !!----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 6808)
@@ -16,19 +16,19 @@
    !!   bdy_tra_frs        : Apply Flow Relaxation Scheme
    !!----------------------------------------------------------------------
-   USE timing          ! Timing
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE bdy_oce         ! ocean open boundary conditions
-   USE bdylib          ! for orlanski library routines
-   USE bdydta, ONLY:   bf
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE in_out_manager  ! I/O manager
-
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables 
+   USE bdy_oce        ! ocean open boundary conditions
+   USE bdylib         ! for orlanski library routines
+   USE bdydta   , ONLY:   bf   ! 
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE timing         ! Timing
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC bdy_tra      ! routine called in tranxt.F90 
-   PUBLIC bdy_tra_dmp  ! routine called in step.F90 
+   PUBLIC   bdy_tra      ! called in tranxt.F90 
+   PUBLIC   bdy_tra_dmp  ! called in step.F90 
 
    !!----------------------------------------------------------------------
@@ -46,36 +46,29 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) :: kt     ! Main time step counter
-      !!
-      INTEGER               :: ib_bdy ! Loop index
+      INTEGER, INTENT(in) ::   kt   ! Main time step counter
+      !
+      INTEGER ::   ib_bdy   ! Loop index
+      !!----------------------------------------------------------------------
 
       DO ib_bdy=1, nb_bdy
-
+         !
          SELECT CASE( cn_tra(ib_bdy) )
-         CASE('none')
-            CYCLE
-         CASE('frs')
-            CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
-         CASE('specified')
-            CALL bdy_tra_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
-         CASE('neumann')
-            CALL bdy_tra_nmn( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
-         CASE('orlanski')
-            CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. )
-         CASE('orlanski_npo')
-            CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. )
-         CASE('runoff')
-            CALL bdy_tra_rnf( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
-         CASE DEFAULT
-            CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' )
+         CASE('none'        )   ;   CYCLE
+         CASE('frs'         )   ;   CALL bdy_tra_frs     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
+         CASE('specified'   )   ;   CALL bdy_tra_spe     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
+         CASE('neumann'     )   ;   CALL bdy_tra_nmn     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
+         CASE('orlanski'    )   ;   CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. )
+         CASE('orlanski_npo')   ;   CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. )
+         CASE('runoff'      )   ;   CALL bdy_tra_rnf     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
+         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( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy )
          CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy )
-      ENDDO
-      !
-
+      END DO
+      !
    END SUBROUTINE bdy_tra
 
+
    SUBROUTINE bdy_tra_frs( idx, dta, kt )
       !!----------------------------------------------------------------------
@@ -86,8 +79,8 @@
       !! Reference : Engedahl H., 1995, Tellus, 365-382.
       !!----------------------------------------------------------------------
-      INTEGER,         INTENT(in) ::   kt
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
-      !! 
+      INTEGER,         INTENT(in) ::   kt    !
+      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
@@ -95,5 +88,5 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_frs')
+      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_frs')
       !
       igrd = 1                       ! Everything is at T-points here
@@ -108,10 +101,11 @@
       END DO 
       !
-      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
-      !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_frs')
+      IF( kt .eq. nit000 )   CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_frs')
       !
    END SUBROUTINE bdy_tra_frs
-  
+
+
    SUBROUTINE bdy_tra_spe( idx, dta, kt )
       !!----------------------------------------------------------------------
@@ -121,8 +115,8 @@
       !! 
       !!----------------------------------------------------------------------
-      INTEGER,         INTENT(in) ::   kt
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
-      !! 
+      INTEGER,         INTENT(in) ::   kt    !
+      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
@@ -142,10 +136,11 @@
       END DO
       !
-      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
-      !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_spe')
+      IF( kt == nit000 )   CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_spe')
       !
    END SUBROUTINE bdy_tra_spe
 
+
    SUBROUTINE bdy_tra_nmn( idx, dta, kt )
       !!----------------------------------------------------------------------
@@ -155,8 +150,8 @@
       !! 
       !!----------------------------------------------------------------------
-      INTEGER,         INTENT(in) ::   kt
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
-      !! 
+      INTEGER,         INTENT(in) ::   kt    ! 
+      TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices
+      TYPE(OBC_DATA) , INTENT(in) ::   dta   ! OBC external data
+      !
       REAL(wp) ::   zwgt           ! boundary weight
       REAL(wp) ::   zcoef, zcoef1,zcoef2
@@ -165,5 +160,5 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn')
+      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_nmn')
       !
       igrd = 1                       ! Everything is at T-points here
@@ -197,7 +192,7 @@
       END DO
       !
-      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
-      !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn')
+      IF( kt == nit000 )   CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_nmn')
       !
    END SUBROUTINE bdy_tra_nmn
@@ -214,11 +209,11 @@
       !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)    
       !!----------------------------------------------------------------------
-      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
-
+      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_tra_orlanski')
       !
@@ -231,7 +226,6 @@
       CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo )
       !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_orlanski')
-      !
-
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_orlanski')
+      !
    END SUBROUTINE bdy_tra_orlanski
 
@@ -246,8 +240,8 @@
       !! 
       !!----------------------------------------------------------------------
-      INTEGER,         INTENT(in) ::   kt
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
-      !! 
+      INTEGER        , INTENT(in) ::   kt    ! 
+      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
@@ -255,5 +249,5 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_rnf')
+      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_rnf')
       !
       igrd = 1                       ! Everything is at T-points here
@@ -269,10 +263,11 @@
       END DO
       !
-      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
-      !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf')
+      IF( kt == nit000 )   CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_rnf')
       !
    END SUBROUTINE bdy_tra_rnf
 
+
    SUBROUTINE bdy_tra_dmp( kt )
       !!----------------------------------------------------------------------
@@ -282,6 +277,6 @@
       !! 
       !!----------------------------------------------------------------------
-      INTEGER,         INTENT(in) ::   kt
-      !! 
+      INTEGER, INTENT(in) ::   kt   !
+      !
       REAL(wp) ::   zwgt           ! boundary weight
       REAL(wp) ::   zta, zsa, ztime
@@ -291,8 +286,8 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_dmp')
-      !
-      DO ib_bdy=1, nb_bdy
-         IF ( ln_tra_dmp(ib_bdy) ) THEN
+      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_dmp')
+      !
+      DO ib_bdy = 1, nb_bdy
+         IF( ln_tra_dmp(ib_bdy) ) THEN
             igrd = 1                       ! Everything is at T-points here
             DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
@@ -308,7 +303,7 @@
             END DO
          ENDIF
-      ENDDO
-      !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_dmp')
+      END DO
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_dmp')
       !
    END SUBROUTINE bdy_tra_dmp
@@ -326,5 +321,4 @@
       WRITE(*,*) 'bdy_tra_dmp: You should not have seen this print! error?', kt
    END SUBROUTINE bdy_tra_dmp
-
 #endif
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 6808)
@@ -10,28 +10,27 @@
    !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
    !!----------------------------------------------------------------------
-#if   defined key_bdy   &&   defined key_dynspg_flt
+#if defined key_bdy
    !!----------------------------------------------------------------------
-   !!   'key_bdy'            AND      unstructured open boundary conditions
-   !!   'key_dynspg_flt'                              filtered free surface
+   !!   'key_bdy'                     unstructured open boundary conditions
    !!----------------------------------------------------------------------
-   USE timing          ! Timing
-   USE oce             ! ocean dynamics and tracers 
-   USE sbcisf          ! ice shelf
-   USE dom_oce         ! ocean space and time domain 
-   USE phycst          ! physical constants
-   USE bdy_oce         ! ocean open boundary conditions
-   USE lib_mpp         ! for mppsum
-   USE in_out_manager  ! I/O manager
-   USE sbc_oce         ! ocean surface boundary conditions
+   USE oce            ! ocean dynamics and tracers 
+   USE bdy_oce        ! ocean open boundary conditions
+   USE sbc_oce        ! ocean surface boundary conditions
+   USE dom_oce        ! ocean space and time domain 
+   USE phycst         ! physical constants
+   USE sbcisf         ! ice shelf
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! for mppsum
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran routines library
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC bdy_vol        ! routine called by dynspg_flt.h90
+   PUBLIC   bdy_vol    ! called by ???
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
@@ -43,9 +42,9 @@
       !!                      ***  ROUTINE bdyvol  ***
       !!
-      !! ** Purpose :   This routine is called in dynspg_flt to control 
-      !!      the volume of the system. A correction velocity is calculated
-      !!      to correct the total transport through the unstructured OBC. 
+      !! ** Purpose :   This routine controls the volume of the system. 
+      !!      A correction velocity is calculated to correct the total transport 
+      !!      through the unstructured OBC. 
       !!      The total depth used is constant (H0) to be consistent with the 
-      !!      linear free surface coded in OPA 8.2
+      !!      linear free surface coded in OPA 8.2    <<<=== !!gm  ???? true ????
       !!
       !! ** Method  :   The correction velocity (zubtpecor here) is defined calculating
@@ -71,6 +70,6 @@
       !!            (set nn_volctl to 1 in tne namelist for this option)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
-      !!
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
       INTEGER  ::   ji, jj, jk, jb, jgrd
       INTEGER  ::   ib_bdy, ii, ij
@@ -78,9 +77,9 @@
       TYPE(OBC_INDEX), POINTER :: idx
       !!-----------------------------------------------------------------------------
-
-      IF( nn_timing == 1 ) CALL timing_start('bdy_vol')
-
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_vol')
+      !
       IF( ln_vol ) THEN
-
+      !
       IF( kt == nit000 ) THEN 
          IF(lwp) WRITE(numout,*)
@@ -91,13 +90,17 @@
       ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain
       ! -----------------------------------------------------------------------
-      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+rdivisf*fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0
+!!gm replace these lines :
+      z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0
       IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain
+!!gm   by :
+!!gm      z_cflxemp = glob_sum(  ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:)  ) / rau0
+!!gm
 
       ! Transport through the unstructured open boundary
       ! ------------------------------------------------
-      zubtpecor = 0.e0
+      zubtpecor = 0._wp
       DO ib_bdy = 1, nb_bdy
          idx => idx_bdy(ib_bdy)
-
+         !
          jgrd = 2                               ! cumulate u component contribution first 
          DO jb = 1, idx%nblenrim(jgrd)
@@ -105,5 +108,5 @@
                ii = idx%nbi(jb,jgrd)
                ij = idx%nbj(jb,jgrd)
-               zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk)
+               zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * e3u_n(ii,ij,jk)
             END DO
          END DO
@@ -113,8 +116,8 @@
                ii = idx%nbi(jb,jgrd)
                ij = idx%nbj(jb,jgrd)
-               zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 
+               zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * e3v_n(ii,ij,jk) 
             END DO
          END DO
-
+         !
       END DO
       IF( lk_mpp )   CALL mpp_sum( zubtpecor )   ! sum over the global domain
@@ -122,14 +125,14 @@
       ! The normal velocity correction
       ! ------------------------------
-      IF( nn_volctl==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot 
-      ELSE                   ;   zubtpecor =   zubtpecor             / bdysurftot
+      IF( nn_volctl==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp ) / bdysurftot 
+      ELSE                      ;   zubtpecor =   zubtpecor               / bdysurftot
       END IF
 
       ! Correction of the total velocity on the unstructured boundary to respect the mass flux conservation
       ! -------------------------------------------------------------
-      ztranst = 0.e0
+      ztranst = 0._wp
       DO ib_bdy = 1, nb_bdy
          idx => idx_bdy(ib_bdy)
-
+         !
          jgrd = 2                               ! correct u component
          DO jb = 1, idx%nblenrim(jgrd)
@@ -138,5 +141,5 @@
                ij = idx%nbj(jb,jgrd)
                ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb,jgrd) * zubtpecor * umask(ii,ij,jk)
-               ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk)
+               ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * e3u_n(ii,ij,jk)
             END DO
          END DO
@@ -147,8 +150,8 @@
                ij = idx%nbj(jb,jgrd)
                va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb,jgrd) * zubtpecor * vmask(ii,ij,jk)
-               ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk)
+               ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * e3v_n(ii,ij,jk)
             END DO
          END DO
-
+         !
       END DO
       IF( lk_mpp )   CALL mpp_sum( ztranst )   ! sum over the global domain
@@ -156,5 +159,5 @@
       ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected
       ! ------------------------------------------------------
-      IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN
+      IF( lwp .AND. MOD( kt, nwrite ) == 0 ) THEN
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*)'bdy_vol : time step :', kt
@@ -166,8 +169,8 @@
       END IF 
       !
-      IF( nn_timing == 1 ) CALL timing_stop('bdy_vol')
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_vol')
       !
       END IF ! ln_vol
-
+      !
    END SUBROUTINE bdy_vol
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90	(revision 6808)
@@ -4,7 +4,7 @@
    !! Ocean domain  :  1D configuration
    !!=====================================================================
-   !! History :   2.0  !  2004-09 (C. Ethe)     Original code
-   !!             3.0  !  2008-04 (G. Madec)    adaptation to SBC
-   !!             3.5  !  2013-10 (D. Calvert)  add namelist
+   !! History :  2.0  !  2004-09 (C. Ethe)     Original code
+   !!            3.0  !  2008-04 (G. Madec)    adaptation to SBC
+   !!            3.5  !  2013-10 (D. Calvert)  add namelist
    !!----------------------------------------------------------------------
 #if defined key_c1d
@@ -12,23 +12,24 @@
    !!   'key_c1d'                                   1D column configuration
    !!----------------------------------------------------------------------
-   !!   c1d_init       : read in the C1D namelist
+   !!   c1d_init      : read in the C1D namelist
    !!----------------------------------------------------------------------
-   USE in_out_manager   ! I/O manager
-   USE par_kind         ! kind parameters
-   USE lib_mpp
+   USE par_kind       ! kind parameters
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   c1d_init                                 ! called by nemogcm.F90
+   PUBLIC   c1d_init   ! called by nemogcm.F90
 
    LOGICAL , PUBLIC, PARAMETER ::  lk_c1d = .TRUE.   ! 1D config. flag
 
-   REAL(wp), PUBLIC            ::  rn_lat1d     ! Column latitude
-   REAL(wp), PUBLIC            ::  rn_lon1d     ! Column longitude
-   LOGICAL , PUBLIC            ::  ln_c1d_locpt ! Localization (or not) of 1D column in a grid
+   REAL(wp), PUBLIC ::  rn_lat1d     !: Column latitude
+   REAL(wp), PUBLIC ::  rn_lon1d     !: Column longitude
+   LOGICAL , PUBLIC ::  ln_c1d_locpt !: Localization (or not) of 1D column in a grid
 
    !!----------------------------------------------------------------------
-   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
+   !! NEMO/C1D 3.7 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -44,18 +45,17 @@
       !! ** Method  :   Read namelist namc1d 
       !!----------------------------------------------------------------------
-      INTEGER ::   ios                 ! Local integer output status for namelist read
+      INTEGER ::   ios   ! Local integer
+      !!
       NAMELIST/namc1d/ rn_lat1d, rn_lon1d , ln_c1d_locpt
       !!----------------------------------------------------------------------
       !
-
       REWIND( numnam_ref )              ! Namelist namc1d in reference namelist : Tracer advection scheme
       READ  ( numnam_ref, namc1d, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d in reference namelist', lwp )
-
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d in reference namelist', lwp )
+      !
       REWIND( numnam_cfg )              ! Namelist namtra_adv in configuration namelist : Tracer advection scheme
       READ  ( numnam_cfg, namc1d, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namc1d )
-
       !
       IF(lwp) THEN                    ! Control print
@@ -69,5 +69,4 @@
       ENDIF
       !
-      !
    END SUBROUTINE c1d_init
 
@@ -77,14 +76,10 @@
    !!----------------------------------------------------------------------
    USE par_kind         ! kind parameters
-
    LOGICAL, PUBLIC, PARAMETER ::   lk_c1d = .FALSE.   !: 1D config. flag de-activated
    REAL(wp)                   ::   rn_lat1d, rn_lon1d
    LOGICAL , PUBLIC           ::   ln_c1d_locpt = .FALSE. 
-
 CONTAINS
-
    SUBROUTINE c1d_init               ! Dummy routine
    END SUBROUTINE c1d_init
-
 #endif
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90	(revision 6808)
@@ -12,8 +12,9 @@
    !!   dom_c1d     : Determine jpizoom/jpjzoom from a given lat/lon
    !!----------------------------------------------------------------------
-   USE phycst                        ! Physical constants (and par_oce)
-   USE iom                           ! I/O library (iom_get)
-   USE in_out_manager                ! I/O manager (ctmp1)
-   USE dom_oce , ONLY : nimpp, njmpp ! Shared/distributed memory setting (mpp_init routine)
+   USE phycst         ! Physical constants (and par_oce)
+   USE dom_oce , ONLY : nimpp, njmpp ! Shared/distributed memory setting
+   !
+   USE iom            ! I/O library (iom_get)
+   USE in_out_manager ! I/O manager (ctmp1)
    USE wrk_nemo                      ! Memory allocation
    USE timing                        ! Timing
@@ -22,8 +23,8 @@
    PRIVATE
 
-   PUBLIC   dom_c1d                  ! Routine called in domcfg.F90
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   PUBLIC   dom_c1d   ! called in domcfg.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -43,29 +44,23 @@
       !! ** Action  : Recalculate jpizoom, jpjzoom (indices of C1D zoom)
       !!----------------------------------------------------------------------
-      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   &
-         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,                  &
-         &             rn_rdtmax, rn_rdth     , nn_closea , ln_crs,    &
-         &             jphgr_msh, &
-         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
-         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
-         &             ppa2, ppkth2, ppacr2
-
-      INTEGER  ::  ji, jj                          ! Dummy loop indices
-      INTEGER  ::  inum                            ! Coordinate file handle (case 0)
-      INTEGER  ::  ijeq                            ! Index of equator T point (case 4)
-      INTEGER  ::  ios                             ! Local integer output status for namelist read
-
-      INTEGER , DIMENSION(2) ::   iloc             ! Minloc returned indices
-
-      REAL(wp), INTENT(in) ::  plat                ! Column latitude
-      REAL(wp), INTENT(in) ::  plon                ! Column longitude
-
+      REAL(wp), INTENT(in) ::  plat, plon    ! Column latitude &  longitude
+      !
+      INTEGER  ::  ji, jj   ! Dummy loop indices
+      INTEGER  ::  inum     ! Coordinate file handle (case 0)
+      INTEGER  ::  ijeq     ! Index of equator T point (case 4)
+      INTEGER  ::  ios      ! Local integer output status for namelist read
+      INTEGER , DIMENSION(2) ::   iloc   ! Minloc returned indices
       REAL(wp) ::  zlon                            ! Wraparound longitude
       REAL(wp) ::  zti, ztj, zarg                  ! Local scalars
       REAL(wp) ::  glam0, gphi0                    ! Variables corresponding to parameters ppglam0 ppgphi0 set in par_oce
       REAL(wp) ::  zlam1, zcos_alpha, ze1, ze1deg  ! Case 5 local scalars
-      REAL(wp) ::  zphi1, zsin_alpha, zim05, zjm05 !          "
-
+      REAL(wp) ::  zphi1, zsin_alpha, zim05, zjm05 !          
       REAL(wp) , POINTER, DIMENSION(:,:) ::  gphidta, glamdta, zdist ! Global lat/lon
+      !!
+      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   &
+         &             rn_atfp     , rn_rdt      ,nn_closea , ln_crs,  jphgr_msh, &
+         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
+         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
+         &             ppa2, ppkth2, ppacr2
       !!----------------------------------------------------------------------
 
@@ -74,13 +69,11 @@
       REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
       READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 901 )
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
-  
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
       !
       REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
       READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
-
-      CALL wrk_alloc( jpidta, jpjdta, gphidta, glamdta, zdist )
-
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
+
+      CALL wrk_alloc( jpidta,jpjdta,   gphidta, glamdta, zdist )
 
       ! ============================= !
@@ -171,5 +164,4 @@
       END SELECT
 
-
       ! ============================== !
       !  Code from dom_ngb:            !
@@ -192,5 +184,5 @@
       jpjzoom = iloc(2) + njmpp - 2  ! corner index of the zoom domain.
 
-      CALL wrk_dealloc( jpidta, jpjdta, gphidta, glamdta, zdist )
+      CALL wrk_dealloc( jpidta,jpjdta,   gphidta, glamdta, zdist )
 
       IF (lwp) THEN
@@ -202,7 +194,7 @@
          WRITE(numout,*)
       ENDIF
-
+      !
       IF( nn_timing == 1 )   CALL timing_stop('dom_c1d')
-
+      !
    END SUBROUTINE dom_c1d
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90	(revision 6808)
@@ -4,19 +4,20 @@
    !! Ocean data  :  read ocean U & V current data from gridded data
    !!======================================================================
-   !! History :  3.5   ! 2013-08  (D. Calvert)  Original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dta_uvd_init   : read namelist and allocate data structures
-   !!   dta_uvd        : read and time-interpolate ocean U & V current data
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE fldread         ! read input fields
-   USE in_out_manager  ! I/O manager
-   USE phycst          ! physical constants
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
+   !! History :  3.5  ! 2013-08  (D. Calvert)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dta_uvd_init  : read namelist and allocate data structures
+   !!   dta_uvd       : read and time-interpolate ocean U & V current data
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean space and time domain
+   !
+   USE in_out_manager ! I/O manager
+   USE fldread        ! read input fields
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -26,13 +27,11 @@
    PUBLIC   dta_uvd        ! called by istate.F90 and dyndmp.90
 
-   LOGICAL , PUBLIC ::   ln_uvd_init         ! Flag to initialise with U & V current data
-   LOGICAL , PUBLIC ::   ln_uvd_dyndmp       ! Flag for Newtonian damping toward U & V current data
+   LOGICAL , PUBLIC ::   ln_uvd_init     ! Flag to initialise with U & V current data
+   LOGICAL , PUBLIC ::   ln_uvd_dyndmp   ! Flag for Newtonian damping toward U & V current data
 
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_uvd   ! structure for input U & V current (file information and data)
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -50,27 +49,25 @@
       !!              - fld_fill data structure with namelist information
       !!----------------------------------------------------------------------
-      LOGICAL, INTENT(in), OPTIONAL ::   ld_dyndmp         ! force the initialization when dyndmp is used
-      !
-      INTEGER ::   ierr0, ierr1, ierr2, ierr3              ! temporary integers
-      !
-      CHARACTER(len=100)            ::   cn_dir            ! Root directory for location of files to be used
-      TYPE(FLD_N), DIMENSION(2)     ::   suv_i             ! Combined U & V namelist information
-      TYPE(FLD_N)                   ::   sn_ucur, sn_vcur  ! U & V data namelist information
+      LOGICAL, INTENT(in), OPTIONAL ::   ld_dyndmp   ! force the initialization when dyndmp is used
+      !
+      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3     ! local integers
+      CHARACTER(len=100)        ::   cn_dir            ! Root directory for location of files to be used
+      TYPE(FLD_N), DIMENSION(2) ::   suv_i             ! Combined U & V namelist information
+      TYPE(FLD_N)               ::   sn_ucur, sn_vcur  ! U & V data namelist information
       !!
       NAMELIST/namc1d_uvd/ ln_uvd_init, ln_uvd_dyndmp, cn_dir, sn_ucur, sn_vcur
-      INTEGER  ::   ios
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dta_uvd_init')
-      !
-      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dta_uvd_init')
+      !
+      ierr0 = 0   ;   ierr1 = 0   ;   ierr2 = 0  ;   ierr3 = 0
 
       REWIND( numnam_ref )              ! Namelist namc1d_uvd in reference namelist : 
       READ  ( numnam_ref, namc1d_uvd, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist', lwp )
-
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist', lwp )
+      !
       REWIND( numnam_cfg )              ! Namelist namc1d_uvd in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, namc1d_uvd, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namc1d_uvd )
 
@@ -149,13 +146,7 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('dta_uvd')
+      IF( nn_timing == 1 )   CALL timing_start('dta_uvd')
       !
       CALL fld_read( kt, 1, sf_uvd )      !==   read U & V current data at time step kt   ==!
-      !
-      !
-      !                                   !==   ORCA_R2 configuration and U & V current damping   ==! 
-      IF( cp_cfg == "orca" .AND. jp_cfg == 2 .AND. ln_uvd_dyndmp ) THEN    ! some hand made alterations
-         !!! EMPTY- to be added for running in 3D context !!!
-      ENDIF
       !
       puvd(:,:,:,1) = sf_uvd(1)%fnow(:,:,:)                 ! NO mask
@@ -164,5 +155,5 @@
       IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
          !
-         CALL wrk_alloc( jpk, zup, zvp )
+         CALL wrk_alloc( jpk,   zup, zvp )
          !
          IF( kt == nit000 .AND. lwp )THEN
@@ -174,5 +165,5 @@
             DO ji = 1, jpi                ! determines the interpolated U & V current profiles at each (i,j) point
                DO jk = 1, jpk
-                  zl = fsdept(ji,jj,jk)
+                  zl = gdept_n(ji,jj,jk)
                   IF    ( zl < gdept_1d(1  ) ) THEN          ! extrapolate above the first level of data
                      zup(jk) =  puvd(ji,jj,1    ,1)
@@ -200,5 +191,5 @@
          END DO
          ! 
-         CALL wrk_dealloc( jpk, zup, zvp )
+         CALL wrk_dealloc( jpk,   zup, zvp )
          ! 
       ELSE                                !==   z- or zps- coordinate   ==!
@@ -222,25 +213,4 @@
       ENDIF
       !
-      IF( lwp .AND. kt == nit000 ) THEN   ! control print
-         WRITE(numout,*) ' U current '
-         WRITE(numout,*)
-         WRITE(numout,*)'  level = 1'
-         CALL prihre( puvd(:,:,1    ,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         WRITE(numout,*)'  level = ', jpk/2
-         CALL prihre( puvd(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         WRITE(numout,*)'  level = ', jpkm1
-         CALL prihre( puvd(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         WRITE(numout,*)
-         WRITE(numout,*) ' V current '
-         WRITE(numout,*)
-         WRITE(numout,*)'  level = 1'
-         CALL prihre( puvd(:,:,1    ,2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         WRITE(numout,*)'  level = ', jpk/2
-         CALL prihre( puvd(:,:,jpk/2,2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         WRITE(numout,*)'  level = ', jpkm1
-         CALL prihre( puvd(:,:,jpkm1,2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         WRITE(numout,*)
-      ENDIF
-      !
       IF( .NOT. ln_uvd_dyndmp    ) THEN   !==   deallocate U & V current structure   ==! 
          !                                !==   (data used only for initialization)  ==!
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90	(revision 6808)
@@ -11,23 +11,24 @@
    !!   'key_c1d'                                          1D Configuration
    !!----------------------------------------------------------------------
-   !!   cor_c1d      : Coriolis factor at T-point (1D configuration)
-   !!   dyn_cor_c1d  : vorticity trend due to Coriolis at T-point
+   !!   cor_c1d       : Coriolis factor at T-point (1D configuration)
+   !!   dyn_cor_c1d   : vorticity trend due to Coriolis at T-point
    !!----------------------------------------------------------------------
-   USE oce               ! ocean dynamics and tracers
-   USE dom_oce           ! ocean space and time domain
-   USE phycst            ! physical constants
-   USE in_out_manager    ! I/O manager
-   USE prtctl            ! Print control
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   cor_c1d      ! routine called by OPA.F90
-   PUBLIC   dyn_cor_c1d  ! routine called by step1d.F90
+   PUBLIC   cor_c1d      ! called by nemogcm.F90
+   PUBLIC   dyn_cor_c1d  ! called by step1d.F90
 
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
+   !! NEMO/C1D 3.7 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -41,5 +42,5 @@
       !! ** Purpose : set the Coriolis factor at T-point
       !!----------------------------------------------------------------------
-      REAL(wp) ::   zphi0, zbeta, zf0         !  temporary scalars
+      REAL(wp) ::   zphi0, zbeta, zf0   ! local scalars
       !!----------------------------------------------------------------------
 
@@ -87,5 +88,5 @@
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !!
-      INTEGER ::   ji, jj, jk         ! dummy loop indices
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
       !!----------------------------------------------------------------------
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90	(revision 6808)
@@ -23,4 +23,5 @@
    USE dtauvd         ! data: U & V current
    USE zdfmxl         ! vertical physics: mixed layer depth
+   !
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
@@ -36,15 +37,14 @@
    PUBLIC   dyn_dmp      ! routine called by step_c1d.F90
 
-   LOGICAL, PUBLIC ::   ln_dyndmp           ! Flag for Newtonian damping
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  utrdmp    ! damping U current trend (m/s2)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  vtrdmp    ! damping V current trend (m/s2)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  resto_uv  ! restoring coeff. on U & V current
+   LOGICAL, PUBLIC ::   ln_dyndmp   !: Flag for Newtonian damping
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  utrdmp    !: damping U current trend (m/s2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  vtrdmp    !: damping V current trend (m/s2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  resto_uv  !: restoring coeff. on U & V current
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -75,18 +75,18 @@
       !!              - calculate damping coefficient
       !!----------------------------------------------------------------------
+      INTEGER ::   ios, imask   ! local integers
+      !!
       NAMELIST/namc1d_dyndmp/ ln_dyndmp
-      INTEGER :: ios
-      INTEGER :: imask
-      !!----------------------------------------------------------------------
-
+      !!----------------------------------------------------------------------
+      !
       REWIND( numnam_ref )              ! Namelist namc1d_dyndmp in reference namelist : 
       READ  ( numnam_ref, namc1d_dyndmp, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist', lwp )
-
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist', lwp )
+      !
       REWIND( numnam_cfg )              ! Namelist namc1d_dyndmp in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, namc1d_dyndmp, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namc1d_dyndmp )
-
+      !
       IF(lwp) THEN                           ! control print
          WRITE(numout,*)
@@ -101,5 +101,5 @@
          WRITE(numout,*)
       ENDIF
-
+      !
       IF( ln_dyndmp ) THEN
          !                                   !==   allocate the data arrays   ==!
@@ -150,14 +150,14 @@
       !! ** Action  : - (ua,va)   momentum trends updated with the damping trend
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt                        ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk                           ! dummy loop indices
-      REAL(wp) ::   zua, zva                             ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zuv_dta  ! Read in data 
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zua, zva     ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuv_dta   ! Read in data 
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start( 'dyn_dmp' )
       !
-      CALL wrk_alloc( jpi, jpj, jpk, 2,  zuv_dta )
+      CALL wrk_alloc( jpi,jpj,jpk,2,   zuv_dta )
       !
       !                           !==   read and interpolate U & V current data at kt   ==!
@@ -204,5 +204,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
+                  IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
                      zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) )
                      zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) )
@@ -221,12 +221,9 @@
       END SELECT
       !
-!!gm      !                           ! Trend diagnostic
-!!gm      IF( l_trddyn )   CALL trd_mod( utrdmp, vtrdmp, jpdyn_trd_dat, 'DYN', kt )
-      !
       !                           ! Control print
       IF( ln_ctl   )   CALL prt_ctl( tab3d_1=ua(:,:,:), clinfo1=' dmp  - Ua: ', mask1=umask,   &
          &                           tab3d_2=va(:,:,:), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, 2,  zuv_dta )
+      CALL wrk_dealloc( jpi,jpj,jpk,2,   zuv_dta )
       !
       IF( nn_timing == 1 )  CALL timing_stop( 'dyn_dmp')
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90	(revision 6807)
+++ 	(revision )
@@ -1,103 +1,0 @@
-MODULE dynnxt_c1d
-   !!======================================================================
-   !!                       ***  MODULE  dynnxt_c1d  ***
-   !! Ocean dynamics: time stepping in 1D configuration
-   !!======================================================================
-   !! History :  2.0  !  2004-10  (C. Ethe)  Original code from dynnxt.F90
-   !!            3.0  !  2008-04  (G.madec)  Style only
-   !!----------------------------------------------------------------------
-#if defined key_c1d
-   !!----------------------------------------------------------------------
-   !!   'key_c1d'                                          1D Configuration
-   !!----------------------------------------------------------------------  
-   !!   dyn_nxt_c1d : update the horizontal velocity from the momentum trend
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! lateral boundary condition (or mpp link)
-   USE prtctl          ! Print control
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC dyn_nxt_c1d                ! routine called by step.F90
-   !!----------------------------------------------------------------------
-   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dyn_nxt_c1d ( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_nxt_c1d  ***
-      !!                   
-      !! ** Purpose :   Compute the after horizontal velocity from the momentum trend.
-      !!
-      !! ** Method  :   Apply lateral boundary conditions on the trends (ua,va) 
-      !!      through calls to routine lbc_lnk.
-      !!      After velocity is compute using a leap-frog scheme environment:
-      !!         (ua,va) = (ub,vb) + 2 rdt (ua,va)
-      !!      Time filter applied on now horizontal velocity to avoid the
-      !!      divergence of two consecutive time-steps and swap of dynamics
-      !!      arrays to start the next time step:
-      !!         (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ]
-      !!         (un,vn) = (ua,va) 
-      !!
-      !! ** Action : - Update ub,vb arrays, the before horizontal velocity
-      !!             - Update un,vn arrays, the now horizontal velocity
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !!
-      INTEGER  ::   jk           ! dummy loop indices
-      REAL(wp) ::   z2dt         ! temporary scalar
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn_nxt_c1d : time stepping on 1D configuation'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-
-      z2dt = 2._wp * rdt                                                   ! Local constant initialization
-      IF( neuler == 0 .AND. kt == nit000 )  z2dt = rdt
-
-      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )      ! Lateral boundary conditions
-
-      DO jk = 1, jpkm1                                                     ! Next Velocity
-         ua(:,:,jk) = ( ub(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk)
-         va(:,:,jk) = ( vb(:,:,jk) + z2dt * va(:,:,jk) ) * vmask(:,:,jk)
-      END DO 
- 
-      DO jk = 1, jpkm1                                                     ! Time filter and swap of dynamics arrays
-         IF( neuler == 0 .AND. kt == nit000 ) THEN                               ! Euler (forward) time stepping
-             ub(:,:,jk) = un(:,:,jk)
-             vb(:,:,jk) = vn(:,:,jk)
-             un(:,:,jk) = ua(:,:,jk)
-             vn(:,:,jk) = va(:,:,jk)
-         ELSE                                                                    ! Leap-frog time stepping
-             ub(:,:,jk) = atfp * ( ub(:,:,jk) + ua(:,:,jk) ) + atfp1 * un(:,:,jk)
-             vb(:,:,jk) = atfp * ( vb(:,:,jk) + va(:,:,jk) ) + atfp1 * vn(:,:,jk)
-             un(:,:,jk) = ua(:,:,jk)
-             vn(:,:,jk) = va(:,:,jk)
-         ENDIF
-      END DO
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt_c1d  - Un: ', mask1=umask,   &
-         &                       tab3d_2=vn, clinfo2=' Vn: '           , mask2=vmask )
-      !
-   END SUBROUTINE dyn_nxt_c1d
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default key                                     NO 1D Config
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE dyn_nxt_c1d ( kt )
-      WRITE(*,*) 'dyn_nxt_c1d: You should not have seen this print! error?', kt
-   END SUBROUTINE dyn_nxt_c1d
-#endif
-
-   !!======================================================================
-END MODULE dynnxt_c1d
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 6808)
@@ -18,5 +18,5 @@
 #endif
    USE dyncor_c1d      ! Coriolis term (c1d case)         (dyn_cor_1d     )
-   USE dynnxt_c1d      ! time-stepping                    (dyn_nxt routine)
+   USE dynnxt          ! time-stepping                    (dyn_nxt routine)
    USE dyndmp          ! U & V momentum damping           (dyn_dmp routine)
    USE restart         ! restart 
@@ -28,8 +28,7 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
+   !! NEMO/C1D 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -55,4 +54,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kstp   ! ocean time-step index
+      !
       INTEGER ::   jk       ! dummy loop indice
       INTEGER ::   indic    ! error indicator if < 0
@@ -82,5 +82,4 @@
       IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz
       IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz
-      IF( lk_zdfkpp  )   CALL zdf_kpp( kstp )            ! KPP closure scheme for Kz
       IF( lk_zdfcst  )   THEN                            ! Constant Kz (reset avt, avm[uv] to the background value)
          avt (:,:,:) = rn_avt0 * tmask(:,:,:)
@@ -93,10 +92,6 @@
       ENDIF
       IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity
-
       IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing
-
-      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   &
-         &               CALL zdf_ddm( kstp )         ! double diffusive mixing
-         
+      IF( lk_zdfddm  )   CALL zdf_ddm( kstp )         ! double diffusive mixing
                          CALL zdf_mxl( kstp )         ! mixed layer depth
 
@@ -128,5 +123,4 @@
       IF( ln_traqsr )   CALL tra_qsr( kstp )       ! penetrative solar radiation qsr
       IF( ln_tradmp )   CALL tra_dmp( kstp )       ! internal damping trends- tracers
-      IF( lk_zdfkpp )   CALL tra_kpp( kstp )       ! KPP non-local tracer fluxes
                         CALL tra_zdf( kstp )       ! vertical mixing
                         CALL eos( tsn, rhd, rhop, gdept_0(:,:,:) )   ! now potential density for zdfmxl
@@ -145,5 +139,5 @@
                         CALL dyn_cor_c1d( kstp )   ! vorticity term including Coriolis
                         CALL dyn_zdf    ( kstp )   ! vertical diffusion
-                        CALL dyn_nxt_c1d( kstp )   ! lateral velocity at next time step
+                        CALL dyn_nxt    ( kstp )   ! lateral velocity at next time step
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 6808)
@@ -11,9 +11,7 @@
    USE in_out_manager
 
-
    IMPLICIT NONE
    PUBLIC
 
-   
    PUBLIC crs_dom_alloc  ! Called from crsini.F90
    PUBLIC crs_dom_alloc2  ! Called from crsini.F90
@@ -161,8 +159,9 @@
       INTEGER,  PUBLIC, ALLOCATABLE, DIMENSION(:,:)    ::  nmln_crs, hmld_crs, hmlp_crs, hmlpt_crs                       
 
-      ! Direction of lateral diffusion
-
-
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
    
@@ -258,5 +257,6 @@
 
    END FUNCTION crs_dom_alloc
-   
+
+
    INTEGER FUNCTION crs_dom_alloc2()
       !!-------------------------------------------------------------------
@@ -272,5 +272,6 @@
       crs_dom_alloc2 = MAXVAL(ierr)
 
-      END FUNCTION crs_dom_alloc2
+   END FUNCTION crs_dom_alloc2
+
 
    SUBROUTINE dom_grid_glo
@@ -312,4 +313,5 @@
    END SUBROUTINE dom_grid_glo
 
+
    SUBROUTINE dom_grid_crs
       !!--------------------------------------------------------------------
@@ -318,5 +320,4 @@
       !! ** Purpose :  Save the parent grid information & Switch to coarse grid domain
       !!---------------------------------------------------------------------
-
       !
       !                        Switch to coarse grid domain
@@ -349,12 +350,8 @@
       nlejt(:)  = nlejt_crs(:)
       njmppt(:) = njmppt_crs(:)
-
-
       !
    END SUBROUTINE dom_grid_crs
    
-      
    !!======================================================================
-
 END MODULE crs
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90	(revision 6808)
@@ -30,13 +30,12 @@
    !!       Original.   May 2012.  (J. Simeon, C. Calone, G. Madec, C. Ethe)
    !!===================================================================
-
    USE dom_oce        ! ocean space and time domain and to get jperio
-   USE wrk_nemo       ! work arrays
    USE crs            ! domain for coarse grid
+   !
    USE in_out_manager 
    USE par_kind
    USE crslbclnk
+   USE wrk_nemo       ! work arrays
    USE lib_mpp
-   
 
    IMPLICIT NONE
@@ -54,10 +53,10 @@
    REAL(wp) :: r_inf = 1e+36
 
-   !! Substitutions
-#  include "domzgr_substitute.h90"
-   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
-
 
    SUBROUTINE crs_dom_msk
@@ -133,4 +132,5 @@
    END SUBROUTINE crs_dom_msk
 
+
    SUBROUTINE crs_dom_coordinates( p_gphi, p_glam, cd_type, p_gphi_crs, p_glam_crs )
       !!----------------------------------------------------------------
@@ -334,5 +334,5 @@
       !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V)
       !!              cd_op       = applied operation (SUM, VOL, WGT)
-      !!              p_fse3      = (Optional) parent grid vertical level thickness (fse3u or fse3v)
+      !!              p_e3      = (Optional) parent grid vertical level thickness (e3u or e3v)
       !! ** Outputs : p_cfield2d_1 = (Optional) 2D field on coarse grid
       !!              p_cfield2d_2 = (Optional) 2D field on coarse grid
@@ -342,32 +342,27 @@
       !! History.     4 Jun.  Write for WGT and scale factors only
       !!----------------------------------------------------------------
-      !! 
-      !!  Arguments
-      CHARACTER(len=1),                         INTENT(in)  :: cd_type  ! grid type U,V 
-      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_mask  ! Parent grid U,V mask
-      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e1     ! Parent grid U,V scale factors (e1)
-      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e2     ! Parent grid U,V scale factors (e2)
-      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v)
-
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld1_crs ! Coarse grid box 3D quantity 
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld2_crs ! Coarse grid box 3D quantity 
-
-      !! Local variables
-      REAL(wp)                                :: zdAm
-      INTEGER                                 :: ji, jj, jk , ii, ij, je_2
-
-      REAL(wp), DIMENSION(:,:,:), POINTER     :: zvol, zmask      
+      CHARACTER(len=1),                         INTENT(in   ) ::   cd_type    ! grid type U,V 
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in   ) ::   p_mask     ! Parent grid U,V mask
+      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in   ) ::   p_e1       ! Parent grid U,V scale factors (e1)
+      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in   ) ::   p_e2       ! Parent grid U,V scale factors (e2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in   ) ::   p_e3       ! Parent grid vertical level thickness (e3u, e3v)
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out) ::   p_fld1_crs ! Coarse grid box 3D quantity 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out) ::   p_fld2_crs ! Coarse grid box 3D quantity 
+      !
+      INTEGER  ::   ji, jj, jk , ii, ij, je_2
+      REAL(wp) ::   zdAm
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   zvol, zmask      
       !!----------------------------------------------------------------  
-   
-      CALL wrk_alloc( jpi, jpj, jpk, zvol, zmask )
-
-      p_fld1_crs(:,:,:) = 0.0
-      p_fld2_crs(:,:,:) = 0.0
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zvol, zmask )
+      !
+      p_fld1_crs(:,:,:) = 0._wp
+      p_fld2_crs(:,:,:) = 0._wp
 
       DO jk = 1, jpk
          zvol(:,:,jk) =  p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk) 
-      ENDDO
-
-      zmask(:,:,:) = 0.0
+      END DO
+
+      zmask(:,:,:) = 0._wp
       IF( cd_type == 'W' ) THEN
          zmask(:,:,1) = p_mask(:,:,1) 
@@ -469,5 +464,5 @@
       !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors; 
       !!                                       for velocities (U or V)
-      !!              p_fse3      = parent grid vertical level thickness (fse3u or fse3v)
+      !!              p_e3      = parent grid vertical level thickness (e3u or e3v)
       !!              p_pfield    = U or V on the parent grid
       !!              p_surf_crs  = (Optional) Coarse grid weight for averaging
@@ -478,38 +473,33 @@
       !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights.
       !!----------------------------------------------------------------
-      !! 
-      !!  Arguments
-      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_fld   ! T, U, V or W on parent grid
-      CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_fld      ! T, U, V or W on parent grid
+      CHARACTER(len=3),                         INTENT(in)           :: cd_op      ! Operation SUM, MAX or MIN
       CHARACTER(len=1),                         INTENT(in)           :: cd_type    ! grid type U,V 
-      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask
-      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2)
-      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v)
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask     ! Parent grid T,U,V mask
+      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12      ! Parent grid T,U,V scale factors (e1 or e2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3       ! Parent grid vertical level thickness (e3u, e3v)
       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator    
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V maska
-      REAL(wp),                                 INTENT(in)           :: psgn    ! sign 
-
-
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity 
-
-      !! Local variables
-      INTEGER  :: ji, jj, jk 
-      INTEGER  :: ii, ij, ijie, ijje, je_2
-      REAL(wp) :: zflcrs, zsfcrs   
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask  
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs ! Coarse grid T,U,V maska
+      REAL(wp),                                 INTENT(in)           :: psgn       ! sign 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out)        :: p_fld_crs  ! Coarse grid box 3D quantity 
+      !
+      INTEGER  ::   ji, jj, jk 
+      INTEGER  ::   ii, ij, ijie, ijje, je_2
+      REAL(wp) ::   zflcrs, zsfcrs   
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   zsurf, zsurfmsk, zmask  
       !!----------------------------------------------------------------  
-   
-      p_fld_crs(:,:,:) = 0.0
-
+      !
+      p_fld_crs(:,:,:) = 0._wp
+      !
       SELECT CASE ( cd_op )
-      
-         CASE ( 'VOL' )
-      
-            CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk )
-         
-            SELECT CASE ( cd_type )
-            
-               CASE( 'T', 'W' )
-                  IF( cd_type == 'T' ) THEN
+      !
+      CASE ( 'VOL' )
+         !
+         CALL wrk_alloc( jpi,jpj,jpk,   zsurf, zsurfmsk )
+         !   
+         SELECT CASE ( cd_type )
+         !   
+         CASE( 'T', 'W' )
+               IF( cd_type == 'T' ) THEN
                      DO jk = 1, jpk
                         zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk) 
@@ -1136,5 +1126,5 @@
       !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors; 
       !!                                       for velocities (U or V)
-      !!              p_fse3      = parent grid vertical level thickness (fse3u or fse3v)
+      !!              p_e3      = parent grid vertical level thickness (e3u or e3v)
       !!              p_pfield    = U or V on the parent grid
       !!              p_surf_crs  = (Optional) Coarse grid weight for averaging
@@ -1145,6 +1135,4 @@
       !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights.
       !!----------------------------------------------------------------
-      !! 
-      !!  Arguments
       REAL(wp), DIMENSION(jpi,jpj),             INTENT(in)           :: p_fld   ! T, U, V or W on parent grid
       CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN
@@ -1152,21 +1140,18 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask
       REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2)
-      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v)
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (e3u, e3v)
       REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator    
       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V mask
       REAL(wp),                                 INTENT(in)           :: psgn   
-
       REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity 
-
-      !! Local variables
+      !
       INTEGER  :: ji, jj, jk                 ! dummy loop indices
       INTEGER  :: ijie, ijje, ii, ij, je_2
       REAL(wp) :: zflcrs, zsfcrs   
       REAL(wp), DIMENSION(:,:), POINTER :: zsurfmsk   
-
       !!----------------------------------------------------------------  
-   
-      p_fld_crs(:,:) = 0.0
-
+      !
+      p_fld_crs(:,:) = 0._wp
+      !
       SELECT CASE ( cd_op )
       
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90	(revision 6808)
@@ -33,5 +33,9 @@
    PUBLIC crs_dom_wri        ! routine called by crsini.F90
 
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 6808)
@@ -11,18 +11,19 @@
    !!                       other variables needed to be passed to TOP
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers 
-   USE dom_oce         ! ocean space and time domain
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE zdf_oce         ! vertical  physics: ocean fields
-   USE zdfddm          ! vertical  physics: double diffusion
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE in_out_manager  ! I/O manager
-   USE timing          ! preformance summary
-   USE wrk_nemo        ! working array
    USE crs
    USE crsdom
    USE crslbclnk
-   USE iom
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE zdf_oce         ! vertical  physics: ocean fields
+   USE ldftra          ! ocean active tracers: lateral diffusivity & EIV coefficients
+   USE zdfddm          ! vertical  physics: double diffusion
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! 
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE timing          ! preformance summary
+   USE wrk_nemo        ! working array
 
    IMPLICIT NONE
@@ -31,11 +32,8 @@
    PUBLIC   crs_fld                 ! routines called by step.F90
 
-
    !! * Substitutions
-#  include "zdfddm_substitute.h90"
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -52,36 +50,32 @@
       !!      2. At time of output, rescale [1] by dimension and time
       !!         to yield the spatial and temporal average.
-      !!  See. diawri_dimg.h90, sbcmod.F90
+      !!  See. sbcmod.F90
       !!
       !! ** Method  :  
       !!----------------------------------------------------------------------
-      !!
-      
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !!
-      INTEGER               ::   ji, jj, jk              ! dummy loop indices
-      !!
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs 
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs !
-      REAL(wp)       :: z2dcrsu, z2dcrsv
-      !!
-       !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk        ! dummy loop indices
+      REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zt, zt_crs
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zs, zs_crs  
+      !!----------------------------------------------------------------------
       ! 
-
       IF( nn_timing == 1 )   CALL timing_start('crs_fld')
 
       !  Initialize arrays
-      CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w )
-      CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v )
-      CALL wrk_alloc( jpi, jpj, jpk, zt, zs       )
-      !
-      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs )
+      CALL wrk_alloc( jpi,jpj,jpk,   ze3t, ze3w )
+      CALL wrk_alloc( jpi,jpj,jpk,   ze3u, ze3v )
+      CALL wrk_alloc( jpi,jpj,jpk,   zt  , zs   )
+      !
+      CALL wrk_alloc( jpi_crs,jpj_crs,jpk,   zt_crs, zs_crs )
 
       ! Depth work arrrays
-      zfse3t(:,:,:) = fse3t(:,:,:)
-      zfse3u(:,:,:) = fse3u(:,:,:)
-      zfse3v(:,:,:) = fse3v(:,:,:)
-      zfse3w(:,:,:) = fse3w(:,:,:)
+      ze3t(:,:,:) = e3t_n(:,:,:)
+      ze3u(:,:,:) = e3u_n(:,:,:)
+      ze3v(:,:,:) = e3v_n(:,:,:)
+      ze3w(:,:,:) = e3w_n(:,:,:)
 
       IF( kt == nit000  ) THEN
@@ -111,5 +105,5 @@
       !  Temperature
       zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
-      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
+      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
       tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
 
@@ -120,5 +114,5 @@
       !  Salinity
       zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
-      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
+      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
       tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:)
 
@@ -127,5 +121,5 @@
 
       !  U-velocity
-      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
+      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
       !
       zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
@@ -138,6 +132,6 @@
          END DO
       END DO
-      CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
-      CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
+      CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
+      CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
 
       CALL iom_put( "uoce"  , un_crs )   ! i-current 
@@ -146,5 +140,5 @@
 
       !  V-velocity
-      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
+      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
       !                                                                                 
       zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
@@ -157,6 +151,6 @@
          END DO
       END DO
-      CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
-      CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
+      CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
+      CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
  
       CALL iom_put( "voce"  , vn_crs )   ! i-current 
@@ -166,8 +160,8 @@
      
       !  Kinetic energy
-      CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 )
+      CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
       CALL iom_put( "eken", rke_crs )
 
-      !  Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 ) 
+      !  Horizontal divergence ( following OPA_SRC/DYN/divhor.F90 ) 
       DO jk = 1, jpkm1
          DO ji = 2, jpi_crsm1
@@ -192,5 +186,5 @@
       IF( ln_crs_wn ) THEN
          CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )
-       !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=zfse3w )
+       !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w )
       ELSE
         wn_crs(:,:,jpk) = 0._wp
@@ -203,11 +197,12 @@
 
       !  avt, avs
+!!gm BUG   TOP always uses avs !!!
       SELECT CASE ( nn_crs_kz )
          CASE ( 0 )
-            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
+            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
          CASE ( 1 )
-            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
+            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
          CASE ( 2 )
-            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 )
+            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
       END SELECT
       !
@@ -215,5 +210,5 @@
       
       !  sbc fields  
-      CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )  
+      CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t           , psgn=1.0 )  
       CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 )
       CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 )
@@ -237,8 +232,8 @@
 
       !  free memory
-      CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w )
-      CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v )
-      CALL wrk_dealloc( jpi, jpj, jpk, zt, zs       )
-      CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs )
+      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t, ze3w )
+      CALL wrk_dealloc( jpi,jpj,jpk,   ze3u, ze3v )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zt  , zs   )
+      CALL wrk_dealloc( jpi_crs,jpj_crs,jpk,   zt_crs, zs_crs )
       !
       CALL iom_swap( "nemo" )     ! return back on high-resolution grid
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 6808)
@@ -7,27 +7,32 @@
    !!----------------------------------------------------------------------
 
-   USE timing                   ! Timing
+   !!----------------------------------------------------------------------
+   !!  crs_init    : 
+   !!----------------------------------------------------------------------
+   USE par_kind, ONLY: wp
    USE par_oce                  ! For parameter jpi,jpj,jphgr_msh
-   USE dom_oce                  ! For parameters in par_oce (jperio, lk_vvl)
-   USE crs                  ! Coarse grid domain
+   USE dom_oce                  ! For parameters in par_oce
+   USE crs                      ! Coarse grid domain
    USE phycst, ONLY: omega, rad ! physical constants
-   USE wrk_nemo 
-   USE in_out_manager
-   USE par_kind, ONLY: wp
-   USE iom
    USE crsdom
    USE crsdomwri
    USE crslbclnk
+   !
+   USE iom
+   USE in_out_manager
    USE lib_mpp
+   USE wrk_nemo 
+   USE timing                   ! Timing
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC  crs_init
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-
+   PUBLIC   crs_init   ! called by nemogcm.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
    
@@ -59,5 +64,5 @@
       !! output C*dA or C*dV as summation not mran, then do mean (division) at moment of output.
       !! As is, crsfun takes into account vvl.   
-      !!      Talked about pre-setting the surface array to avoid IF/ENDIFS and division.
+      !!      Talked about pre-setting the surface array to avoid IF/ENDIF and division.
       !!      But have then to make that preset array here and elsewhere.
       !!      that is called every timestep...
@@ -65,9 +70,8 @@
       !!               - Read in pertinent data ?
       !!-------------------------------------------------------------------
-      !! Local variables
       INTEGER  :: ji,jj,jk      ! dummy indices
       INTEGER  :: ierr                                ! allocation error status
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      REAL(wp), DIMENSION(:,:,:), POINTER :: zfse3t, zfse3u, zfse3v, zfse3w
+      REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t, ze3u, ze3v, ze3w
 
       NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn
@@ -183,15 +187,15 @@
      
      !
-     CALL wrk_alloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w )
-     !
-     zfse3t(:,:,:) = fse3t(:,:,:)
-     zfse3u(:,:,:) = fse3u(:,:,:)
-     zfse3v(:,:,:) = fse3v(:,:,:)
-     zfse3w(:,:,:) = fse3w(:,:,:)
+     CALL wrk_alloc( jpi,jpj,jpk,   ze3t, ze3u, ze3v, ze3w )
+     !
+     ze3t(:,:,:) = e3t_n(:,:,:)
+     ze3u(:,:,:) = e3u_n(:,:,:)
+     ze3v(:,:,:) = e3v_n(:,:,:)
+     ze3w(:,:,:) = e3w_n(:,:,:)
 
      !    3.d.2   Surfaces 
-     CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t    )
-     CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u )
-     CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v )
+     CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t  )
+     CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=ze3u )
+     CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=ze3v )
    
      facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:)
@@ -200,12 +204,10 @@
      !    3.d.3   Vertical scale factors
      !
-   
-  
-     CALL crs_dom_e3( e1t, e2t, zfse3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs)
-     CALL crs_dom_e3( e1u, e2u, zfse3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)
-     CALL crs_dom_e3( e1v, e2v, zfse3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
-     CALL crs_dom_e3( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
-
-     ! Reset 0 to e3t_0 or e3w_0
+     CALL crs_dom_e3( e1t, e2t, ze3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs)
+     CALL crs_dom_e3( e1u, e2u, ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)
+     CALL crs_dom_e3( e1v, e2v, ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
+     CALL crs_dom_e3( e1t, e2t, ze3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
+
+     ! Replace 0 by e3t_0 or e3w_0
      DO jk = 1, jpk
         DO ji = 1, jpi_crs
@@ -220,6 +222,6 @@
 
      !    3.d.3   Vertical depth (meters)
-     CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=zfse3t, psgn=1.0 ) 
-     CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=zfse3w, psgn=1.0 )
+     CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=ze3t, psgn=1.0 ) 
+     CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=ze3w, psgn=1.0 )
 
 
@@ -228,5 +230,5 @@
      !---------------------------------------------------------
      ! 4.a. Ocean volume or area unmasked and masked
-     CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, ocean_volume_crs_t, facvol_t )
+     CALL crs_dom_facvol( tmask, 'T', e1t, e2t, ze3t, ocean_volume_crs_t, facvol_t )
      !
      bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:)
@@ -235,5 +237,5 @@
      WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:)
 
-     CALL crs_dom_facvol( tmask, 'W', e1t, e2t, zfse3w, ocean_volume_crs_w, facvol_w )
+     CALL crs_dom_facvol( tmask, 'W', e1t, e2t, ze3w, ocean_volume_crs_w, facvol_w )
      !
      !---------------------------------------------------------
@@ -247,13 +249,11 @@
      ENDIF
      
-     !---------------------------------------------------------
-     ! 7. Finish and clean-up
-     !---------------------------------------------------------
-     CALL wrk_dealloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w )
-
-
+      !---------------------------------------------------------
+      ! 7. Finish and clean-up
+      !---------------------------------------------------------
+      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t, ze3u, ze3v, ze3w )
+      !
    END SUBROUTINE crs_init
     
    !!======================================================================
-
 END MODULE crsini
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 6808)
@@ -1,4 +1,3 @@
 MODULE crslbclnk
-
    !!======================================================================
    !!                       ***  MODULE  crslbclnk  ***
@@ -7,12 +6,11 @@
    !!=====================================================================
    !! History :   ! 2012-06  (J. Simeon, G. Madec, C. Ethe, C. Calone)     Original code
-
+   !!----------------------------------------------------------------------
+   USE par_kind, ONLY: wp
    USE dom_oce
    USE crs
+   !
    USE lbclnk
-   USE par_kind, ONLY: wp
    USE in_out_manager
-
-   
    
    INTERFACE crs_lbc_lnk
@@ -22,5 +20,9 @@
    PUBLIC crs_lbc_lnk
    
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -35,33 +37,30 @@
       !!                Upon exiting, switch back to full domain indices.
       !!----------------------------------------------------------------------
-      !! Arguments
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1 ! grid type
-      REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign
-
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)   ::   pt3d1 ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo
-      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
-      
-      !! local vairables
-      LOGICAL                                                   ::   ll_grid_crs
-      REAL(wp)                                                  ::   zval     ! valeur sur les halo
-
+      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1 ! grid type
+      REAL(wp)                                , INTENT(in   ) ::   psgn     ! control of the sign
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1    ! 3D array on which the lbc is applied
+      REAL(wp)                      , OPTIONAL, INTENT(in   ) ::   pval     ! valeur sur les halo
+      CHARACTER(len=3)              , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! MPP only (here do nothing)
+      !
+      LOGICAL  ::   ll_grid_crs
+      REAL(wp) ::   zval   ! valeur sur les halo
       !!----------------------------------------------------------------------
-      
+      !
       ll_grid_crs = ( jpi == jpi_crs )
-      
+      !
       IF( PRESENT(pval) ) THEN  ;  zval = pval
-      ELSE                      ;  zval = 0.0
+      ELSE                      ;  zval = 0._wp
       ENDIF
-      
-      IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
-
+      !
+      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+      !
       IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  )
       ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval  )
       ENDIF
-
-      IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
-
+      !
+      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
+      !
    END SUBROUTINE crs_lbc_lnk_3d
+   
    
    SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
@@ -75,22 +74,19 @@
       !!                Upon exiting, switch back to full domain indices.
       !!----------------------------------------------------------------------
-      !! Arguments
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1,cd_type2 ! grid type
-      REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign
-
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)   ::   pt3d1,pt3d2 ! 3D array on which the lbc is applied
-      
-      !! local vairables
-      LOGICAL                                                   ::   ll_grid_crs
+      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1, cd_type2 ! grid type
+      REAL(wp)                                , INTENT(in   ) ::   psgn               ! control of the sign
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1   , pt3d2    ! 3D array on which the lbc is applied
+      !
+      LOGICAL ::   ll_grid_crs
       !!----------------------------------------------------------------------
-      
+      !
       ll_grid_crs = ( jpi == jpi_crs )
-      
-      IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
-
+      !
+      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+      !
       CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn  )
-
-      IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
-
+      !
+      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
+      !
    END SUBROUTINE crs_lbc_lnk_3d_gather
 
@@ -107,34 +103,30 @@
       !!                Upon exiting, switch back to full domain indices.
       !!----------------------------------------------------------------------
-      !! Arguments
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type  ! grid type
-      REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign
-
-      REAL(wp), DIMENSION(jpi_crs,jpj_crs),     INTENT(inout)   ::   pt2d     ! 2D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo
-      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp   ! MPP only (here do nothing)
-      !! local variables
-      
-      LOGICAL                                                   ::   ll_grid_crs
-      REAL(wp)                                                  ::   zval     ! valeur sur les halo
-
+      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type  ! grid type
+      REAL(wp)                            , INTENT(in   ) ::   psgn     ! control of the sign
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(inout) ::   pt2d     ! 2D array on which the lbc is applied
+      REAL(wp)                  , OPTIONAL, INTENT(in   ) ::   pval     ! valeur sur les halo
+      CHARACTER(len=3)          , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! MPP only (here do nothing)
+      !      
+      LOGICAL  ::   ll_grid_crs
+      REAL(wp) ::   zval     ! valeur sur les halo
       !!----------------------------------------------------------------------
-      
+      !
       ll_grid_crs = ( jpi == jpi_crs )
-      
+      !
       IF( PRESENT(pval) ) THEN  ;  zval = pval
-      ELSE                      ;  zval = 0.0
+      ELSE                      ;  zval = 0._wp
       ENDIF
-      
-      IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
-
+      !
+      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+      !
       IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  )
       ELSE                         ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval  )
       ENDIF
-
-      IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
-
+      !
+      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
+      !
    END SUBROUTINE crs_lbc_lnk_2d
 
-
+   !!======================================================================
 END MODULE crslbclnk
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90	(revision 6808)
@@ -0,0 +1,326 @@
+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 in_out_manager  ! I/O units
+   USE iom             ! I/0 library
+   USE wrk_nemo        ! working arrays
+#if defined key_zdftke 
+   USE zdf_oce, ONLY: en
+#endif
+   USE zdf_oce, ONLY: avt, avm
+#if defined key_zdfgls
+   USE zdf_oce, ONLY: en
+   USE zdfgls, ONLY: mxln
+#endif
+
+   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
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_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
+      !
+      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( 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)
+      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, 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
+      IF( MOD( 3600,INT(rdt) ) == 0 ) THEN
+         i_steps = 3600/INT(rdt)
+      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)
+         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
+            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
+            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)
+            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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 6808)
@@ -7,5 +7,5 @@
    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
    !!----------------------------------------------------------------------
-#if defined key_diaar5   || defined key_esopa
+#if defined key_diaar5
    !!----------------------------------------------------------------------
    !!   'key_diaar5'  :                           activate ar5 diagnotics
@@ -40,6 +40,4 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity
       
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -99,12 +97,12 @@
       ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh
       ztsn(:,:,:,jp_sal) = sn0(:,:,:)
-      CALL eos( ztsn, zrhd, fsdept_n(:,:,:) )                       ! now in situ density using initial salinity
+      CALL eos( ztsn, zrhd, gdept_n(:,:,:) )                       ! now in situ density using initial salinity
       !
       zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
       DO jk = 1, jpkm1
-         zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)
-      END DO
-      IF( .NOT.lk_vvl ) THEN
-         IF ( ln_isfcav ) THEN
+         zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk)
+      END DO
+      IF( ln_linssh ) THEN
+         IF( ln_isfcav ) THEN
             DO ji=1,jpi
                DO jj=1,jpj
@@ -115,4 +113,7 @@
             zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
          END IF
+!!gm
+!!gm   riceload should be added in both ln_linssh=T or F, no?
+!!gm
       END IF
       !                                         
@@ -123,5 +124,5 @@
       
       !                                         ! steric sea surface height
-      CALL eos( tsn, zrhd, zrhop, fsdept_n(:,:,:) )                 ! now in situ and potential density
+      CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) )                 ! now in situ and potential density
       zrhop(:,:,jpk) = 0._wp
       CALL iom_put( 'rhop', zrhop )
@@ -129,7 +130,7 @@
       zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
       DO jk = 1, jpkm1
-         zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)
-      END DO
-      IF( .NOT.lk_vvl ) THEN
+         zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk)
+      END DO
+      IF( ln_linssh ) THEN
          IF ( ln_isfcav ) THEN
             DO ji=1,jpi
@@ -159,5 +160,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zztmp = area(ji,jj) * fse3t(ji,jj,jk)
+               zztmp = area(ji,jj) * e3t_n(ji,jj,jk)
                ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem)
                zsal  = zsal  + zztmp * tsn(ji,jj,jk,jp_sal)
@@ -165,6 +166,6 @@
          END DO
       END DO
-      IF( .NOT.lk_vvl ) THEN
-         IF ( ln_isfcav ) THEN
+      IF( ln_linssh ) THEN
+         IF( ln_isfcav ) THEN
             DO ji=1,jpi
                DO jj=1,jpj
@@ -237,5 +238,5 @@
       IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' )
 
-      area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)
+      area(:,:) = e1e2t(:,:) * tmask_i(:,:)
 
       area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90	(revision 6808)
@@ -0,0 +1,206 @@
+MODULE diacfl
+   !!==============================================================================
+   !!                       ***  MODULE  diacfl  ***
+   !! Output CFL diagnostics to ascii file
+   !!==============================================================================
+   !! History :  1.0  !  2010-03  (E. Blockley)  Original code
+   !!                 !  2014-06  (T Graham) Removed CPP key & Updated to vn3.6
+   !! 
+   !!----------------------------------------------------------------------
+   !!   dia_cfl        : Compute and output Courant numbers at each timestep
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE lib_mpp         ! distribued memory computing
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE domvvl     
+   USE timing          ! Performance output
+
+   IMPLICIT NONE
+   PRIVATE
+
+   REAL(wp) :: cu_max, cv_max, cw_max                      ! Run max U Courant number 
+   INTEGER, DIMENSION(3) :: cu_loc, cv_loc, cw_loc         ! Run max locations
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcu_cfl           ! Courant number arrays
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcv_cfl           ! Courant number arrays
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcw_cfl           ! Courant number arrays
+
+   INTEGER  :: numcfl                                       ! outfile unit
+   CHARACTER(LEN=50) :: clname="cfl_diagnostics.ascii"      ! ascii filename
+
+   PUBLIC   dia_cfl       ! routine called by step.F90
+   PUBLIC   dia_cfl_init  ! routine called by nemogcm
+
+   !! * Substitutions
+#  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 dia_cfl ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_cfl  ***
+      !!
+      !! ** Purpose :  Compute the Courant numbers Cu=u*dt/dx and Cv=v*dt/dy
+      !!               and output to ascii file 'cfl_diagnostics.ascii'
+      !!----------------------------------------------------------------------
+
+      INTEGER, INTENT(in) ::  kt                            ! ocean time-step index
+
+      REAL(wp) :: zcu_max, zcv_max, zcw_max                 ! max Courant numbers per timestep
+      INTEGER, DIMENSION(3) :: zcu_loc, zcv_loc, zcw_loc    ! max Courant number locations
+
+      REAL(wp) :: dt                                        ! temporary scalars
+      INTEGER, DIMENSION(3) :: zlocu, zlocv, zlocw          ! temporary arrays 
+      INTEGER  :: ji, jj, jk                                ! dummy loop indices
+
+      
+      IF( nn_diacfl == 1) THEN
+         IF( nn_timing == 1 )   CALL timing_start('dia_cfl')
+         ! setup timestep multiplier to account for initial Eulerian timestep
+         IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    dt = rdt
+         ELSE                                        ;    dt = rdt * 2.0
+         ENDIF
+
+             ! calculate Courant numbers
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, fs_jpim1   ! vector opt.
+
+                  ! Courant number for x-direction (zonal current)
+                  zcu_cfl(ji,jj,jk) = ABS(un(ji,jj,jk))*dt/e1u(ji,jj)
+
+                  ! Courant number for y-direction (meridional current)
+                  zcv_cfl(ji,jj,jk) = ABS(vn(ji,jj,jk))*dt/e2v(ji,jj)
+
+                  ! Courant number for z-direction (vertical current)
+                  zcw_cfl(ji,jj,jk) = ABS(wn(ji,jj,jk))*dt/e3w_n(ji,jj,jk)
+               END DO
+            END DO         
+         END DO
+
+         ! calculate maximum values and locations
+         IF( lk_mpp ) THEN
+            CALL mpp_maxloc(zcu_cfl,umask,zcu_max, zcu_loc(1), zcu_loc(2), zcu_loc(3))
+            CALL mpp_maxloc(zcv_cfl,vmask,zcv_max, zcv_loc(1), zcv_loc(2), zcv_loc(3))
+            CALL mpp_maxloc(zcw_cfl,tmask,zcw_max, zcw_loc(1), zcw_loc(2), zcw_loc(3))
+         ELSE
+            zlocu = MAXLOC( ABS( zcu_cfl(:,:,:) ) )
+            zcu_loc(1) = zlocu(1) + nimpp - 1
+            zcu_loc(2) = zlocu(2) + njmpp - 1
+            zcu_loc(3) = zlocu(3)
+            zcu_max = zcu_cfl(zcu_loc(1),zcu_loc(2),zcu_loc(3))
+
+            zlocv = MAXLOC( ABS( zcv_cfl(:,:,:) ) )
+            zcv_loc(1) = zlocv(1) + nimpp - 1
+            zcv_loc(2) = zlocv(2) + njmpp - 1
+            zcv_loc(3) = zlocv(3)
+            zcv_max = zcv_cfl(zcv_loc(1),zcv_loc(2),zcv_loc(3))
+
+            zlocw = MAXLOC( ABS( zcw_cfl(:,:,:) ) )
+            zcw_loc(1) = zlocw(1) + nimpp - 1
+            zcw_loc(2) = zlocw(2) + njmpp - 1
+            zcw_loc(3) = zlocw(3)
+            zcw_max = zcw_cfl(zcw_loc(1),zcw_loc(2),zcw_loc(3))
+         ENDIF
+      
+         ! write out to file
+         IF( lwp ) THEN
+            WRITE(numcfl,FMT='(2x,i4,5x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zcu_max, zcu_loc(1), zcu_loc(2), zcu_loc(3)
+            WRITE(numcfl,FMT='(11x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') 'Max Cv', zcv_max, zcv_loc(1), zcv_loc(2), zcv_loc(3)
+            WRITE(numcfl,FMT='(11x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') 'Max Cw', zcw_max, zcw_loc(1), zcw_loc(2), zcw_loc(3)
+         ENDIF
+
+         ! update maximum Courant numbers from whole run if applicable
+         IF( zcu_max > cu_max ) THEN
+            cu_max = zcu_max
+            cu_loc = zcu_loc
+         ENDIF
+         IF( zcv_max > cv_max ) THEN
+            cv_max = zcv_max
+            cv_loc = zcv_loc
+         ENDIF
+         IF( zcw_max > cw_max ) THEN
+            cw_max = zcw_max
+            cw_loc = zcw_loc
+         ENDIF
+
+         ! at end of run output max Cu and Cv and close ascii file
+         IF( kt == nitend .AND. lwp ) THEN
+            ! to ascii file
+            WRITE(numcfl,*) '******************************************'
+            WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cu', cu_max, cu_loc(1), cu_loc(2), cu_loc(3)
+            WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cu_max)
+            WRITE(numcfl,*) '******************************************'
+            WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cv', cv_max, cv_loc(1), cv_loc(2), cv_loc(3)
+            WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cv_max)
+            WRITE(numcfl,*) '******************************************'
+            WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cw', cw_max, cw_loc(1), cw_loc(2), cw_loc(3)
+            WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cw_max)
+            CLOSE( numcfl ) 
+
+            ! to ocean output
+            WRITE(numout,*)
+            WRITE(numout,*) 'dia_cfl     : Maximum Courant number information for the run:'
+            WRITE(numout,*) '~~~~~~~~~~~~'
+            WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cu', cu_max, 'at (i, j, k) = (', cu_loc(1), cu_loc(2), cu_loc(3), ')'
+            WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cu_max)
+            WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cv', cv_max, 'at (i, j, k) = (', cv_loc(1), cv_loc(2), cv_loc(3), ')'
+            WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cv_max)
+            WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cw', cw_max, 'at (i, j, k) = (', cw_loc(1), cw_loc(2), cw_loc(3), ')'
+            WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cw_max)
+
+         ENDIF
+
+         IF( nn_timing == 1 )   CALL timing_stop('dia_cfl')
+      ENDIF
+
+   END SUBROUTINE dia_cfl
+
+   SUBROUTINE dia_cfl_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_cfl_init  ***
+      !!                   
+      !! ** Purpose :   create output file, initialise arrays
+      !!----------------------------------------------------------------------
+
+
+      IF( nn_diacfl == 1 ) THEN
+         IF( nn_timing == 1 )   CALL timing_start('dia_cfl_init')
+
+         cu_max=0.0
+         cv_max=0.0
+         cw_max=0.0
+
+         ALLOCATE( zcu_cfl(jpi, jpj, jpk), zcv_cfl(jpi, jpj, jpk), zcw_cfl(jpi, jpj, jpk) )
+
+         zcu_cfl(:,:,:)=0.0
+         zcv_cfl(:,:,:)=0.0
+         zcw_cfl(:,:,:)=0.0
+
+         IF( lwp ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'dia_cfl     : Outputting CFL diagnostics to '//TRIM(clname)
+            WRITE(numout,*) '~~~~~~~~~~~~'
+            WRITE(numout,*)
+
+            ! create output ascii file
+            CALL ctl_opn( numcfl, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
+            WRITE(numcfl,*) 'Timestep  Direction  Max C     i    j    k'
+            WRITE(numcfl,*) '******************************************'
+         ENDIF
+
+         IF( nn_timing == 1 )   CALL timing_stop('dia_cfl_init')
+
+      ENDIF
+
+   END SUBROUTINE dia_cfl_init
+
+END MODULE diacfl
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 6808)
@@ -1,118 +1,110 @@
 MODULE diadct
-  !!=====================================================================
-  !!                       ***  MODULE  diadct  ***
-  !! Ocean diagnostics: Compute the transport trough a sec.
-  !!===============================================================
-  !! History : 
-  !!
-  !!         original  : 02/99 (Y Drillet)
-  !!         addition  : 10/01 (Y Drillet, R Bourdalle Badie)
-  !!                   : 10/05 (M Laborie) F90
-  !!         addition  : 04/07 (G Garric) Ice sections
-  !!         bugfix    : 04/07 (C Bricaud) test on sec%nb_point
-  !!                                      initialisation of ztransp1,ztransp2,...
-  !!         nemo_v_3_4: 09/2011 (C Bricaud)
-  !!
-  !!
-  !!----------------------------------------------------------------------
+   !!======================================================================
+   !!                       ***  MODULE  diadct  ***
+   !! Ocean diagnostics: Compute the transport trough a sec.
+   !!======================================================================
+   !! History :  OPA  ! 02/1999 (Y Drillet)  original code
+   !!                 ! 10/2001 (Y Drillet, R Bourdalle Badie)
+   !!   NEMO     1.0  ! 10/2005 (M Laborie) F90
+   !!            3.0  ! 04/2007 (G Garric) Ice sections
+   !!             -   ! 04/2007 (C Bricaud) test on sec%nb_point, initialisation of ztransp1,ztransp2,...
+   !!            3.4  ! 09/2011 (C Bricaud)
+   !!----------------------------------------------------------------------
 #if defined key_diadct
-  !!----------------------------------------------------------------------
-  !!   'key_diadct' :
-  !!----------------------------------------------------------------------
-  !!----------------------------------------------------------------------
-  !!   dia_dct      :  Compute the transport through a sec.
-  !!   dia_dct_init :  Read namelist.
-  !!   readsec      :  Read sections description and pathway
-  !!   removepoints :  Remove points which are common to 2 procs
-  !!   transport    :  Compute transport for each sections
-  !!   dia_dct_wri  :  Write tranports results in ascii files
-  !!   interp       :  Compute temperature/salinity/density at U-point or V-point
-  !!   
-  !!----------------------------------------------------------------------
-  !! * Modules used
-  USE oce             ! ocean dynamics and tracers
-  USE dom_oce         ! ocean space and time domain
-  USE phycst          ! physical constants
-  USE in_out_manager  ! I/O manager
-  USE daymod          ! calendar
-  USE dianam          ! build name of file
-  USE lib_mpp         ! distributed memory computing library
+   !!----------------------------------------------------------------------
+   !!   'key_diadct' :
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   dia_dct      :  Compute the transport through a sec.
+   !!   dia_dct_init :  Read namelist.
+   !!   readsec      :  Read sections description and pathway
+   !!   removepoints :  Remove points which are common to 2 procs
+   !!   transport    :  Compute transport for each sections
+   !!   dia_dct_wri  :  Write tranports results in ascii files
+   !!   interp       :  Compute temperature/salinity/density at U-point or V-point
+   !!   
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+   USE dianam          ! build name of file
+   USE lib_mpp         ! distributed memory computing library
 #if defined key_lim2
-  USE ice_2
+   USE ice_2
 #endif
 #if defined key_lim3
-  USE ice
+   USE ice
 #endif
-  USE domvvl
-  USE timing          ! preformance summary
-  USE wrk_nemo        ! working arrays
-
-  IMPLICIT NONE
-  PRIVATE
-
-  !! * Routine accessibility
-  PUBLIC   dia_dct      ! routine called by step.F90
-  PUBLIC   dia_dct_init ! routine called by opa.F90
-  PUBLIC   diadct_alloc ! routine called by nemo_init in nemogcm.F90 
-  PRIVATE  readsec
-  PRIVATE  removepoints
-  PRIVATE  transport
-  PRIVATE  dia_dct_wri
-
-#include "domzgr_substitute.h90"
-
-  !! * Shared module variables
-  LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .TRUE.   !: model-data diagnostics flag
-
-  !! * Module variables
-  INTEGER :: nn_dct        ! Frequency of computation
-  INTEGER :: nn_dctwri     ! Frequency of output
-  INTEGER :: nn_secdebug   ! Number of the section to debug
+   USE domvvl
+   USE timing          ! preformance summary
+   USE wrk_nemo        ! working arrays
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dia_dct      ! routine called by step.F90
+   PUBLIC   dia_dct_init ! routine called by opa.F90
+   PUBLIC   diadct_alloc ! routine called by nemo_init in nemogcm.F90 
+   PRIVATE  readsec
+   PRIVATE  removepoints
+   PRIVATE  transport
+   PRIVATE  dia_dct_wri
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .TRUE.   !: model-data diagnostics flag
+
+   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  = 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 
-
-  TYPE POINT_SECTION
-     INTEGER :: I,J
-  END TYPE POINT_SECTION
-
-  TYPE COORD_SECTION
-     REAL(wp) :: lon,lat
-  END TYPE COORD_SECTION
-
-  TYPE SECTION
-     CHARACTER(len=60)                            :: name              ! name of the sec
-     LOGICAL                                      :: llstrpond         ! true if you want the computation of salt and
+   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 
+
+   TYPE POINT_SECTION
+      INTEGER :: I,J
+   END TYPE POINT_SECTION
+
+   TYPE COORD_SECTION
+      REAL(wp) :: lon,lat
+   END TYPE COORD_SECTION
+
+   TYPE SECTION
+      CHARACTER(len=60)                            :: name              ! name of the sec
+      LOGICAL                                      :: llstrpond         ! true if you want the computation of salt and
                                                                        ! heat transports
-     LOGICAL                                      :: ll_ice_section    ! ice surface and ice volume computation
-     LOGICAL                                      :: ll_date_line      ! = T if the section crosses the date-line
-     TYPE(COORD_SECTION), DIMENSION(2)            :: coordSec          ! longitude and latitude of the extremities of the sec
-     INTEGER                                      :: nb_class          ! number of boundaries for density classes
-     INTEGER, DIMENSION(nb_point_max)             :: direction         ! vector direction of the point in the section
-     CHARACTER(len=40),DIMENSION(nb_class_max)    :: classname         ! characteristics of the class
-     REAL(wp), DIMENSION(nb_class_max)            :: zsigi           ,&! in-situ   density classes    (99 if you don't want)
-                                                     zsigp           ,&! potential density classes    (99 if you don't want)
-                                                     zsal            ,&! salinity classes   (99 if you don't want)
-                                                     ztem            ,&! temperature classes(99 if you don't want)
-                                                     zlay              ! level classes      (99 if you don't want)
-     REAL(wp), DIMENSION(nb_type_class,nb_class_max)  :: transport     ! transport output
-     REAL(wp)                                         :: slopeSection  ! slope of the section
-     INTEGER                                          :: nb_point      ! number of points in the section
-     TYPE(POINT_SECTION),DIMENSION(nb_point_max)      :: listPoint     ! list of points in the sections
-  END TYPE SECTION
-
-  TYPE(SECTION),DIMENSION(nb_sec_max) :: secs ! Array of sections
- 
-  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  transports_3d 
-  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  transports_2d  
-
+      LOGICAL                                      :: ll_ice_section    ! ice surface and ice volume computation
+      LOGICAL                                      :: ll_date_line      ! = T if the section crosses the date-line
+      TYPE(COORD_SECTION), DIMENSION(2)            :: coordSec          ! longitude and latitude of the extremities of the sec
+      INTEGER                                      :: nb_class          ! number of boundaries for density classes
+      INTEGER, DIMENSION(nb_point_max)             :: direction         ! vector direction of the point in the section
+      CHARACTER(len=40),DIMENSION(nb_class_max)    :: classname         ! characteristics of the class
+      REAL(wp), DIMENSION(nb_class_max)            :: zsigi           ,&! in-situ   density classes    (99 if you don't want)
+                                                      zsigp           ,&! potential density classes    (99 if you don't want)
+                                                      zsal            ,&! salinity classes   (99 if you don't want)
+                                                      ztem            ,&! temperature classes(99 if you don't want)
+                                                      zlay              ! level classes      (99 if you don't want)
+      REAL(wp), DIMENSION(nb_type_class,nb_class_max)  :: transport     ! transport output
+      REAL(wp)                                         :: slopeSection  ! slope of the section
+      INTEGER                                          :: nb_point      ! number of points in the section
+      TYPE(POINT_SECTION),DIMENSION(nb_point_max)      :: listPoint     ! list of points in the sections
+   END TYPE SECTION
+
+   TYPE(SECTION),DIMENSION(nb_sec_max) :: secs ! Array of sections
+ 
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  transports_3d 
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  transports_2d  
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
-
  
   INTEGER FUNCTION diadct_alloc() 
@@ -130,4 +122,5 @@
  
   END FUNCTION diadct_alloc 
+
 
   SUBROUTINE dia_dct_init
@@ -208,8 +201,6 @@
      !!               Reinitialise all relevant arrays to zero 
      !!---------------------------------------------------------------------
-     !! * Arguments
-     INTEGER,INTENT(IN)        ::kt
-
-     !! * Local variables
+     INTEGER,INTENT(in)        ::kt
+     !
      INTEGER             :: jsec,            &! loop on sections
                             itotal            ! nb_sec_max*nb_type_class*nb_class_max
@@ -220,6 +211,6 @@
      REAL(wp), POINTER, DIMENSION(:)    :: zwork !   "  
      REAL(wp), POINTER, DIMENSION(:,:,:):: zsum  !   "
-
      !!---------------------------------------------------------------------    
+     !
      IF( nn_timing == 1 )   CALL timing_start('dia_dct')
 
@@ -619,142 +610,140 @@
                             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/potential density/ssh/depth at u/v point
+     REAL(wp)            :: ztn, zsn, zrhoi, zrhop, zsshn, zdep !temperature/salinity/potential density/ssh/depth at u/v point
 
      TYPE(POINT_SECTION) :: k
-     !!--------------------------------------------------------
-
-     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( sec%slopeSection .GE. 9999. )     isgnv =  1
-
-        IF( ld_debug )write(numout,*)"sec%slopeSection isgnu isgnv ",sec%slopeSection,isgnu,isgnv
-
-        !--------------------------------------!
-        ! LOOP ON THE SEGMENT BETWEEN 2 NODES  !
-        !--------------------------------------!
-        DO jseg=1,MAX(sec%nb_point-1,0)
+      !!--------------------------------------------------------
+      !
+      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( sec%slopeSection .GE. 9999. )     isgnv =  1
+
+         IF( ld_debug )write(numout,*)"sec%slopeSection isgnu isgnv ",sec%slopeSection,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 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',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',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 
- 
-              zfsdep= fsdept(k%I,k%J,jk) 
+            !-------------------------------------------------------------------------------------------
+            ! 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     | 
+            !---------------------------| 
+            DO jk = 1, mbathy(k%I,k%J)            !Sum of the transport on the vertical
+            !           ! 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',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',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 
+               !
+               zdep= gdept_n(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
+               SELECT CASE( sec%direction(jseg) )                !compute velocity with the correct direction 
+               CASE(0,1)   
+                  zumid=0._wp
+                  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._wp
+               END SELECT 
+ 
+               !zTnorm=transport through one cell; 
+               !velocity* cell's length * cell's thickness 
+               zTnorm = zumid*e2u(k%I,k%J) * e3u_n(k%I,k%J,jk)     & 
+                  &   + zvmid*e1v(k%I,k%J) * e3v_n(k%I,k%J,jk) 
+
+!!gm  THIS is WRONG  no transport due to ssh in linear free surface case !!!!!
+               IF( ln_linssh ) THEN              !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
+!!gm end
               !COMPUTE TRANSPORT  
  
               transports_3d(1,jsec,jseg,jk) = transports_3d(1,jsec,jseg,jk) + zTnorm 
   
-              IF ( sec%llstrpond ) THEN 
+              IF( sec%llstrpond ) THEN 
                  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
               ENDIF
    
-           ENDDO !end of loop on the level
+           END DO !end of loop on the level
 
 #if defined key_lim2 || defined key_lim3
@@ -797,5 +786,5 @@
                  transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)*   &
                                    a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl)
-              ENDDO
+              END DO
 #endif
    
@@ -803,10 +792,11 @@
 #endif
  
-        ENDDO !end of loop on the segment
+        END DO !end of loop on the segment
 
      ENDIF !end of sec%nb_point =0 case
      !
   END SUBROUTINE transport
-  
+
+
   SUBROUTINE dia_dct_sum(sec,jsec) 
      !!------------------------------------------------------------- 
@@ -828,5 +818,4 @@
      !! 
      !!------------------------------------------------------------- 
-     !! * arguments 
      TYPE(SECTION),INTENT(INOUT) :: sec 
      INTEGER      ,INTENT(IN)    :: jsec        ! numeric identifier of section 
@@ -834,5 +823,5 @@
      TYPE(POINT_SECTION) :: k 
      INTEGER  :: jk,jseg,jclass                        ! dummy variables for looping on level/segment/classes  
-     REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point 
+     REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zdep ! temperature/salinity/ssh/potential density /depth at u/v point 
      !!------------------------------------------------------------- 
  
@@ -903,5 +892,5 @@
               END SELECT 
  
-              zfsdep= fsdept(k%I,k%J,jk) 
+              zdep= gdept_n(k%I,k%J,jk) 
   
               !------------------------------- 
@@ -932,6 +921,6 @@
                     ( sec%ztem(jclass) .EQ.99.)) .AND.                     & 
  
-                    ((( zfsdep .GE. sec%zlay(jclass)) .AND.                & 
-                    (   zfsdep .LE. sec%zlay(jclass+1))) .OR.              & 
+                    ((( zdep .GE. sec%zlay(jclass)) .AND.                & 
+                    (   zdep .LE. sec%zlay(jclass+1))) .OR.              & 
                     ( sec%zlay(jclass) .EQ. 99. ))                         & 
                                                                    ))   THEN 
@@ -991,5 +980,5 @@
 #endif 
   
-        ENDDO !end of loop on the segment 
+        END DO !end of loop on the segment 
  
      ELSE  !if sec%nb_point =0 
@@ -1000,5 +989,6 @@
  
   END SUBROUTINE dia_dct_sum 
-  
+
+
   SUBROUTINE dia_dct_wri(kt,ksec,sec)
      !!-------------------------------------------------------------
@@ -1138,13 +1128,15 @@
                               sec%transport(9,1),sec%transport(10,1), &
                               sec%transport(9,1)+sec%transport(10,1) 
-     ENDIF
+      ENDIF
                                               
-118 FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3F12.4)
-119 FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3E15.6)
-
-     CALL wrk_dealloc(nb_type_class , zsumclasses )  
-  END SUBROUTINE dia_dct_wri
-
-  FUNCTION interp(ki, kj, kk, cd_point, ptab)
+118   FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3F12.4)
+119   FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3E15.6)
+
+      CALL wrk_dealloc(nb_type_class , zsumclasses )  
+      !
+   END SUBROUTINE dia_dct_wri
+
+
+   FUNCTION interp(ki, kj, kk, cd_point, ptab)
   !!----------------------------------------------------------------------
   !!
@@ -1214,5 +1206,5 @@
   !*local declations
   INTEGER :: ii1, ij1, ii2, ij2                                ! local integer
-  REAL(wp):: ze3t, zfse3, zwgt1, zwgt2, zbis, zdepu            ! local real
+  REAL(wp):: ze3t, ze3, zwgt1, zwgt2, zbis, zdepu            ! local real
   REAL(wp):: zet1, zet2                                        ! weight for interpolation 
   REAL(wp):: zdep1,zdep2                                       ! differences of depth
@@ -1241,7 +1233,7 @@
   IF( ln_sco )THEN   ! s-coordinate case
 
-     zdepu = ( fsdept(ii1,ij1,kk) +  fsdept(ii2,ij2,kk) ) /2 
-     zdep1 = fsdept(ii1,ij1,kk) - zdepu
-     zdep2 = fsdept(ii2,ij2,kk) - zdepu
+     zdepu = ( gdept_n(ii1,ij1,kk) +  gdept_n(ii2,ij2,kk) ) * 0.5_wp 
+     zdep1 = gdept_n(ii1,ij1,kk) - zdepu
+     zdep2 = gdept_n(ii2,ij2,kk) - zdepu
 
      ! weights
@@ -1255,17 +1247,7 @@
   ELSE       ! full step or partial step case 
 
-#if defined key_vvl
-
-     ze3t  = fse3t_n(ii2,ij2,kk) - fse3t_n(ii1,ij1,kk) 
-     zwgt1 = ( fse3w_n(ii2,ij2,kk) - fse3w_n(ii1,ij1,kk) ) / fse3w_n(ii2,ij2,kk)
-     zwgt2 = ( fse3w_n(ii1,ij1,kk) - fse3w_n(ii2,ij2,kk) ) / fse3w_n(ii1,ij1,kk)
-
-#else
-
-     ze3t  = fse3t(ii2,ij2,kk)   - fse3t(ii1,ij1,kk) 
-     zwgt1 = ( fse3w(ii2,ij2,kk) - fse3w(ii1,ij1,kk) ) / fse3w(ii2,ij2,kk)
-     zwgt2 = ( fse3w(ii1,ij1,kk) - fse3w(ii2,ij2,kk) ) / fse3w(ii1,ij1,kk)
-
-#endif
+     ze3t  = e3t_n(ii2,ij2,kk) - e3t_n(ii1,ij1,kk) 
+     zwgt1 = ( e3w_n(ii2,ij2,kk) - e3w_n(ii1,ij1,kk) ) / e3w_n(ii2,ij2,kk)
+     zwgt2 = ( e3w_n(ii1,ij1,kk) - e3w_n(ii2,ij2,kk) ) / e3w_n(ii1,ij1,kk)
 
      IF(kk .NE. 1)THEN
@@ -1288,7 +1270,6 @@
 
   ENDIF
-
-
-  END FUNCTION interp
+      !
+   END FUNCTION interp
 
 #else
@@ -1311,3 +1292,4 @@
 #endif
 
+   !!======================================================================
 END MODULE diadct
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90	(revision 6807)
+++ 	(revision )
@@ -1,229 +1,0 @@
-MODULE diadimg
-   !!======================================================================
-   !!                     ***  MODULE  diadimg  ***
-   !! Ocean diagnostics :  write ocean output files in dimg direct access format (mpp)
-   !!=====================================================================
-# if defined key_dimgout
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers 
-   USE dom_oce         ! ocean space and time domain
-   USE in_out_manager  ! I/O manager
-   USE daymod          ! calendar
-   USE lib_mpp
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC dia_wri_dimg            ! called by trd_mld (eg)
-   PUBLIC dia_wri_dimg_alloc      ! called by nemo_alloc in nemogcm.F90
-
-
-   !! These workspace arrays are inside the module so that we can make them
-   !! allocatable in a clean way. Not done in wrk_nemo because these are of KIND(sp).
-   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: z42d    ! 2d temporary workspace (sp)
-   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:)   :: z4dep   ! vertical level (sp)
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   FUNCTION dia_wri_dimg_alloc()
-      !!---------------------------------------------------------------------
-      !!        *** ROUTINE dia_wri_dimg_alloc ***
-      !!
-      !!---------------------------------------------------------------------
-      INTEGER :: dia_wri_dimg_alloc   ! return value
-      !!---------------------------------------------------------------------
-      !
-      IF( .NOT. ALLOCATED( z42d ) )THEN
-
-         ALLOCATE( z42d(jpi,jpj), z4dep(jpk), STAT=dia_wri_dimg_alloc )
-
-         IF( lk_mpp                  )   CALL mpp_sum ( dia_wri_dimg_alloc )
-         IF( dia_wri_dimg_alloc /= 0 )   CALL ctl_warn('dia_wri_dimg_alloc: allocation of array failed.')
-
-      ELSE
-
-         dia_wri_dimg_alloc = 0
-
-      ENDIF
-      !
-  END FUNCTION dia_wri_dimg_alloc
-
-
-  SUBROUTINE dia_wri_dimg( cd_name, cd_text, ptab, klev, cd_type , ksubi )
-    !!-------------------------------------------------------------------------
-    !!        *** ROUTINE dia_wri_dimg ***
-    !!
-    !! ** Purpose :   write ptab in the dimg file cd_name, with comment cd_text.
-    !!              ptab has klev x 2D fields
-    !!
-    !! ** Action :   Define header variables from the config parameters
-    !!               Open the dimg file on unit inum = 14 ( IEEE I4R4 file )
-    !!               Write header on record 1
-    !!               Write ptab on the following klev records
-    !!
-    !! History :  2003-12 (J.M. Molines ) : Original. Replace ctl_opn, writn2d
-    !!---------------------------------------------------------------------------
-    CHARACTER(len=*),INTENT(in) ::   &
-         &                            cd_name,  &  ! dimg file name
-         &                            cd_text      ! comment to write on record #1
-    INTEGER, INTENT(in) ::            klev         ! number of level in ptab to write
-    REAL(wp),INTENT(in), DIMENSION(:,:,:) :: ptab  ! 3D array to write 
-    CHARACTER(LEN=1),INTENT(in) ::    cd_type      ! either 'T', 'W' or '2' , depending on the vertical
-    !                                              ! grid for ptab. 2 stands for 2D file
-    INTEGER, INTENT(in), OPTIONAL, DIMENSION(klev) :: ksubi 
-
-    !! * Local declarations
-    INTEGER :: jk, jn           ! dummy loop indices
-    INTEGER :: irecl4,             &    ! record length in bytes
-         &       inum,             &    ! logical unit (set to 14)
-         &       irec,             &    ! current record to be written
-         &       irecend                ! record number where nclit... are stored
-    REAL(sp)                    :: zdx,zdy,zspval,zwest,ztimm
-    REAL(sp)                    :: zsouth
-
-    CHARACTER(LEN=80) :: clname                ! name of file in case of dimgnnn
-    CHARACTER(LEN=4) :: clver='@!01'           ! dimg string identifier
-    !!---------------------------------------------------------------------------
-
-    !                                      ! allocate dia_wri_dimg array
-    IF( dia_wri_dimg_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_wri_dimg : unable to allocate arrays' )
-
-    !! * Initialisations
-
-    irecl4 = MAX(jpi*jpj*sp , 84+(18+1+jpk)*sp )
-
-    zspval=0.0_sp    ! special values on land
-    !  the 'numerical' grid is described. The geographical one is in a grid file
-    zdx=1._sp
-    zdy=1._sp
-    zsouth=njmpp * 1._sp
-    zwest=nimpp * 1._sp
-    !  time in days since the historical begining of the run (nit000 = 0 ) 
-    ztimm=adatrj
-
-    SELECT CASE ( cd_type )
-
-    CASE ( 'T')
-       z4dep(:)=gdept_1d(:)
-
-    CASE ( 'W' )
-       z4dep(:)=gdepw_1d(:)
-
-    CASE ( '2' )
-       z4dep(1:klev) =(/(jk, jk=1,klev)/)
-
-    CASE ( 'I' )
-       z4dep(1:klev) = ksubi(1:klev)
-
-    CASE DEFAULT
-       IF(lwp) WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg '
-       STOP 'dia_wri_dimg'
-
-    END SELECT
-
-    IF ( ln_dimgnnn  ) THEN
-     irecl4 = MAX(jpi*jpj*sp , 84+(18+jpk)*sp + 8*jpnij*sp  )
-       WRITE(clname,'(a,a,i3.3)') TRIM(cd_name),'.',narea
-       CALL ctl_opn(inum, clname,'UNKNOWN','UNFORMATTED','DIRECT',irecl4,numout,lwp)
-       WRITE(inum,REC=1 ) clver, cd_text, irecl4, &
-            &     jpi,jpj, klev, 1 , 1 ,            &
-            &     zwest, zsouth, zdx, zdy, zspval,  &
-            &     z4dep(1:klev),                    &
-            &     ztimm,                            &
-            &     narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom,    &    ! extension to dimg for mpp output
-            &     nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt  !
-
-       !! * Write klev levels
-       IF ( cd_type == 'I' ) THEN
-
-          DO jk = 1, klev
-             irec =1 + jk
-             z42d(:,:) = ptab(:,:,ksubi(jk))
-             WRITE(inum,REC=irec)  z42d(:,:)
-          END DO
-       ELSE
-          DO jk = 1, klev
-             irec =1 + jk
-             z42d(:,:) = ptab(:,:,jk)
-             WRITE(inum,REC=irec)  z42d(:,:)
-          END DO
-       ENDIF
-    ELSE
-       clver='@!03'           ! dimg string identifier
-       ! note that version @!02 is optimized with respect to record length.
-       ! The vertical dep variable is reduced to klev instead of klev*jpnij :
-       !   this is OK for jpnij < 181 (jpk=46)
-       ! for more processors, irecl4 get huge and that's why we switch to '@!03':
-       !  In this case we just add an extra integer to the standard dimg structure,
-       !  which is a record number where the arrays nlci etc... starts (1 per record)
-       
-       !! Standard dimgproc (1 file per variable, all procs. write to this file )
-       !! * Open file
-       CALL ctl_opn(inum, cd_name,'UNKNOWN','UNFORMATTED','DIRECT',irecl4,numout,lwp)
-
-       !! * Write header on record #1
-       irecend=1 + klev*jpnij 
-       IF(lwp) WRITE(inum,REC=1 ) clver, cd_text, irecl4, &
-            &     jpi,jpj, klev, 1 , 1 ,            &
-            &     zwest, zsouth, zdx, zdy, zspval,  &
-            &     z4dep(1:klev),       &
-            &     ztimm,                            &
-            &     narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom, irecend 
-       IF (lwp ) THEN
-         WRITE(inum,REC=irecend + 1 ) nlcit
-         WRITE(inum,REC=irecend + 2 ) nlcjt
-         WRITE(inum,REC=irecend + 3 ) nldit
-         WRITE(inum,REC=irecend + 4 ) nldjt
-         WRITE(inum,REC=irecend + 5 ) nleit
-         WRITE(inum,REC=irecend + 6 ) nlejt
-         WRITE(inum,REC=irecend + 7 ) nimppt
-         WRITE(inum,REC=irecend + 8 ) njmppt
-       ENDIF
-      !   &    ! extension to dimg for mpp output
-      !   &     nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt  !
-
-       !! * Write klev levels
-       IF ( cd_type == 'I' ) THEN
-
-          DO jk = 1, klev
-             irec =1 + klev * (narea -1) + jk
-             z42d(:,:) = ptab(:,:,ksubi(jk))
-             WRITE(inum,REC=irec)  z42d(:,:)
-          END DO
-       ELSE
-          DO jk = 1, klev
-             irec =1 + klev * (narea -1) + jk
-             z42d(:,:) = ptab(:,:,jk)
-             WRITE(inum,REC=irec)  z42d(:,:)
-          END DO
-       ENDIF
-    ENDIF
-
-    !! * Close the file
-    CLOSE(inum)
-
-  END SUBROUTINE dia_wri_dimg
-
-#  else
-   !!----------------------------------------------------------------------
-   !!   Default option :                                       Empty module
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dia_wri_dimg( cd_name, cd_exper, ptab, klev, cd_type )
-      REAL, DIMENSION(:,:,:) :: ptab
-      INTEGER :: klev
-      CHARACTER(LEN=80) :: cd_name, cd_exper,cd_type
-      WRITE(*,*) ' This print must never occur ', cd_name, cd_exper,ptab, klev, cd_type
-      WRITE(*,*) ' this routine is here just for compilation '
-   END SUBROUTINE dia_wri_dimg
-# endif
-   !!======================================================================
-END MODULE diadimg
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 6808)
@@ -33,5 +33,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -40,5 +39,4 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -74,5 +72,5 @@
          a_salb   = 0.e0 ! valeur de sal au debut de la simulation
          ! sshb used because diafwb called after tranxt (i.e. after the swap)
-         a_sshb = SUM( e1t(:,:) * e2t(:,:) * sshb(:,:) * tmask_i(:,:) )
+         a_sshb = SUM( e1e2t(:,:) * sshb(:,:) * tmask_i(:,:) )
          IF( lk_mpp )   CALL mpp_sum( a_sshb )      ! sum over the global domain
 
@@ -80,5 +78,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  zwei  = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
                   a_salb = a_salb + ( tsb(ji,jj,jk,jp_sal) - zsm0 ) * zwei
                END DO
@@ -88,5 +86,5 @@
       ENDIF
       
-      a_fwf    = SUM( e1t(:,:) * e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) ) 
+      a_fwf    = SUM( e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) ) 
       IF( lk_mpp )   CALL mpp_sum( a_fwf    )       ! sum over the global domain
 
@@ -98,7 +96,7 @@
          zfwfnew = 0.e0
          ! Mean sea level at nitend
-         a_sshn = SUM( e1t(:,:) * e2t(:,:) * sshn(:,:) * tmask_i(:,:) )
+         a_sshn = SUM( e1e2t(:,:) * sshn(:,:) * tmask_i(:,:) )
          IF( lk_mpp )   CALL mpp_sum( a_sshn )      ! sum over the global domain
-         zarea  = SUM( e1t(:,:) * e2t(:,:) *             tmask_i(:,:) )
+         zarea  = SUM( e1e2t(:,:) *             tmask_i(:,:) )
          IF( lk_mpp )   CALL mpp_sum( zarea  )      ! sum over the global domain
          
@@ -106,5 +104,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  zwei  = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
                   a_saln = a_saln + ( tsn(ji,jj,jk,jp_sal) - zsm0 ) * zwei
                   zvol  = zvol  + zwei
@@ -116,5 +114,5 @@
          
          ! Conversion in m3
-         a_fwf    = a_fwf * rdttra(1) * 1.e-3 
+         a_fwf    = a_fwf * rdt * 1.e-3 
          
          ! fwf correction to bring back the mean ssh to zero
@@ -186,5 +184,5 @@
                   zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
                   zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
-                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
+                  zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
 
                   IF( un(ji,jj,jk) > 0.e0 ) THEN 
@@ -238,5 +236,5 @@
                   zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
                   zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
-                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
+                  zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
                   
                   IF( un(ji,jj,jk) > 0.e0 ) THEN 
@@ -290,5 +288,5 @@
                   zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
                   zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
-                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
+                  zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
                   
                   IF( un(ji,jj,jk) > 0.e0 ) THEN 
@@ -342,5 +340,5 @@
                   zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
                   zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
-                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
+                  zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
                   
                   IF( un(ji,jj,jk) > 0.e0 ) THEN 
@@ -404,5 +402,5 @@
          WRITE(inum,*)
          WRITE(inum,*)    'Net freshwater budget '
-         WRITE(inum,9010) '  fwf    = ',a_fwf,   ' m3 =', a_fwf   /(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'
+         WRITE(inum,9010) '  fwf    = ',a_fwf,   ' m3 =', a_fwf   /(FLOAT(nitend-nit000+1)*rdt) * 1.e-6,' Sv'
          WRITE(inum,*)
          WRITE(inum,9010) '  zarea =',zarea
@@ -460,5 +458,5 @@
       ENDIF
 
-      IF( nn_timing == 1 )   CALL timing_start('dia_fwb')
+      IF( nn_timing == 1 )   CALL timing_stop('dia_fwb')
 
  9005 FORMAT(1X,A,ES24.16)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90	(revision 6808)
@@ -14,6 +14,4 @@
    USE dom_oce         ! ocean space and time domain
    USE phycst
-   USE dynspg_oce
-   USE dynspg_ts
    USE daymod
    USE tide_mod
@@ -23,5 +21,4 @@
    USE ioipsl          ! NetCDF IPSL library
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE diadimg         ! To write dimg
    USE timing          ! preformance summary
    USE wrk_nemo        ! working arrays
@@ -137,5 +134,5 @@
       DO jk=1,nb_ana
        DO ji=1,jpmax_harmo
-          IF (TRIM(tname(jk)) .eq. Wave(ji)%cname_tide) THEN
+          IF (TRIM(tname(jk)) ==  Wave(ji)%cname_tide) THEN
              name(jk) = ji
              EXIT
@@ -196,9 +193,7 @@
                   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)        
-#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
+                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*ssmask (ji,jj)        
+                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*ssumask(ji,jj)
+                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj)
                   END DO
                END DO
@@ -328,6 +323,6 @@
                X1= ana_amp(ji,jj,jh,1)
                X2=-ana_amp(ji,jj,jh,2)
-               out_u(ji,jj,       jh) = X1 * umask_i(ji,jj)
-               out_u(ji,jj,nb_ana+jh) = X2 * umask_i(ji,jj)
+               out_u(ji,jj,       jh) = X1 * ssumask(ji,jj)
+               out_u(ji,jj,nb_ana+jh) = X2 * ssumask(ji,jj)
             ENDDO
          ENDDO
@@ -362,6 +357,6 @@
                X1=ana_amp(ji,jj,jh,1)
                X2=-ana_amp(ji,jj,jh,2)
-               out_v(ji,jj,       jh)=X1 * vmask_i(ji,jj)
-               out_v(ji,jj,nb_ana+jh)=X2 * vmask_i(ji,jj)
+               out_v(ji,jj,       jh)=X1 * ssvmask(ji,jj)
+               out_v(ji,jj,nb_ana+jh)=X2 * ssvmask(ji,jj)
             END DO
          END DO
@@ -388,17 +383,6 @@
       !!----------------------------------------------------------------------
 
-#if defined key_dimgout
-      cdfile_name_T = TRIM(cexper)//'_Tidal_harmonics_gridT.dimgproc'
-      cdfile_name_U = TRIM(cexper)//'_Tidal_harmonics_gridU.dimgproc'
-      cdfile_name_V = TRIM(cexper)//'_Tidal_harmonics_gridV.dimgproc'
-#endif
-
       IF(lwp) WRITE(numout,*) '  '
       IF(lwp) WRITE(numout,*) 'dia_wri_harm : Write harmonic analysis results'
-#if defined key_dimgout
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~  Output files: ', TRIM(cdfile_name_T)
-      IF(lwp) WRITE(numout,*) '                             ', TRIM(cdfile_name_U)
-      IF(lwp) WRITE(numout,*) '                             ', TRIM(cdfile_name_V)
-#endif
       IF(lwp) WRITE(numout,*) '  '
 
@@ -406,39 +390,24 @@
       !/////////////
       !
-#if defined key_dimgout
-      cltext='Elevation amplitude and phase'
-      CALL dia_wri_dimg(TRIM(cdfile_name_T), TRIM(cltext), out_eta, 2*nb_ana, '2')
-#else
       DO jh = 1, nb_ana
       CALL iom_put( TRIM(tname(jh))//'x', out_eta(:,:,jh) )
       CALL iom_put( TRIM(tname(jh))//'y', out_eta(:,:,nb_ana+jh) )
       END DO
-#endif
 
       ! B) ubar
       !/////////
       !
-#if defined key_dimgout
-      cltext='ubar amplitude and phase'
-      CALL dia_wri_dimg(TRIM(cdfile_name_U), TRIM(cltext), out_u, 2*nb_ana, '2')
-#else
       DO jh = 1, nb_ana
       CALL iom_put( TRIM(tname(jh))//'x_u', out_u(:,:,jh) )
       CALL iom_put( TRIM(tname(jh))//'y_u', out_u(:,:,nb_ana+jh) )
       END DO
-#endif
 
       ! C) vbar
       !/////////
       !
-#if defined key_dimgout
-      cltext='vbar amplitude and phase'
-      CALL dia_wri_dimg(TRIM(cdfile_name_V), TRIM(cltext), out_v, 2*nb_ana, '2')
-#else
       DO jh = 1, nb_ana
          CALL iom_put( TRIM(tname(jh))//'x_v', out_v(:,:,jh       ) )
          CALL iom_put( TRIM(tname(jh))//'y_v', out_v(:,:,jh+nb_ana) )
       END DO
-#endif
       !
    END SUBROUTINE dia_wri_harm
@@ -492,5 +461,5 @@
             DO jj_sd = ji_sd, ninco
                zval2 = ABS(ztmp3(ji_sd,jj_sd))
-               IF( zval2.GE.zval1 )THEN
+               IF( zval2 >= zval1 )THEN
                   ipivot(ji_sd) = jj_sd
                   zval1         = zval2
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 6808)
@@ -46,10 +46,10 @@
    REAL(wp) ::   frc_wn_t, frc_wn_s    ! global forcing trends
    !
-   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf          , ssh_ini          !
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf 
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf_ini      , ssh_ini          !
    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   ssh_hc_loc_ini, ssh_sc_loc_ini   !
    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  !
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -93,5 +93,5 @@
       ! 1 - Trends due to forcing !
       ! ------------------------- !
-      z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes
+      z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + 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
@@ -100,10 +100,5 @@
       IF( ln_rnf_sal)   z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) )
       ! 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) - 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
-
+      IF( ln_isf    ) z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) )
       ! Add penetrative solar radiation
       IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr     (:,:) * surf(:,:) )
@@ -111,12 +106,12 @@
       IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t +               glob_sum( qgh_trd0(:,:) * surf(:,:) )
       !
-      IF( .NOT. lk_vvl ) THEN
-         IF ( ln_isfcav ) THEN
+      IF( ln_linssh ) THEN
+         IF( ln_isfcav ) THEN
             DO ji=1,jpi
                DO jj=1,jpj
                   z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem)
                   z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal)
-               ENDDO
-            ENDDO
+               END DO
+            END DO
          ELSE
             z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem)
@@ -131,5 +126,5 @@
       frc_s = frc_s + z_frc_trd_s * rdt
       !                                          ! Advection flux through fixed surface (z=0)
-      IF( .NOT. lk_vvl ) THEN
+      IF( ln_linssh ) THEN
          frc_wn_t = frc_wn_t + z_wn_trd_t * rdt
          frc_wn_s = frc_wn_s + z_wn_trd_s * rdt
@@ -139,4 +134,5 @@
       ! 2 -  Content variations !
       ! ------------------------ !
+      ! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl)
       zdiff_v2 = 0._wp
       zdiff_hc = 0._wp
@@ -144,9 +140,9 @@
 
       ! volume variation (calculated with ssh)
-      zdiff_v1 = glob_sum( surf(:,:) * ( sshn(:,:) - ssh_ini(:,:) ) )
+      zdiff_v1 = glob_sum_full( surf(:,:) * sshn(:,:) - surf_ini(:,:) * ssh_ini(:,:) )
 
       ! heat & salt content variation (associated with ssh)
-      IF( .NOT. lk_vvl ) THEN
-         IF ( ln_isfcav ) THEN
+      IF( ln_linssh ) THEN
+         IF( ln_isfcav ) THEN
             DO ji = 1, jpi
                DO jj = 1, jpj
@@ -159,26 +155,26 @@
             z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) 
          END IF
-         z_ssh_hc = glob_sum( z2d0 ) 
-         z_ssh_sc = glob_sum( z2d1 ) 
+         z_ssh_hc = glob_sum_full( z2d0 ) 
+         z_ssh_sc = glob_sum_full( z2d1 ) 
       ENDIF
 
       DO jk = 1, jpkm1
          ! volume variation (calculated with scale factors)
-         zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk) &
-            &                           * ( fse3t_n(:,:,jk) - e3t_ini(:,:,jk) ) )
+         zdiff_v2 = zdiff_v2 + glob_sum_full( surf(:,:) * tmask(:,:,jk)            &
+            &                           * e3t_n(:,:,jk) - surf_ini(:,:) * e3t_ini(:,:,jk) )
          ! heat content variation
-         zdiff_hc = zdiff_hc + glob_sum(  surf(:,:) * tmask(:,:,jk) & 
-            &                           * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - hc_loc_ini(:,:,jk) ) )
+         zdiff_hc = zdiff_hc + glob_sum_full(  surf(:,:) * tmask(:,:,jk)                                   & 
+            &                           * e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - surf_ini(:,:) * hc_loc_ini(:,:,jk) ) 
          ! salt content variation
-         zdiff_sc = zdiff_sc + glob_sum(  surf(:,:) * tmask(:,:,jk)   &
-            &                           * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - sc_loc_ini(:,:,jk) ) )
+         zdiff_sc = zdiff_sc + glob_sum_full( surf    (:,:) * tmask(:,:,jk)                           &
+                                        * e3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - surf_ini(:,:) * sc_loc_ini(:,:,jk) )
       ENDDO
 
       ! Substract forcing from heat content, salt content and volume variations
       zdiff_v1 = zdiff_v1 - frc_v
-      IF( lk_vvl )   zdiff_v2 = zdiff_v2 - frc_v
+      IF( .NOT.ln_linssh )   zdiff_v2 = zdiff_v2 - frc_v
       zdiff_hc = zdiff_hc - frc_t
       zdiff_sc = zdiff_sc - frc_s
-      IF( .NOT. lk_vvl ) THEN
+      IF( ln_linssh ) THEN
          zdiff_hc1 = zdiff_hc + z_ssh_hc 
          zdiff_sc1 = zdiff_sc + z_ssh_sc
@@ -192,15 +188,25 @@
       zvol_tot = 0._wp                    ! total ocean volume (calculated with scale factors)
       DO jk = 1, jpkm1
-         zvol_tot  = zvol_tot + glob_sum( surf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) )
+         zvol_tot  = zvol_tot + glob_sum_full( surf(:,:) * tmask(:,:,jk) * e3t_n(:,:,jk) )
       END DO
 
 !!gm to be added ?
-!      IF( .NOT. lk_vvl ) THEN            ! fixed volume, add the ssh contribution
+!      IF( ln_linssh ) THEN            ! fixed volume, add the ssh contribution
 !        zvol_tot = zvol_tot + glob_sum( surf(:,:) * sshn(:,:) )
 !      ENDIF
 !!gm end
 
-
-      IF( lk_vvl ) THEN
+      IF( ln_linssh ) THEN
+        CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content variation (C) 
+        CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content variation (psu)
+        CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp )  ! Heat content variation (1.e20 J) 
+        CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9   )              ! Salt content variation (psu*km3)
+        CALL iom_put( 'bgvolssh' , zdiff_v1  * 1.e-9   )              ! volume ssh variation (km3)  
+        CALL iom_put( 'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3) 
+        CALL iom_put( 'bgfrctem' , frc_t / zvol_tot    )              ! hc  - surface forcing (C) 
+        CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot    )              ! sc  - surface forcing (psu) 
+        CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot )              ! hc  - error due to free surface (C)
+        CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot )              ! sc  - error due to free surface (psu)
+      ELSE
         CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature variation (C) 
         CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot )              ! Salinity    variation (psu)
@@ -212,21 +218,10 @@
         CALL iom_put( 'bgfrctem' , frc_t / zvol_tot    )              ! hc  - surface forcing (C) 
         CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot    )              ! sc  - surface forcing (psu) 
-      ELSE
-        CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content variation (C) 
-        CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content variation (psu)
-        CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp )  ! Heat content variation (1.e20 J) 
-        CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9    )             ! Salt content variation (psu*km3)
-        CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh variation (km3)  
-        CALL iom_put( 'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3) 
-        CALL iom_put( 'bgfrctem' , frc_t / zvol_tot    )              ! hc  - surface forcing (C) 
-        CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot    )              ! sc  - surface forcing (psu) 
-        CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot )              ! hc  - error due to free surface (C)
-        CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot )              ! sc  - error due to free surface (psu)
       ENDIF
       !
       IF( lrst_oce )   CALL dia_hsb_rst( kt, 'WRITE' )
-
+      !
       CALL wrk_dealloc( jpi,jpj,   z2d0, z2d1 )
-
+      !
       IF( nn_timing == 1 )   CALL timing_stop('dia_hsb')
       !
@@ -259,13 +254,14 @@
            CALL iom_get( numror, 'frc_t', frc_t )
            CALL iom_get( numror, 'frc_s', frc_s )
-           IF( .NOT. lk_vvl ) THEN
+           IF( ln_linssh ) THEN
               CALL iom_get( numror, 'frc_wn_t', frc_wn_t )
               CALL iom_get( numror, 'frc_wn_s', frc_wn_s )
            ENDIF
+           CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling
            CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini )
            CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini )
            CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini )
            CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini )
-           IF( .NOT. lk_vvl ) THEN
+           IF( ln_linssh ) THEN
               CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini )
               CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini )
@@ -275,14 +271,16 @@
           IF(lwp) WRITE(numout,*) ' dia_hsb at initial state '
           IF(lwp) WRITE(numout,*) '~~~~~~~'
-          ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh
+          surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface
+          ssh_ini(:,:) = sshn(:,:)                          ! initial ssh
           DO jk = 1, jpk
-             e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                        ! initial vertical scale factors
-             hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk)   ! initial heat content
-             sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk)   ! initial salt content
+             ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).
+             e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors
+             hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content
+             sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content
           END DO
           frc_v = 0._wp                                           ! volume       trend due to forcing
           frc_t = 0._wp                                           ! heat content   -    -   -    -   
           frc_s = 0._wp                                           ! salt content   -    -   -    -        
-          IF( .NOT. lk_vvl ) THEN
+          IF( ln_linssh ) THEN
              IF ( ln_isfcav ) THEN
                 DO ji=1,jpi
@@ -310,13 +308,14 @@
         CALL iom_rstput( kt, nitrst, numrow, 'frc_t'   , frc_t     )
         CALL iom_rstput( kt, nitrst, numrow, 'frc_s'   , frc_s     )
-        IF( .NOT. lk_vvl ) THEN
+        IF( ln_linssh ) THEN
            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t )
            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s )
         ENDIF
+        CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini )      ! ice sheet coupling
         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini )
         CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini )
         CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini )
         CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini )
-        IF( .NOT. lk_vvl ) THEN
+        IF( ln_linssh ) THEN
            CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini )
            CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini )
@@ -381,11 +380,11 @@
       ! 1 - Allocate memory !
       ! ------------------- !
-      ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), &
-         &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), STAT=ierror )
+      ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), surf_ini(jpi,jpj), &
+         &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), STAT=ierror  )
       IF( ierror > 0 ) THEN
          CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN
       ENDIF
 
-      IF(.NOT. lk_vvl ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror )
+      IF( ln_linssh )   ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror )
       IF( ierror > 0 ) THEN
          CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 6808)
@@ -8,8 +8,8 @@
    !!                 !  1997-08  (G. Madec)  optimization
    !!                 !  1999-07  (E. Guilyardi)  hd28 + heat content 
-   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
-   !!   NEMO     3.2  !  2009-07  (S. Masson) hc300 bugfix + cleaning + add new diag
-   !!----------------------------------------------------------------------
-#if   defined key_diahth   ||   defined key_esopa
+   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            3.2  !  2009-07  (S. Masson) hc300 bugfix + cleaning + add new diag
+   !!----------------------------------------------------------------------
+#if   defined key_diahth
    !!----------------------------------------------------------------------
    !!   'key_diahth' :                              thermocline depth diag.
@@ -20,4 +20,5 @@
    USE dom_oce         ! ocean space and time domain
    USE phycst          ! physical constants
+   !
    USE in_out_manager  ! I/O manager
    USE lib_mpp         ! MPP library
@@ -31,5 +32,6 @@
    PUBLIC   dia_hth_alloc ! routine called by nemogcm.F90
 
-   LOGICAL , PUBLIC, PARAMETER          ::   lk_diahth = .TRUE.    !: thermocline-20d depths flag
+   LOGICAL , PUBLIC, PARAMETER ::   lk_diahth = .TRUE.    !: thermocline-20d depths flag
+   
    ! note: following variables should move to local variables once iom_put is always used 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hth    !: depth of the max vertical temperature gradient [m]
@@ -38,6 +40,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc3   !: heat content of first 300 m                    [W]
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
@@ -52,5 +52,5 @@
       !!---------------------------------------------------------------------
       !
-      ALLOCATE(hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc)
+      ALLOCATE( hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc )
       !
       IF( lk_mpp           )   CALL mpp_sum ( dia_hth_alloc )
@@ -108,7 +108,7 @@
       IF( kt == nit000 ) THEN
          !                                      ! allocate dia_hth array
-         IF( dia_hth_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' )
-
-         IF(.not. ALLOCATED(ik20))THEN
+         IF( dia_hth_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard arrays' )
+
+         IF(.NOT. ALLOCATED(ik20) ) THEN
             ALLOCATE(ik20(jpi,jpj), ik28(jpi,jpj), &
                &      zabs2(jpi,jpj),   &
@@ -187,5 +187,5 @@
             DO ji = 1, jpi
                !
-               zzdep = fsdepw(ji,jj,jk)
+               zzdep = gdepw_n(ji,jj,jk)
                zztmp = ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz)
                zzdep = zzdep * tmask(ji,jj,1)
@@ -223,5 +223,5 @@
             DO ji = 1, jpi
                !
-               zzdep = fsdepw(ji,jj,jk) * tmask(ji,jj,1)
+               zzdep = gdepw_n(ji,jj,jk) * tmask(ji,jj,1)
                !
                zztmp = tsn(ji,jj,nla10,jp_tem) - tsn(ji,jj,jk,jp_tem)  ! - delta T(10m)
@@ -270,10 +270,10 @@
          DO ji = 1, jpi
             !
-            zzdep = fsdepw(ji,jj,mbkt(ji,jj)+1)       ! depth of the oean bottom
+            zzdep = gdepw_n(ji,jj,mbkt(ji,jj)+1)       ! depth of the oean bottom
             !
             iid = ik20(ji,jj)
             IF( iid /= 1 ) THEN 
-               zztmp =      fsdept(ji,jj,iid  )   &                     ! linear interpolation
-                  &  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                       )   &
+               zztmp =      gdept_n(ji,jj,iid  )   &                     ! linear interpolation
+                  &  + (    gdept_n(ji,jj,iid+1) - gdept_n(ji,jj,iid)                       )   &
                   &  * ( 20.*tmask(ji,jj,iid+1) - tsn(ji,jj,iid,jp_tem)                       )   &
                   &  / ( tsn(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) )
@@ -285,6 +285,6 @@
             iid = ik28(ji,jj)
             IF( iid /= 1 ) THEN 
-               zztmp =      fsdept(ji,jj,iid  )   &                     ! linear interpolation
-                  &  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                       )   &
+               zztmp =      gdept_n(ji,jj,iid  )   &                     ! linear interpolation
+                  &  + (    gdept_n(ji,jj,iid+1) - gdept_n(ji,jj,iid)                       )   &
                   &  * ( 28.*tmask(ji,jj,iid+1) -    tsn(ji,jj,iid,jp_tem)                       )   &
                   &  / (  tsn(ji,jj,iid+1,jp_tem) -    tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) )
@@ -311,11 +311,11 @@
       END DO
       ! surface boundary condition
-      IF( lk_vvl ) THEN   ;   zthick(:,:) = 0._wp       ;   htc3(:,:) = 0._wp                                   
-      ELSE                ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)   
+      IF( ln_linssh ) THEN   ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)  
+      ELSE                   ;   zthick(:,:) = 0._wp       ;   htc3(:,:) = 0._wp                                   
       ENDIF
       ! integration down to ilevel
       DO jk = 1, ilevel
-         zthick(:,:) = zthick(:,:) + fse3t(:,:,jk)
-         htc3  (:,:) = htc3  (:,:) + fse3t(:,:,jk) * tsn(:,:,jk,jp_tem) * tmask(:,:,jk)
+         zthick(:,:) = zthick(:,:) + e3t_n(:,:,jk)
+         htc3  (:,:) = htc3  (:,:) + e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) * tmask(:,:,jk)
       END DO
       ! deepest layer
@@ -323,6 +323,6 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) * MIN( fse3t(ji,jj,ilevel+1), zthick(ji,jj) )  &
-                                                                   * tmask(ji,jj,ilevel+1)
+            htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem)                  &
+               &                      * MIN( e3t_n(ji,jj,ilevel+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1)
          END DO
       END DO
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90	(revision 6808)
@@ -72,5 +72,5 @@
 
       IF( llfsec .OR. kfreq < 0 ) THEN   ;   inbsec = kfreq                       ! output frequency already in seconds
-      ELSE                               ;   inbsec = kfreq * NINT( rdttra(1) )   ! from time-step to seconds
+      ELSE                               ;   inbsec = kfreq * NINT( rdt )   ! from time-step to seconds
       ENDIF
       iddss = NINT( rday          )                                         ! number of seconds in 1 day
@@ -116,6 +116,6 @@
       ! date of the beginning and the end of the run
 
-      zdrun = rdttra(1) / rday * REAL( nitend - nit000, wp )                ! length of the run in days
-      zjul  = fjulday - rdttra(1) / rday
+      zdrun = rdt / rday * REAL( nitend - nit000, wp )                ! length of the run in days
+      zjul  = fjulday - rdt / rday
       CALL ju2ymds( zjul        , iyear1, imonth1, iday1, zsec1 )           ! year/month/day of the beginning of run
       CALL ju2ymds( zjul + zdrun, iyear2, imonth2, iday2, zsec2 )           ! year/month/day of the end       of run
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 6808)
@@ -59,7 +59,5 @@
    REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: p_fval2d
 
-
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -118,11 +116,11 @@
                DO jj = 1, jpj
                   DO ji = 1, jpi
-                     zsfc = e1t(ji,jj) * fse3t(ji,jj,jk)
+                     zsfc = e1t(ji,jj) * e3t_n(ji,jj,jk)
                      zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc
                      zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc
                      zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc
-                  ENDDO
-               ENDDO
-            ENDDO
+                  END DO
+               END DO
+            END DO
             DO jn = 1, nptr
                zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90	(revision 6808)
@@ -0,0 +1,169 @@
+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
+
+   !!----------------------------------------------------------------------
+   !! 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) - 1)
+            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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 6808)
@@ -17,4 +17,6 @@
    !!                 ! 2005-11  (V. Garnier) Surface pressure gradient organization
    !!            3.2  ! 2008-11  (B. Lemaire) creation from old diawri
+   !!            3.7  ! 2014-01  (G. Madec) remove eddy induced velocity from no-IOM output
+   !!                 !                     change name of output variables in dia_wri_state
    !!----------------------------------------------------------------------
 
@@ -27,8 +29,6 @@
    USE dynadv, ONLY: ln_dynadv_vec
    USE zdf_oce         ! ocean vertical physics
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE ldfdyn_oce      ! ocean dynamics: lateral physics
-   USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv
-   USE sol_oce         ! solver variables
+   USE ldftra          ! lateral physics: eddy diffusivity coef.
+   USE ldfdyn          ! lateral physics: eddy viscosity   coef.
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice fields
@@ -41,10 +41,11 @@
    USE zdfddm          ! vertical  physics: double diffusion
    USE diahth          ! thermocline diagnostics
+   !
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    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 iom
    USE ioipsl
-   USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities     
 
 #if defined key_lim2
@@ -55,4 +56,6 @@
    USE lib_mpp         ! MPP library
    USE timing          ! preformance summary
+   USE diurnal_bulk    ! diurnal warm layer
+   USE cool_skin       ! Cool skin
    USE wrk_nemo        ! working array
 
@@ -76,5 +79,4 @@
    !! * Substitutions
 #  include "zdfddm_substitute.h90"
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -99,15 +101,8 @@
   END FUNCTION dia_wri_alloc
 
-#if defined key_dimgout
-   !!----------------------------------------------------------------------
-   !!   'key_dimgout'                                      DIMG output file
-   !!----------------------------------------------------------------------
-#   include "diawri_dimg.h90"
-
-#else
    !!----------------------------------------------------------------------
    !!   Default option                                   NetCDF output file
    !!----------------------------------------------------------------------
-# if defined key_iomput
+#if defined key_iomput
    !!----------------------------------------------------------------------
    !!   'key_iomput'                                        use IOM library
@@ -145,9 +140,9 @@
       ENDIF
 
-      IF( .NOT.lk_vvl ) THEN
-         CALL iom_put( "e3t" , fse3t_n(:,:,:) )
-         CALL iom_put( "e3u" , fse3u_n(:,:,:) )
-         CALL iom_put( "e3v" , fse3v_n(:,:,:) )
-         CALL iom_put( "e3w" , fse3w_n(:,:,:) )
+      IF( ln_linssh ) THEN
+         CALL iom_put( "e3t" , e3t_n(:,:,:) )
+         CALL iom_put( "e3u" , e3u_n(:,:,:) )
+         CALL iom_put( "e3v" , e3v_n(:,:,:) )
+         CALL iom_put( "e3w" , e3w_n(:,:,:) )
       ENDIF
 
@@ -206,9 +201,4 @@
          CALL iom_put( "sbu", z2d )                ! bottom i-current
       ENDIF
-#if defined key_dynspg_ts
-      CALL iom_put(  "ubar", un_adv(:,:)      )    ! barotropic i-current
-#else
-      CALL iom_put(  "ubar", un_b(:,:)        )    ! barotropic i-current
-#endif
       
       CALL iom_put( "voce", vn(:,:,:)         )    ! 3D j-current
@@ -223,14 +213,9 @@
          CALL iom_put( "sbv", z2d )                ! bottom j-current
       ENDIF
-#if defined key_dynspg_ts
-      CALL iom_put(  "vbar", vn_adv(:,:)      )    ! barotropic j-current
-#else
-      CALL iom_put(  "vbar", vn_b(:,:)        )    ! barotropic j-current
-#endif
 
       CALL iom_put( "woce", wn )                   ! vertical velocity
       IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value
          ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
-         z2d(:,:) = rau0 * e12t(:,:)
+         z2d(:,:) = rau0 * e1e2t(:,:)
          DO jk = 1, jpk
             z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
@@ -247,7 +232,7 @@
          DO jj = 2, jpjm1                                    ! sst gradient
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zztmp      = tsn(ji,jj,1,jp_tem)
-               zztmpx     = ( tsn(ji+1,jj  ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) / e1u(ji-1,jj  )
-               zztmpy     = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) / e2v(ji  ,jj-1)
+               zztmp  = tsn(ji,jj,1,jp_tem)
+               zztmpx = ( tsn(ji+1,jj,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) * r1_e1u(ji-1,jj)
+               zztmpy = ( tsn(ji,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) * r1_e2v(ji,jj-1)
                z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
                   &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
@@ -266,5 +251,5 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
+                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
                END DO
             END DO
@@ -278,5 +263,5 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
+                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
                END DO
             END DO
@@ -290,11 +275,11 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zztmp   = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  zztmpx  = 0.5 * (  un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)    &
-                     &             + un(ji  ,jj,jk) * un(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk) )  &
+                  zztmp   = 1._wp / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
+                  zztmpx  = 0.5 * (  un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)    &
+                     &             + un(ji  ,jj,jk) * un(ji  ,jj,jk) * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) )  &
                      &          *  zztmp 
                   !
-                  zztmpy  = 0.5 * (  vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk)    &
-                     &             + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk) )  &
+                  zztmpy  = 0.5 * (  vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)    &
+                     &             + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) )  &
                      &          *  zztmp 
                   !
@@ -311,5 +296,5 @@
          z3d(:,:,jpk) = 0.e0
          DO jk = 1, jpkm1
-            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk)
+            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk)
          END DO
          CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction
@@ -346,5 +331,5 @@
          z3d(:,:,jpk) = 0.e0
          DO jk = 1, jpkm1
-            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk)
+            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk)
          END DO
          CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction
@@ -380,4 +365,13 @@
       CALL wrk_dealloc( jpi , jpj, jpk , z3d )
       !
+      ! If we want tmb values 
+
+      IF (ln_diatmb) THEN
+         CALL dia_tmb 
+      ENDIF 
+      IF (ln_dia25h) THEN
+         CALL dia_25h( kt )
+      ENDIF 
+
       IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
       !
@@ -401,7 +395,6 @@
       !!      Each nwrite time step, output the instantaneous or mean fields
       !!----------------------------------------------------------------------
-      !!
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !!
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
       LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout
       CHARACTER (len=40) ::   clhstnam, clop, clmx           ! local names
@@ -411,6 +404,6 @@
       INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
       INTEGER  ::   jn, ierror                               ! local integers
-      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt           ! local scalars
-      !!
+      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars
+      !
       REAL(wp), POINTER, DIMENSION(:,:)   :: zw2d       ! 2D workspace
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace
@@ -419,6 +412,6 @@
       IF( nn_timing == 1 )   CALL timing_start('dia_wri')
       !
-      CALL wrk_alloc( jpi , jpj      , zw2d )
-      IF ( ln_traldf_gdia .OR. lk_vvl )  call wrk_alloc( jpi , jpj , jpk  , zw3d )
+                             CALL wrk_alloc( jpi,jpj      , zw2d )
+      IF( .NOT.ln_linssh )   CALL wrk_alloc( jpi,jpj,jpk  , zw3d )
       !
       ! Output the initial state and forcings
@@ -436,18 +429,14 @@
 
       ! Define frequency of output and means
-      zdt = rdt
-      IF( nacc == 1 ) zdt = rdtmin
-      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
+      clop = "x"         ! no use of the mask value (require less cpu time and otherwise the model crashes)
 #if defined key_diainstant
-      zsto = nwrite * zdt
+      zsto = nwrite * rdt
       clop = "inst("//TRIM(clop)//")"
 #else
-      zsto=zdt
+      zsto=rdt
       clop = "ave("//TRIM(clop)//")"
 #endif
-      zout = nwrite * zdt
-      zmax = ( nitend - nit000 + 1 ) * zdt
+      zout = nwrite * rdt
+      zmax = ( nitend - nit000 + 1 ) * rdt
 
       ! Define indices of the horizontal output zoom and vertical limit storage
@@ -491,5 +480,5 @@
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, zdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
             &           "m", ipk, gdept_1d, nz_T, "down" )
@@ -527,5 +516,5 @@
          CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, zdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
             &           "m", ipk, gdept_1d, nz_U, "down" )
@@ -540,5 +529,5 @@
          CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, zdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
             &          "m", ipk, gdept_1d, nz_V, "down" )
@@ -553,5 +542,5 @@
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, zdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_W, "depthw", "Vertical W levels",      &  ! Vertical grid: gdepw
             &          "m", ipk, gdepw_1d, nz_W, "down" )
@@ -565,5 +554,5 @@
          CALL histdef( nid_T, "vosaline", "Salinity"                           , "PSU"    ,   &  ! sn
             &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
-         IF(  lk_vvl  ) THEN
+         IF(  .NOT.ln_linssh  ) THEN
             CALL histdef( nid_T, "vovvle3t", "Level thickness"                    , "m"      ,&  ! e3t_n
             &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
@@ -586,5 +575,5 @@
          CALL histdef( nid_T, "sosfldow", "downward salt flux"                 , "PSU/m2/s",  &  ! sfx
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-         IF(  .NOT. lk_vvl  ) THEN
+         IF(  ln_linssh  ) THEN
             CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"     &  ! emp * tsn(:,:,1,jp_tem)
             &                                                                  , "KgC/m2/s",  &  ! sosst_cd
@@ -659,6 +648,6 @@
          
          clmx ="l_max(only(x))"    ! max index on a period
-         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX 
-            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout )
+!         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX 
+!            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout )
 #if defined key_diahth
          CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth
@@ -684,13 +673,4 @@
          CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un
             &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
-         IF( ln_traldf_gdia ) THEN
-            CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv
-                 &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
-         ELSE
-#if defined key_diaeiv
-            CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv
-            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
-#endif
-         END IF
          !                                                                                      !!! nid_U : 2D
          CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau
@@ -702,13 +682,4 @@
          CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vn
             &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
-         IF( ln_traldf_gdia ) THEN
-            CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv
-                 &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
-         ELSE 
-#if defined key_diaeiv
-            CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv
-            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
-#endif
-         END IF
          !                                                                                      !!! nid_V : 2D
          CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau
@@ -720,13 +691,4 @@
          CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! wn
             &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
-         IF( ln_traldf_gdia ) THEN
-            CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv
-                 &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
-         ELSE
-#if defined key_diaeiv
-            CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv
-                 &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
-#endif
-         END IF
          CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt
             &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
@@ -739,13 +701,4 @@
          ENDIF
          !                                                                                      !!! nid_W : 2D
-#if defined key_traldf_c2d
-         CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity"           , "m2/s"   ,   &  ! ahtw
-            &          jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
-# if defined key_traldf_eiv 
-            CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s",   &  ! aeiw
-               &       jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
-# endif
-#endif
-
          CALL histend( nid_W, snc4chunks=snc4set )
 
@@ -768,9 +721,9 @@
       ENDIF
 
-      IF( lk_vvl ) THEN
-         CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * fse3t_n(:,:,:) , ndim_T , ndex_T  )   ! heat content
-         CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * fse3t_n(:,:,:) , ndim_T , ndex_T  )   ! salt content
-         CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * fse3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface heat content
-         CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * fse3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface salinity content
+      IF( .NOT.ln_linssh ) THEN
+         CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! heat content
+         CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! salt content
+         CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface heat content
+         CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface salinity content
       ELSE
          CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) , ndim_T , ndex_T  )   ! temperature
@@ -779,8 +732,8 @@
          CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) , ndim_hT, ndex_hT )   ! sea surface salinity
       ENDIF
-      IF( lk_vvl ) THEN
-         zw3d(:,:,:) = ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2
-         CALL histwrite( nid_T, "vovvle3t", it, fse3t_n (:,:,:) , ndim_T , ndex_T  )   ! level thickness
-         CALL histwrite( nid_T, "vovvldep", it, fsdept_n(:,:,:) , ndim_T , ndex_T  )   ! t-point depth
+      IF( .NOT.ln_linssh ) THEN
+         zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2
+         CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T  )   ! level thickness
+         CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T  )   ! t-point depth
          CALL histwrite( nid_T, "vovvldef", it, zw3d             , ndim_T , ndex_T  )   ! level thickness deformation
       ENDIF
@@ -791,5 +744,5 @@
                                                                                   ! (includes virtual salt flux beneath ice 
                                                                                   ! in linear free surface case)
-      IF( .NOT. lk_vvl ) THEN
+      IF( ln_linssh ) THEN
          zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem)
          CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sst
@@ -855,55 +808,10 @@
 
       CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current
-      IF( ln_traldf_gdia ) THEN
-         IF (.not. ALLOCATED(psix_eiv))THEN
-            ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr )
-            IF( lk_mpp   )   CALL mpp_sum ( ierr )
-            IF( ierr > 0 )   CALL ctl_stop('STOP', 'diawri: unable to allocate psi{x,y}_eiv')
-            psix_eiv(:,:,:) = 0.0_wp
-            psiy_eiv(:,:,:) = 0.0_wp
-         ENDIF
-         DO jk=1,jpkm1
-            zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz
-         END DO
-         zw3d(:,:,jpk) = 0._wp
-         CALL histwrite( nid_U, "vozoeivu", it, zw3d, ndim_U , ndex_U )           ! i-eiv current
-      ELSE
-#if defined key_diaeiv
-         CALL histwrite( nid_U, "vozoeivu", it, u_eiv, ndim_U , ndex_U )          ! i-eiv current
-#endif
-      ENDIF
       CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
 
       CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current
-      IF( ln_traldf_gdia ) THEN
-         DO jk=1,jpk-1
-            zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz
-         END DO
-         zw3d(:,:,jpk) = 0._wp
-         CALL histwrite( nid_V, "vomeeivv", it, zw3d, ndim_V , ndex_V )           ! j-eiv current
-      ELSE
-#if defined key_diaeiv
-         CALL histwrite( nid_V, "vomeeivv", it, v_eiv, ndim_V , ndex_V )          ! j-eiv current
-#endif
-      ENDIF
       CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
 
       CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current
-      IF( ln_traldf_gdia ) THEN
-         DO jk=1,jpk-1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1  ! vector opt.
-                  zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2v(ji,jj) + &
-                       &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx
-               END DO
-            END DO
-         END DO
-         zw3d(:,:,jpk) = 0._wp
-         CALL histwrite( nid_W, "voveeivw", it, zw3d          , ndim_T, ndex_T )    ! vert. eiv current
-      ELSE
-#   if defined key_diaeiv
-         CALL histwrite( nid_W, "voveeivw", it, w_eiv          , ndim_T, ndex_T )    ! vert. eiv current
-#   endif
-      ENDIF
       CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef.
       CALL histwrite( nid_W, "votkeavm", it, avmu           , ndim_T, ndex_T )    ! T vert. eddy visc. coef.
@@ -911,10 +819,4 @@
          CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T )    ! S vert. eddy diff. coef.
       ENDIF
-#if defined key_traldf_c2d
-      CALL histwrite( nid_W, "soleahtw", it, ahtw          , ndim_hT, ndex_hT )   ! lateral eddy diff. coef.
-# if defined key_traldf_eiv
-         CALL histwrite( nid_W, "soleaeiw", it, aeiw       , ndim_hT, ndex_hT )   ! EIV coefficient at w-point
-# endif
-#endif
 
       ! 3. Close all files
@@ -927,12 +829,10 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi , jpj      , zw2d )
-      IF ( ln_traldf_gdia .OR. lk_vvl )  call wrk_dealloc( jpi , jpj , jpk  , zw3d )
+                             CALL wrk_dealloc( jpi , jpj        , zw2d )
+      IF( .NOT.ln_linssh )   CALL wrk_dealloc( jpi , jpj , jpk  , zw3d )
       !
       IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
       !
    END SUBROUTINE dia_wri
-# endif
-
 #endif
 
@@ -957,9 +857,7 @@
       INTEGER  ::   id_i , nz_i, nh_i       
       INTEGER, DIMENSION(1) ::   idex             ! local workspace
-      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt
+      REAL(wp) ::   zsto, zout, zmax, zjulian
       !!----------------------------------------------------------------------
       ! 
-!     IF( nn_timing == 1 )   CALL timing_start('dia_wri_state') ! not sure this works for routines not called in first timestep
-
       ! 0. Initialisation
       ! -----------------
@@ -968,9 +866,8 @@
       clname = cdfile_name
       IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
-      zdt  = rdt
       zsto = rdt
       clop = "inst(x)"           ! no use of the mask value (require less cpu time)
       zout = rdt
-      zmax = ( nitend - nit000 + 1 ) * zdt
+      zmax = ( nitend - nit000 + 1 ) * rdt
 
       IF(lwp) WRITE(numout,*)
@@ -987,5 +884,5 @@
       zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
       CALL histbeg( clname, jpi, glamt, jpj, gphit,   &
-          1, jpi, 1, jpj, nit000-1, zjulian, zdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
+          1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
       CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept
           "m", jpk, gdept_1d, nz_i, "down")
@@ -1005,4 +902,14 @@
       CALL histdef( id_i, "vovecrtz", "Vertical Velocity"     , "m/s"    ,   &   ! vertical current
          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
+         !
+      CALL histdef( id_i, "ahtu"    , "u-eddy diffusivity"    , "m2/s"    ,   &   ! zonal current
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+      CALL histdef( id_i, "ahtv"    , "v-eddy diffusivity"    , "m2/s"    ,   &   ! meridonal current
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
+      CALL histdef( id_i, "ahmt"    , "t-eddy viscosity"      , "m2/s"    ,   &   ! zonal current
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+      CALL histdef( id_i, "ahmf"    , "f-eddy viscosity"      , "m2/s"    ,   &   ! meridonal current
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
+         !
       CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater 
          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
@@ -1017,8 +924,10 @@
       CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress
          &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-      IF( lk_vvl ) THEN
-         CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      ,   &   ! t-point depth
+      IF( .NOT.ln_linssh ) THEN
+         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 )
-      END IF
+         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 )
+      ENDIF
 
 #if defined key_lim2
@@ -1044,5 +953,11 @@
       CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity
       CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity
-      CALL histwrite( id_i, "sowaflup", kt, (emp-rnf )       , jpi*jpj    , idex )    ! freshwater budget
+      !
+      CALL histwrite( id_i, "ahtu"    , kt, ahtu             , jpi*jpj*jpk, idex )    ! aht at u-point
+      CALL histwrite( id_i, "ahtv"    , kt, ahtv             , jpi*jpj*jpk, idex )    !  -  at v-point
+      CALL histwrite( id_i, "ahmt"    , kt, ahmt             , jpi*jpj*jpk, idex )    ! ahm at t-point
+      CALL histwrite( id_i, "ahmf"    , kt, ahmf             , jpi*jpj*jpk, idex )    !  -  at f-point
+      !
+      CALL histwrite( id_i, "sowaflup", kt, emp-rnf          , jpi*jpj    , idex )    ! freshwater budget
       CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux
       CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux
@@ -1051,8 +966,12 @@
       CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress
 
+      IF(  .NOT.ln_linssh  ) THEN             
+         CALL histwrite( id_i, "vovvldep", kt, gdept_n(:,:,:), jpi*jpj*jpk, idex )!  T-cell depth 
+         CALL histwrite( id_i, "vovvle3t", kt, e3t_n (:,:,:) , jpi*jpj*jpk, idex )!  T-cell thickness  
+      END IF 
       ! 3. Close the file
       ! -----------------
       CALL histclo( id_i )
-#if ! defined key_iomput && ! defined key_dimgout
+#if ! defined key_iomput
       IF( ninist /= 1  ) THEN
          CALL histclo( nid_T )
@@ -1062,9 +981,7 @@
       ENDIF
 #endif
-       
-!     IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep
       ! 
-
    END SUBROUTINE dia_wri_state
+
    !!======================================================================
 END MODULE diawri
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90	(revision 6807)
+++ 	(revision )
@@ -1,372 +1,0 @@
-  !!----------------------------------------------------------------------
-  !!                        ***  diawri_dimg.h90  ***
-  !!----------------------------------------------------------------------
-  !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-  !! $Id $
-  !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-  !!----------------------------------------------------------------------
-
-  SUBROUTINE dia_wri( kt )
-    !!----------------------------------------------------------------------
-    !!           *** routine dia_wri ***
-    !!
-    !! ** Purpose : output dynamics and tracer fields on direct access file
-    !!              suitable for MPP computing
-    !!
-    !! ** define key : 'key_dimgout'
-    !!
-    !! **  Method : Default is to cumulate the values over the interval between
-    !!      2 output, and each nwrite time-steps  the mean value is  computed 
-    !!      and written to the direct access file.
-    !!     If 'key_diainstant' is defined, no mean values are computed and the 
-    !!     instantaneous fields are dump.
-    !!       Each processor creates its own file with its local data
-    !!     Merging all the files is performed off line by a dedicated program
-    !!
-    !! ** Arguments :
-    !!     kt      : time-step number
-    !!     kindinc :  error condition indicator : >=0 :  OK, < 0 : error.
-    !!
-    !! ** Naming convention for files
-    !!
-    !! {cexper}_{var}_y----m--d--.dimg
-    !!   cexper is the name of the experience, given in the namelist
-    !!   var can be either U, V, T, S, KZ, SSH, ...
-    !!   var can also be 2D, which means that each level of the file is a 2D field as described below
-    !!    y----m--d--  is the date at the time of the dump
-    !!    For mpp output, each processor dumps its own memory, on appropriate record range 
-    !!    (direct access : for level jk of a klev field on proc narea irec = 1+ klev*(narea -1) + jk )
-    !!    To be tested with a lot of procs !!!!
-    !!
-    !!  level 1:  utau(:,:) * umask(:,:,1) zonal stress in N.m-2
-    !!  level 2:  vtau(:,:) * vmask(:,:,1) meridional stress in N. m-2
-    !!  level 3:  qsr + qns                total heat flux (W/m2)
-    !!  level 4:  ( emp (:,:)-rnf(:,:) )   E-P flux (mm/day)
-    !!  level 5:  tb  (:,:,1)-sst          model SST -forcing sst (degree C) ! deprecated
-    !!  level 6:  bsfb(:,:)		   streamfunction (m**3/s)
-    !!  level 7:  qsr (:,:)		   solar flux (W/m2)
-    !!  level 8:  qrp (:,:)                relax component of T flux.
-    !!  level 9:  erp (:,:)                relax component of S flux
-    !!  level 10: hmld(:,:)                turbocline depth
-    !!  level 11: hmlp(:,:)                mixed layer depth
-    !!  level 12: fr_i(:,:)                ice fraction (between 0 and 1)
-    !!  level 13: sst(:,:)                 the observed SST we relax to. ! deprecated
-    !!  level 14: qct(:,:)                 equivalent flux due to treshold SST
-    !!  level 15: fbt(:,:)                 feedback term .
-    !!  level 16: ( emp * sss )            concentration/dilution term on salinity
-    !!  level 17: ( emp * sst )            concentration/dilution term on temperature
-    !!  level 17: fsalt(:,:)               Ice=>ocean net freshwater
-    !!  level 18: gps(:,:)                 the surface pressure (m).
-    !!  level 19: spgu(:,:)                the surface pressure gradient in X direction.
-    !!  level 20: spgv(:,:)                the surface pressure gradient in Y direction.
-    !! 
-    !! History:  OPA  ! 1997-02 ( Clipper Group ) dimg files
-    !!            -   ! 2003-12 ( J.M. Molines) f90, mpp output for OPA9.0
-    !!   NEMO    1.0  ! 2005-05  (S. Theetten) add emps fsalt move gps spgu spgv 2 lines below
-    !!            -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
-    !!----------------------------------------------------------------------
-    USE lib_mpp
-    !!
-    INTEGER ,INTENT(in) :: kt
-    !!
-#if defined key_diainstant
-    LOGICAL, PARAMETER :: ll_dia_inst=.TRUE.  !: for instantaneous output
-#else
-    LOGICAL, PARAMETER :: ll_dia_inst=.FALSE. !: for average output
-#endif
-    INTEGER              , SAVE                    ::  nmoyct 
-    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  um , vm, wm   ! mean u, v, w fields
-    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  avtm          ! mean kz fields
-    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  tm , sm       ! mean t, s fields
-    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  fsel          ! mean 2d fields
-    
-    INTEGER :: inbsel, jk
-    INTEGER :: iyear,imon,iday
-    INTEGER :: ialloc
-    REAL(wp) :: zdtj
-    CHARACTER(LEN=80) :: clname
-    CHARACTER(LEN=80) :: cltext
-    CHARACTER(LEN=80) :: clmode
-    CHARACTER(LEN= 4) :: clver
-    !!----------------------------------------------------------------------
-    IF( nn_timing == 1 )   CALL timing_start('dia_wri')
-    !
-    !  Initialization
-    !  ---------------
-    !
-    IF( .NOT. ALLOCATED(um) )THEN
-       ALLOCATE(um(jpi,jpj,jpk), vm(jpi,jpj,jpk), &
-                wm(jpi,jpj,jpk),                  &
-                avtm(jpi,jpj,jpk),                &
-                tm(jpi,jpj,jpk), sm(jpi,jpj,jpk), &
-                fsel(jpi,jpj,jpk),                &
-                STAT=ialloc )
-       !
-       IF( lk_mpp      )   CALL mpp_sum ( ialloc  )
-       IF( ialloc /= 0 )   CALL ctl_warn('dia_wri( diawri_dimg.h90) : failed to allocate arrays')
-    ENDIF
-
-
-    inbsel = 18
-
-    IF( inbsel >  jpk ) THEN
-       IF(lwp) WRITE(numout,*)  ' STOP inbsel =',inbsel,' is larger than jpk=',jpk
-       STOP
-    ENDIF
-
-    iyear = ndastp/10000
-    imon = (ndastp-iyear*10000)/100
-    iday = ndastp - imon*100 - iyear*10000
-
-    !     
-    !! dimg format V1.0 should start with the 4 char. string '@!01'
-    !!
-    clver='@!01'
-    !
-    IF( .NOT. ll_dia_inst ) THEN
-       !
-       !! * Mean output section
-       !! ----------------------
-       !
-       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
-            'THE OUTPUT FILES CONTAINS THE AVERAGE OF EACH FIELD'
-       !
-       IF( kt == nit000  ) THEN
-          ! reset arrays for average computation
-          nmoyct = 0
-          !
-          um(:,:,:) = 0._wp
-          vm(:,:,:) = 0._wp
-          wm(:,:,:) = 0._wp
-          avtm(:,:,:) = 0._wp
-          tm(:,:,:) = 0._wp
-          sm(:,:,:) = 0._wp
-          fsel(:,:,:) = 0._wp
-          !
-       ENDIF
-
-       !  cumulate values
-       !  ---------------
-
-       nmoyct = nmoyct+1
-       !
-       um(:,:,:)=um(:,:,:) + un (:,:,:)
-       vm(:,:,:)=vm(:,:,:) + vn (:,:,:)
-       wm(:,:,:)=wm(:,:,:) + wn (:,:,:)
-       avtm(:,:,:)=avtm(:,:,:) + avt (:,:,:)
-       tm(:,:,:)=tm(:,:,:) + tsn(:,:,:,jp_tem)
-       sm(:,:,:)=sm(:,:,:) + tsn(:,:,:,jp_sal)
-       !
-       fsel(:,:,1 ) = fsel(:,:,1 ) + utau(:,:) * umask(:,:,1)
-       fsel(:,:,2 ) = fsel(:,:,2 ) + vtau(:,:) * vmask(:,:,1)
-       fsel(:,:,3 ) = fsel(:,:,3 ) + qsr (:,:) + qns  (:,:) 
-       fsel(:,:,4 ) = fsel(:,:,4 ) + ( emp(:,:)-rnf(:,:) ) 
-       !        fsel(:,:,5 ) = fsel(:,:,5 ) + tsb(:,:,1,jp_tem)  !RB not used
-       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:) 
-       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:)
-       IF( ln_ssr ) THEN
-          IF( nn_sstr /= 0 )   fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:)
-          IF( nn_sssr /= 0 )   fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:)
-       ENDIF
-       fsel(:,:,10) = fsel(:,:,10) + hmld(:,:)
-       fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
-       fsel(:,:,12) = fsel(:,:,12) + fr_i(:,:)
-       !        fsel(:,:,13) = fsel(:,:,13)   !RB not used
-       !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
-       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
-       fsel(:,:,16) = fsel(:,:,16) + ( emp(:,:)*tsn(:,:,1,jp_sal) ) 
-       fsel(:,:,17) = fsel(:,:,17) + ( emp(:,:)*tsn(:,:,1,jp_tem) ) 
-       !
-       ! Output of dynamics and tracer fields and selected fields
-       ! --------------------------------------------------------
-       !
-       !
-       zdtj=rdt/86400.   ! time step in days
-       WRITE(clmode,'(f5.1,a)' ) nwrite*zdtj,' days average'
-
-       !       iwrite=NINT(adatrj/rwrite)
-       !      IF (abs(adatrj-iwrite*rwrite) < zdtj/2.      &
-
-       IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
-            &   .OR. ( kt == 1 .AND. ninist ==1 )  ) THEN
-          ! it is time to make a dump on file 
-          ! compute average
-          um(:,:,:) = um(:,:,:) / nmoyct
-          vm(:,:,:) = vm(:,:,:) / nmoyct
-          wm(:,:,:) = wm(:,:,:) / nmoyct
-          avtm(:,:,:) = avtm(:,:,:) / nmoyct
-          tm(:,:,:) = tm(:,:,:) / nmoyct
-          sm(:,:,:) = sm(:,:,:) / nmoyct
-          !
-          fsel(:,:,:) = fsel(:,:,:) / nmoyct
-          !
-          ! note : the surface pressure is not averaged, but rather 
-          ! computed from the averaged gradients.
-          !
-          ! mask mean field with tmask except utau vtau (1,2)
-          DO jk=3,inbsel
-            fsel(:,:,jk)=fsel(:,:,jk)*tmask(:,:,1)
-          END DO
-       ENDIF
-       !
-    ELSE   ! ll_dia_inst true
-       !
-       !! * Instantaneous output section
-       !! ------------------------------
-       !
-       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
-            'THE OUTPUT FILES CONTAINS INSTANTANEOUS VALUES OF EACH FIELD'
-       !
-       zdtj=rdt/86400.   ! time step in days
-       !  iwrite=NINT(adatrj/rwrite)
-       clmode='instantaneous'
-       !     IF (abs(adatrj-iwrite*rwrite) < zdtj/2.  &
-       IF (  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
-            &   .OR. ( kt == 1 .AND. ninist == 1 )  ) THEN
-          !
-          ! transfer wp arrays to sp arrays for dimg files
-          fsel(:,:,:) = 0._wp
-          !
-          fsel(:,:,1 ) = utau(:,:) * umask(:,:,1)
-          fsel(:,:,2 ) = vtau(:,:) * vmask(:,:,1)
-          fsel(:,:,3 ) = (qsr (:,:) + qns (:,:)) * tmask(:,:,1)
-          fsel(:,:,4 ) = ( emp(:,:)-rnf(:,:) ) * tmask(:,:,1) 
-          !         fsel(:,:,5 ) = (tsb(:,:,1,jp_tem) - sf_sst(1)%fnow(:,:) ) *tmask(:,:,1) !RB not used
-
-          fsel(:,:,6 ) = sshn(:,:)
-          fsel(:,:,7 ) = qsr (:,:) * tmask(:,:,1)
-          IF( ln_ssr ) THEN
-             IF( nn_sstr /= 0 )   fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1)
-             IF( nn_sssr /= 0 )   fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1)
-          ENDIF
-          fsel(:,:,10) = hmld(:,:) * tmask(:,:,1)
-          fsel(:,:,11) = hmlp(:,:) * tmask(:,:,1)
-          fsel(:,:,12) = fr_i(:,:) * tmask(:,:,1)
-          !         fsel(:,:,13) = sf_sst(1)%fnow(:,:) !RB not used
-          !         fsel(:,:,14) =  qct(:,:)
-          !         fsel(:,:,15) =  fbt(:,:)
-          fsel(:,:,16) = ( emp(:,:)-tsn(:,:,1,jp_sal) ) * tmask(:,:,1) 
-          fsel(:,:,17) = ( emp(:,:)-tsn(:,:,1,jp_tem) ) * tmask(:,:,1) 
-          !
-          !         qct(:,:) = 0._wp
-       ENDIF
-    ENDIF
-    !
-    ! Opening of the datrj.out file with the absolute time in day of each dump
-    ! this file gives a record of the dump date for post processing ( ASCII file )
-    !
-    IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
-         &   .OR. ( kt == 1 .AND. ninist == 1 )  ) THEN
-
-       IF( lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj
-
-       !! * U section
-
-       WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday
-       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode)
-       !
-       IF( ll_dia_inst) THEN   ;   CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
-       ELSE                    ;   CALL dia_wri_dimg(clname, cltext, um, jpk, 'T')
-       ENDIF
-
-       !! * V section
-
-       WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday
-       cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode)
-       !
-       IF( ll_dia_inst) THEN
-          CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T')
-       ELSE
-          CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T')
-       ENDIF
-       !
-
-       !! * KZ section
-
-       WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday
-       cltext=TRIM(cexper)//' KZ(m2/s) '//TRIM(clmode)
-
-       IF( ll_dia_inst) THEN
-          CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W')
-       ELSE
-          CALL dia_wri_dimg(clname, cltext, avtm, jpk, 'W')
-       ENDIF
-       !
-
-       !! * W section
-
-       WRITE(clname,9000) TRIM(cexper),'W',iyear,imon,iday
-       cltext=TRIM(cexper)//' W(m/s) '//TRIM(clmode)
-
-       IF( ll_dia_inst) THEN
-          CALL dia_wri_dimg(clname, cltext, wn, jpk, 'W')
-       ELSE
-          CALL dia_wri_dimg(clname, cltext, wm, jpk, 'W')
-       ENDIF
-
-       !! * T section
-
-       WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday
-       cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode)
-
-       IF( ll_dia_inst) THEN
-          CALL dia_wri_dimg(clname, cltext, tsn(:,:,:,jp_tem), jpk, 'T')
-       ELSE
-          CALL dia_wri_dimg(clname, cltext, tm               , jpk, 'T')
-       ENDIF
-       !
-
-       !! * S section
-
-       WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday
-       cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode)
-
-       IF( ll_dia_inst) THEN
-          CALL dia_wri_dimg(clname, cltext, tsn(:,:,:,jp_sal), jpk, 'T')
-       ELSE
-          CALL dia_wri_dimg(clname, cltext, sm               , jpk, 'T')
-       ENDIF
-       !
-
-       !! * 2D section
-
-       WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday
-       cltext='2D fields '//TRIM(clmode)
-
-       IF( ll_dia_inst) THEN
-          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
-       ELSE
-          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
-       ENDIF
-
-       IF( lk_mpp )   CALL mppsync   ! synchronization in mpp
-
-       !! * Log message in numout 
-
-       IF( lwp)WRITE(numout,*) ' '
-       IF( lwp)WRITE(numout,*) ' **** WRITE in dimg file ',kt
-
-       IF( lwp .AND.        ll_dia_inst) WRITE(numout,*) '    instantaneous fields'
-       IF( lwp .AND. .NOT.  ll_dia_inst) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
-       !
-       !
-       !! * Reset cumulating arrays  and counter to 0 after writing
-       !
-       IF( .NOT. ll_dia_inst ) THEN
-          nmoyct = 0
-          !
-          um(:,:,:) = 0._wp
-          vm(:,:,:) = 0._wp
-          wm(:,:,:) = 0._wp
-          tm(:,:,:) = 0._wp
-          sm(:,:,:) = 0._wp
-          fsel(:,:,:) = 0._wp
-          avtm(:,:,:) = 0._wp
-       ENDIF
-    ENDIF
-    !
-    IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
-    !
-9000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
-    !
-  END SUBROUTINE dia_wri
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIU/cool_skin.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIU/cool_skin.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIU/cool_skin.F90	(revision 6808)
@@ -0,0 +1,153 @@
+MODULE cool_skin
+   !!======================================================================
+   !!                    ***  MODULE  cool_skin  ***
+   !!     Cool skin thickness and delta T correction using Artele et al. (2002)
+   !!     [see also Tu and Tsuang (2005)]
+   !!
+   !!=====================================================================
+   !! History :        !  2012-01  (P. Sykes)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   diurnal_sst_coolskin_step  : time-step the cool skin corrections
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE phycst
+   USE dom_oce
+   USE in_out_manager
+   USE sbc_oce
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   
+   IMPLICIT NONE
+   
+   ! Namelist parameters
+
+   ! Parameters
+   REAL(wp), PRIVATE, PARAMETER :: pp_k = 0.596_wp          ! Thermal conductivity of seawater
+   REAL(wp), PRIVATE, PARAMETER :: pp_v = 1.05e-6_wp        ! Kinematic viscosity of seawater
+   REAL(wp), PRIVATE, PARAMETER :: pp_C = 86400             ! seconds [see Tu and Tsuang (2005)]
+   REAL(wp), PRIVATE, PARAMETER :: pp_cw = 3993._wp         ! specific heat capacity of seawater
+   REAL(wp), PRIVATE, PARAMETER :: pp_h = 10._wp            ! reference depth [using 10m from Artale et al. (2002)]
+   REAL(wp), PRIVATE, PARAMETER :: pp_rhoa = 1.20421_wp     ! density of air (at 20C)
+   REAL(wp), PRIVATE, PARAMETER :: pp_cda = 1.45e-3_wp      ! assumed air-sea drag coefficient for calculating wind speed
+   
+   ! Key variables
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csdsst    ! Cool skin delta SST
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csthick   ! Cool skin thickness
+
+   PRIVATE
+   PUBLIC diurnal_sst_coolskin_step, diurnal_sst_coolskin_init
+
+      !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   
+   CONTAINS 
+   
+   SUBROUTINE diurnal_sst_coolskin_init
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_coolskin_init ***
+      !!
+      !! ** Purpose :   initialise the cool skin model
+      !!
+      !! ** Method : 
+      !!
+      !! ** Reference :
+      !! 
+      !!----------------------------------------------------------------------
+      
+      IMPLICIT NONE
+      
+      ALLOCATE( x_csdsst(jpi,jpj), x_csthick(jpi,jpj) )
+      x_csdsst = 0.
+      x_csthick = 0.
+      
+   END SUBROUTINE diurnal_sst_coolskin_init
+ 
+   SUBROUTINE diurnal_sst_coolskin_step(psqflux, pstauflux, psrho, rdt)
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_takaya_step ***
+      !!
+      !! ** Purpose :   Time-step the Artale cool skin model
+      !!
+      !! ** Method : 
+      !!
+      !! ** Reference : 
+      !!----------------------------------------------------------------------
+     
+      IMPLICIT NONE
+     
+      ! Dummy variables
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psqflux     ! Heat (non-solar)(Watts)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pstauflux   ! Wind stress (kg/ m s^2)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho       ! Water density (kg/m^3)
+      REAL(wp), INTENT(IN) :: rdt                             ! Time-step
+     
+      ! Local variables
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fv                    ! Friction velocity     
+      REAL(wp), DIMENSION(jpi,jpj) :: z_gamma                 ! Dimensionless function of wind speed
+      REAL(wp), DIMENSION(jpi,jpj) :: z_lamda                 ! Sauders (dimensionless) proportionality constant
+      REAL(wp), DIMENSION(jpi,jpj) :: z_wspd                  ! Wind speed (m/s)
+      REAL(wp) :: z_ztx                                       ! Temporary u wind stress
+      REAL(wp) :: z_zty                                       ! Temporary v wind stress
+      REAL(wp) :: z_zmod                                      ! Temporary total wind stress
+     
+      INTEGER :: ji,jj
+     
+      IF ( .NOT. ln_blk_core ) THEN
+         CALL ctl_stop("cool_skin.f90: diurnal flux processing only implemented"//&
+         &             " for core bulk forcing")
+      ENDIF
+ 
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+            
+            ! Calcualte wind speed from wind stress and friction velocity
+            IF( tmask(ji,jj,1) == 1. .AND. pstauflux(ji,jj) /= 0 .AND. psrho(ji,jj) /=0 ) THEN
+               z_fv(ji,jj) = SQRT( pstauflux(ji,jj) / psrho(ji,jj) )
+               z_wspd(ji,jj) = SQRT( pstauflux(ji,jj) / ( pp_cda * pp_rhoa ) )
+            ELSE
+               z_fv(ji,jj) = 0.
+               z_wspd(ji,jj) = 0.     
+            ENDIF
+
+ 
+            ! Calculate gamma function which is dependent upon wind speed
+            IF( tmask(ji,jj,1) == 1. ) THEN
+               IF( ( z_wspd(ji,jj) <= 7.5 ) ) z_gamma(ji,jj) = ( 0.2 * z_wspd(ji,jj) ) + 0.5
+               IF( ( z_wspd(ji,jj) > 7.5 ) .AND. ( z_wspd(ji,jj) < 10. ) ) z_gamma(ji,jj) = ( 1.6 * z_wspd(ji,jj) ) - 10.
+               IF( ( z_wspd(ji,jj) >= 10. ) ) z_gamma(ji,jj) = 6.
+            ENDIF
+
+
+            ! Calculate lamda function
+            IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 ) THEN
+               z_lamda(ji,jj) = ( z_fv(ji,jj) * pp_k * pp_C ) / ( z_gamma(ji,jj) * psrho(ji,jj) * pp_cw * pp_h * pp_v )
+            ELSE
+               z_lamda(ji,jj) = 0.
+            ENDIF
+
+
+
+            ! Calculate the cool skin thickness - only when heat flux is out of the ocean
+            IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 .AND. psqflux(ji,jj) < 0 ) THEN
+                x_csthick(ji,jj) = ( z_lamda(ji,jj) * pp_v ) / z_fv(ji,jj)
+            ELSE
+                x_csthick(ji,jj) = 0.
+            ENDIF
+
+
+
+            ! Calculate the cool skin correction - only when the heat flux is out of the ocean
+            IF( tmask(ji,jj,1) == 1. .AND. x_csthick(ji,jj) /= 0. .AND. psqflux(ji,jj) < 0. ) THEN
+               x_csdsst(ji,jj) = ( psqflux(ji,jj) * x_csthick(ji,jj) ) / pp_k
+             ELSE
+               x_csdsst(ji,jj) = 0.
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE diurnal_sst_coolskin_step
+
+
+END MODULE cool_skin
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIU/diurnal_bulk.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIU/diurnal_bulk.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIU/diurnal_bulk.F90	(revision 6808)
@@ -0,0 +1,297 @@
+MODULE diurnal_bulk
+   !!======================================================================
+   !!                    ***  MODULE  diurnal_bulk  ***
+   !!     Takaya model of diurnal warming (Takaya, 2010)
+   !!=====================================================================
+   !! History :        !  11-10  (J. While)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   diurnal_sst_bulk_init  : initialise diurnal model
+   !!   diurnal_sst_bulk_step  : time-step the diurnal model
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE phycst
+   USE dom_oce
+   USE lib_mpp
+   USE solfrac_mod
+   USE in_out_manager
+   
+   IMPLICIT NONE
+   
+   ! Namelist parameters
+   LOGICAL, PUBLIC :: ln_diurnal
+   LOGICAL, PUBLIC :: ln_diurnal_only
+
+   ! Parameters
+   REAL(wp), PRIVATE, PARAMETER :: pp_alpha = 2.0e-4_wp
+   REAL(wp), PRIVATE, PARAMETER :: pp_veltol = 0._wp
+   REAL(wp), PRIVATE, PARAMETER :: pp_min_fvel = 1.e-10_wp 
+   
+   ! Key variables
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_dsst     ! Delta SST
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_solfrac  ! Fraction of 
+   !                                                           ! absorbed radiation
+
+   PRIVATE
+   PUBLIC diurnal_sst_bulk_init, diurnal_sst_takaya_step
+   
+   CONTAINS 
+   
+   SUBROUTINE diurnal_sst_bulk_init
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_init ***
+      !!
+      !! ** Purpose : Initialise the Takaya diurnal model
+      
+      !!----------------------------------------------------------------------
+      
+      IMPLICIT NONE
+      
+      INTEGER :: ios
+      
+      NAMELIST /namdiu/ ln_diurnal, ln_diurnal_only
+      
+      ! Read the namelist
+      REWIND( numnam_ref )
+      READ( numnam_ref, namdiu, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdiu in reference namelist', lwp )
+      REWIND( numnam_cfg )
+      READ( numnam_cfg, namdiu, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdiu in configuration namelist', lwp )      
+      
+      IF ( ln_diurnal_only .AND. ( .NOT. ln_diurnal ) ) THEN
+         CALL ctl_stop( "ln_diurnal_only set, but ln_diurnal = FALSE !" )
+      ENDIF
+      
+      IF ( ln_diurnal ) THEN      
+         
+         ! Allocate arrays
+         ALLOCATE( x_dsst(jpi,jpj), x_solfrac(jpi,jpj) )
+         
+         ! Initialise the solar fraction
+         x_solfrac = 0._wp
+         x_dsst = 0._wp
+
+         IF ( ln_diurnal_only ) THEN
+            CALL ctl_warn( "ln_diurnal_only set; only the diurnal component of SST will be calculated" )
+         ENDIF
+      ENDIF
+      
+   END SUBROUTINE diurnal_sst_bulk_init
+   
+   SUBROUTINE diurnal_sst_takaya_step(kt, psolflux, pqflux, ptauflux, prho, p_rdt,&
+            &                  pla, pthick, pcoolthick, pmu, &
+            &                  p_fvel_bkginc, p_hflux_bkginc)
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_takaya_step ***
+      !!
+      !! ** Purpose :   Time-step the Takaya diurnal model
+      !!
+      !! ** Method :    1) Calculate the Obukhov length
+      !!                2) Calculate the Similarity function
+      !!                2) Calculate the increment to dsst
+      !!                3) Apply the increment
+      !! ** Reference : Refinements to a prognostic scheme of skin sea surface
+      !!                temperature, Takaya et al, JGR, 2010 
+      !!----------------------------------------------------------------------
+      
+      IMPLICIT NONE
+      
+      ! Dummy variables
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psolflux  ! solar flux (Watts)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pqflux    ! heat (non-solar) 
+      !                                                     ! flux (Watts)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: ptauflux  ! wind stress 
+      !                                                     ! (kg/ m s^2)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: prho      ! water density 
+      !                                                     ! (kg/m^3)
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pLa    
+      !                                                     ! Langmuir number
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pthick 
+      !                                                     ! warm layer thickness (m)
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pcoolthick 
+      !                                                     ! cool skin thickness (m)
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pmu    
+      !                                                     ! mu parameter
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: p_hflux_bkginc  
+      !                                                     ! optional increment to the
+      !                                                     ! heat flux
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: p_fvel_bkginc  
+      !                                                     ! optional increment to the
+      !                                                     ! friction velocity
+      REAL(wp), INTENT(IN) :: p_rdt                         ! time-step
+      
+      ! Local variables 
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fvel              ! friction velocity     
+      REAL(wp), DIMENSION(jpi,jpj) :: zthick, zcoolthick, zmu, zla
+      REAL(wp), DIMENSION(jpi,jpj) :: z_abflux            ! absorbed flux           
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fla               ! Langmuir function value 
+      
+      LOGICAL  :: ll_calcfrac
+      
+      INTEGER :: ji,jj
+      INTEGER, INTENT(IN) :: kt                           ! time step
+
+      ! Set optional arguments to their defaults
+      IF ( .NOT. PRESENT(pthick) ) THEN 
+         zthick(:,:) = 3._wp
+      ELSE
+         zthick(:,:) = pthick(:,:)
+      ENDIF
+      IF ( .NOT. PRESENT(pcoolthick) ) THEN 
+         zcoolthick(:,:) = 0._wp
+      ELSE
+         zcoolthick(:,:) = pcoolthick(:,:)
+      ENDIF
+      IF ( .NOT. PRESENT(pmu) ) THEN
+         zmu(:,:) = 0.3_wp
+      ELSE
+         zmu(:,:) = pmu(:,:)
+      ENDIF
+      IF ( .NOT. PRESENT(pla) ) THEN
+         zla(:,:) = 0.3_wp
+      ELSE
+         zla(:,:) = pla(:,:)
+      ENDIF
+      
+      ! If not done already, calculate the solar fraction
+      IF ( kt==nit000 ) THEN
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               IF(  ( x_solfrac(ji,jj) == 0._wp ) .AND. ( tmask(ji,jj,1) == 1._wp ) ) &
+               &   x_solfrac(ji,jj) = solfrac( zcoolthick(ji,jj),zthick(ji,jj) )
+            END DO
+         END DO   
+      ENDIF   
+
+      ! convert solar flux and heat flux to absorbed flux   
+      WHERE ( tmask(:,:,1) == 1._wp) 
+         z_abflux(:,:) = (  x_solfrac(:,:) *  psolflux (:,:)) + pqflux(:,:)     
+      ELSEWHERE
+         z_abflux(:,:) = 0._wp
+      ENDWHERE
+      IF( PRESENT(p_hflux_bkginc) ) z_abflux(:,:) = z_abflux(:,:) + p_hflux_bkginc   ! Optional increment
+      WHERE ( ABS( z_abflux(:,:) ) < rsmall )
+         z_abflux(:,:) = rsmall
+      ENDWHERE 
+      
+      ! Calculate the friction velocity
+      WHERE ( (ptauflux /= 0) .AND. ( tmask(:,:,1) == 1.) )   
+         z_fvel(:,:) = SQRT( ptauflux(:,:) / prho(:,:) )
+      ELSEWHERE
+         z_fvel(:,:) = 0._wp
+      ENDWHERE
+      IF( PRESENT(p_fvel_bkginc) ) z_fvel(:,:) = z_fvel(:,:) + p_fvel_bkginc   ! Optional increment
+      
+       
+       
+      ! Calculate the Langmuir function value
+      WHERE ( tmask(:,:,1) == 1.)
+         z_fla(:,:) = MAX( 1._wp, zla(:,:)**( -2._wp / 3._wp ) )  
+      ELSEWHERE
+         z_fla(:,:) = 0._wp
+      ENDWHERE     
+      
+      ! Increment the temperature using the implicit solution
+      x_dsst(:,:) = t_imp( x_dsst(:,:), p_rdt, z_abflux(:,:), z_fvel(:,:), &
+                                 z_fla(:,:), zmu(:,:), zthick(:,:), prho(:,:))
+      
+                                
+      
+   END SUBROUTINE diurnal_sst_takaya_step
+
+   
+   FUNCTION t_imp(p_dsst, p_rdt, p_abflux, p_fvel, &
+                          p_fla, pmu, pthick, prho )
+                          
+      IMPLICIT NONE
+      
+      ! Function definition
+      REAL(wp), DIMENSION(jpi,jpj) :: t_imp
+      ! Dummy variables
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_dsst     ! Delta SST
+      REAL(wp), INTENT(IN)                     :: p_rdt      ! Time-step
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_abflux   ! Heat forcing
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fvel     ! Friction velocity
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fla      ! Langmuir number
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pmu        ! Structure parameter
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pthick     ! Layer thickness
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: prho       ! Water density
+   
+      ! Local variables
+      REAL(wp) :: z_olength          ! Obukhov length
+      REAL(wp) :: z_sigma, z_sigma2
+      REAL(wp) :: z_term1, z_term2     
+      REAL(wp) :: z_stabfunc         ! stability function value
+      REAL(wp) :: z_fvel      
+      
+      CHARACTER(200) :: warn_string
+       
+      INTEGER :: ji,jj
+                     
+      DO jj = 1, jpj
+         DO ji = 1, jpi   
+            
+            ! Only calculate outside tmask
+            IF ( tmask(ji,jj,1) /= 1._wp ) THEN
+               t_imp(ji,jj) = 0._wp
+               CYCLE   
+            END IF
+            
+            IF (p_fvel(ji,jj) < pp_min_fvel) THEN
+               z_fvel = pp_min_fvel
+               WRITE(warn_string,*) "diurnal_sst_takaya step: "&
+               &//"friction velocity < minimum\n" &
+               &//"Setting friction velocity =",pp_min_fvel
+               CALL ctl_warn(warn_string)
+               
+            ELSE
+               z_fvel = p_fvel(ji,jj)
+            ENDIF
+                 
+            ! Calculate the Obukhov length
+            IF ( (z_fvel < pp_veltol ) .AND. &
+            &    (p_dsst(ji,jj) > 0._wp) ) THEN
+               z_olength =  z_fvel  / &
+               &     SQRT( p_dsst(ji,jj) * vkarmn * grav * &
+               &             pp_alpha / ( 5._wp * pthick(ji,jj) ) )
+            ELSE
+               z_olength = &
+               &   ( prho(ji,jj) * rcp * z_fvel**3._wp ) / &
+               &   ( vkarmn * grav * pp_alpha *&
+               &     p_abflux(ji,jj) )
+            ENDIF
+             
+            ! Calculate the stability function          
+            z_sigma = pthick(ji,jj) / z_olength
+            z_sigma2 = z_sigma * z_sigma
+  
+            IF ( z_sigma >= 0. ) THEN
+               z_stabfunc = 1._wp + &
+               &  ( ( 5._wp * z_sigma + 4._wp * z_sigma2 ) / &
+               &  ( 1._wp + 3._wp * z_sigma + 0.25_wp * &
+               &    z_sigma2 ) )
+            ELSE
+               z_stabfunc = 1._wp / &
+               &                   SQRT( 1._wp - 16._wp * z_sigma )
+            ENDIF
+
+            ! Calculate the T increment
+            z_term1 = ( p_abflux(ji,jj) * ( pmu(ji,jj) + 1._wp)  / &
+            & ( pmu(ji,jj) * pthick(ji,jj) * prho(ji,jj) * rcp ) )
+            
+             
+            z_term2 = -( ( pmu(ji,jj) + 1._wp) * &
+            &                       ( vkarmn * z_fvel * p_fla(ji,jj) ) / &
+            &      ( pthick(ji,jj) * z_stabfunc ) )     
+          
+            t_imp(ji,jj) = ( p_dsst(ji,jj) + p_rdt * z_term1 ) / &
+                           ( 1._wp - p_rdt * z_term2 )
+
+         END DO
+      END DO
+      
+      END FUNCTION t_imp
+
+END MODULE diurnal_bulk
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIU/solfrac_mod.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIU/solfrac_mod.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIU/solfrac_mod.F90	(revision 6808)
@@ -0,0 +1,56 @@
+MODULE solfrac_mod
+   !!======================================================================
+   !!                    ***  MODULE  solfrac  ***
+   !!     POSH representation of solar absorption (Gntermann, 2009)
+   !!=====================================================================
+   !! History :        !  11-10  (J. While)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   solfrac  : function to calculate the solar fraction
+   !!----------------------------------------------------------------------
+   
+   USE par_kind
+   IMPLICIT NONE
+     
+   ! Parameters 
+   REAL(wp), PRIVATE, PARAMETER, DIMENSION(9) :: &
+   &                                     pp_wgt = (/0.2370, 0.36,  0.1790, &
+   &                                                0.087,  0.08,  0.025,  &
+   &                                                0.025,  0.007, 0.0004/)
+   REAL(wp), PRIVATE, PARAMETER, DIMENSION(9) :: &
+   &                                    pp_len = (/34.84,   2.266,   0.0315,  &
+   &                                               0.0055,  8.32e-4, 1.26e-4, &
+   &                                                3.13e-4, 7.82e-4, 1.44e-5/)
+   
+   PUBLIC solfrac
+                                                   
+CONTAINS
+
+   REAL(dp) FUNCTION solfrac(ptop,pbottom)
+       !!----------------------------------------------------------------------
+      !! *** ROUTINE solfrac ***
+      !!
+      !! ** Purpose :   Calculate the solar fraction absorbed between two 
+      !!                layers
+      !!
+      !! ** Reference : POSH a model of diurnal warming, Gentemann et al, 
+      !!                 JGR, 2009 
+      !!----------------------------------------------------------------------
+      
+      ! Dummy variabes
+      REAL(wp), INTENT(IN) :: ptop, pbottom   ! Top and bottom of layer
+      
+      ! local variables
+      INTEGER :: jt
+      
+      ! Calculate the solar fraction absorbed between the two layers
+      solfrac = 0._wp
+      DO jt = 1, 9
+           solfrac = solfrac + pp_wgt(jt) * ( exp ( -ptop / pp_len(jt) ) &
+            &                                 - exp ( -pbottom / pp_len(jt) ) )
+      END DO
+      
+   END FUNCTION
+   
+END MODULE solfrac_mod
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIU/step_diu.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIU/step_diu.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DIU/step_diu.F90	(revision 6808)
@@ -0,0 +1,96 @@
+MODULE step_diu
+   !!======================================================================
+   !!                       ***  MODULE stp_diu  ***
+   !! Time-stepping of diurnal cycle models
+   !!======================================================================
+   !! History :  3.7  ! 2015-11  (J. While)  Original code
+
+   USE diurnal_bulk    ! diurnal SST bulk routines  (diurnal_sst_takaya routine) 
+   USE cool_skin       ! diurnal cool skin correction (diurnal_sst_coolskin routine)   
+   USE iom
+   USE sbc_oce
+   USE sbcmod           ! surface boundary condition       (sbc     routine)
+   USE diaobs           ! Observation operator
+   USE oce
+   USE daymod
+   USE restart          ! ocean restart                    (rst_wri routine)
+   USE timing           ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   stp_diurnal   ! called by nemogcm.F90 or step.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id:$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   CONTAINS
+
+   SUBROUTINE stp_diurnal( kstp ) 
+      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index 
+      !!---------------------------------------------------------------------- 
+      !!                     ***  ROUTINE stp_diurnal  *** 
+      !!                       
+      !! ** Purpose : - Time stepping of diurnal SST model only 
+      !!   
+      !! ** Method  : -1- Update forcings and data   
+      !!              -2- Update ocean physics   
+      !!              -3- Compute the t and s trends   
+      !!              -4- Update t and s   
+      !!              -5- Compute the momentum trends 
+      !!              -6- Update the horizontal velocity 
+      !!              -7- Compute the diagnostics variables (rd,N2, div,cur,w) 
+      !!              -8- Outputs and diagnostics 
+      !!---------------------------------------------------------------------- 
+      INTEGER ::   jk       ! dummy loop indices
+      INTEGER ::   indic    ! error indicator if < 0 
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fvel_bkginc, z_hflux_bkginc     
+      !! --------------------------------------------------------------------- 
+      
+      IF(ln_diurnal_only) THEN
+         indic = 0                                 ! reset to no error condition 
+         IF( kstp /= nit000 )   CALL day( kstp )   ! Calendar (day was already called at nit000 in day_init) 
+ 
+         CALL iom_setkt( kstp - nit000 + 1, cxios_context )   ! tell iom we are at time step kstp
+         IF( ln_crs ) THEN
+            CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" ) ! tell iom we are at time step kstp
+         ENDIF
+       
+            CALL sbc    ( kstp )                      ! Sea Boundary Conditions 
+      ENDIF
+     
+      ! Cool skin
+      IF ( .NOT.ln_diurnal ) CALL ctl_stop(  "stp_diurnal: ln_diurnal not set"  )
+         
+      IF ( .NOT. ln_blk_core ) THEN
+         CALL ctl_stop("step.f90: diurnal flux processing only implemented"//&
+         &             " for core forcing") 
+      ENDIF
+
+      CALL diurnal_sst_coolskin_step( qns, taum, rhop(:,:,1), rdt)
+
+      CALL iom_put( "sst_wl"   , x_dsst               )    ! warm layer (write out before update below).
+      CALL iom_put( "sst_cs"   , x_csdsst             )    ! cool skin
+
+      ! Diurnal warm layer model       
+      CALL diurnal_sst_takaya_step( kstp, & 
+      &    qsr, qns, taum, rhop(:,:,1), rdt) 
+
+      IF(ln_diurnal_only) THEN
+         IF( ln_diaobs )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
+     
+         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
+         ! Control and restarts 
+         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
+         IF( kstp == nit000   )   CALL iom_close( numror )     ! close input  ocean restart file 
+         IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file
+     
+         IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset 
+      ENDIF
+       
+   END SUBROUTINE stp_diurnal  
+   
+END MODULE step_diu
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90	(revision 6808)
@@ -71,19 +71,19 @@
       !!                                   =2 put at location runoff
       !!----------------------------------------------------------------------
-      INTEGER ::   jc            ! dummy loop indices
-      INTEGER :: isrow           ! local index
-      !!----------------------------------------------------------------------
-      
+      INTEGER ::   jc      ! dummy loop indices
+      INTEGER ::   isrow   ! local index
+      !!----------------------------------------------------------------------
+      !
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*)'dom_clo : closed seas '
       IF(lwp) WRITE(numout,*)'~~~~~~~'
-
+      !
       ! initial values
       ncsnr(:) = 1  ;  ncsi1(:) = 1  ;  ncsi2(:) = 1  ;  ncsir(:,:) = 1
       ncstt(:) = 0  ;  ncsj1(:) = 1  ;  ncsj2(:) = 1  ;  ncsjr(:,:) = 1
-
+      !
       ! set the closed seas (in data domain indices)
       ! -------------------
-
+      !
       IF( cp_cfg == "orca" ) THEN
          !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 6808)
@@ -11,4 +11,5 @@
    !!                 ! 2004-01  (A.M. Treguier) new calculation based on adatrj
    !!                 ! 2006-08  (G. Madec)  surface module major update
+   !!                 ! 2015-11  (D. Lea) Allow non-zero initial time of day
    !!----------------------------------------------------------------------
 
@@ -20,5 +21,5 @@
    !!
    !!   we suppose that the time step is deviding the number of second of in a day
-   !!             ---> MOD( rday, rdttra(1) ) == 0
+   !!             ---> MOD( rday, rdt ) == 0
    !!
    !!           ----------- WARNING -----------
@@ -26,13 +27,13 @@
    !!
    !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE in_out_manager  ! I/O manager
-   USE iom             !
-   USE ioipsl, ONLY :   ymds2ju   ! for calendar
-   USE prtctl          ! Print control
-   USE trc_oce, ONLY : lk_offline ! offline flag
-   USE timing          ! Timing
-   USE restart         ! restart
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE in_out_manager ! I/O manager
+   USE iom            !
+   USE ioipsl  , ONLY :   ymds2ju   ! for calendar
+   USE prtctl         ! Print control
+   USE trc_oce , ONLY : lk_offline ! offline flag
+   USE timing         ! Timing
+   USE restart        ! restart
 
    IMPLICIT NONE
@@ -43,5 +44,5 @@
    PUBLIC   day_mth    ! Needed by TAM
 
-   INTEGER, PUBLIC ::   nsecd, nsecd05, ndt, ndt05 ! (PUBLIC for TAM)
+   INTEGER, PUBLIC ::   nsecd, nsecd05, ndt, ndt05   !: (PUBLIC for TAM)
 
    !!----------------------------------------------------------------------
@@ -73,12 +74,17 @@
       !!----------------------------------------------------------------------
       !
-      ! 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' )
-      IF( MOD( rday     , 2.        ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    )
-      IF( MOD( rdttra(1), 2.        ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           )
-      nsecd   = NINT(rday           )
-      nsecd05 = NINT(0.5 * rday     )
-      ndt     = NINT(      rdttra(1))
-      ndt05   = NINT(0.5 * rdttra(1))
+      ! 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, rdt ) == 0
+      IF( MOD( rday     , rdt   ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
+      IF( MOD( rday     , 2.    ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    )
+      IF( MOD( rdt      , 2.    ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           )
+      nsecd   = NINT(rday       )
+      nsecd05 = NINT(0.5 * rday )
+      ndt     = NINT(      rdt  )
+      ndt05   = NINT(0.5 * rdt  )
 
       IF( .NOT. lk_offline ) CALL day_rst( nit000, 'READ' )
@@ -90,7 +96,10 @@
       nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 )
 
-      CALL ymds2ju( nyear, nmonth, nday, 0.0, fjulday )  ! we assume that we start run at 00:00
+      nhour   =   nn_time0 / 100
+      nminute = ( nn_time0 - nhour * 100 )
+
+      CALL ymds2ju( nyear, nmonth, nday, nhour*3600._wp+nminute*60._wp, fjulday )  
       IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
-      fjulday = fjulday + 1.                             ! move back to the day at nit000 (and not at nit000 - 1)
+      IF( nn_time0*3600 - ndt05 .lt. 0 ) fjulday = fjulday + 1.                    ! move back to the day at nit000 (and not at nit000 - 1)
 
       nsec1jan000 = 0
@@ -113,16 +122,27 @@
       !compute number of days between last monday and today
       CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (our reference that was a Monday)
-      inbday = NINT(fjulday - zjul)            ! compute nb day between  01.01.1900 and current day
+      inbday = FLOOR(fjulday - zjul)            ! compute nb day between  01.01.1900 and start of current day
       idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day
+      IF (idweek .lt. 0) idweek=idweek+7       ! Avoid negative values for dates before 01.01.1900
 
       ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step
-      nsec_year  = nday_year * nsecd - ndt05   ! 1 time step before the middle of the first time step
-      nsec_month = nday      * nsecd - ndt05   ! because day will be called at the beginning of step
-      nsec_week  = idweek    * nsecd - ndt05
-      nsec_day   =             nsecd - ndt05
+      IF (nhour*3600+nminute*60-ndt05 .gt. 0) THEN
+         ! 1 timestep before current middle of first time step is still the same day
+         nsec_year  = (nday_year-1) * nsecd + nhour*3600+nminute*60 - ndt05 
+         nsec_month = (nday-1)      * nsecd + nhour*3600+nminute*60 - ndt05    
+      ELSE
+         ! 1 time step before the middle of the first time step is the previous day 
+         nsec_year  = nday_year * nsecd + nhour*3600+nminute*60 - ndt05 
+         nsec_month = nday      * nsecd + nhour*3600+nminute*60 - ndt05   
+      ENDIF
+      nsec_week  = idweek    * nsecd + nhour*3600+nminute*60 - ndt05
+      nsec_day   =             nhour*3600+nminute*60 - ndt05 
+      IF( nsec_day .lt. 0 ) nsec_day = nsec_day + nsecd
+      IF( nsec_week .lt. 0 ) nsec_week = nsec_week + nsecd*7
 
       ! control print
-      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
-           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week
+      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
+           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week, '  &
+           &                   nsec_month:', nsec_month , '  nsec_year:' , nsec_year
 
       ! Up to now, calendar parameters are related to the end of previous run (nit000-1)
@@ -218,6 +238,6 @@
       nsec_week  = nsec_week  + ndt
       nsec_day   = nsec_day   + ndt
-      adatrj  = adatrj  + rdttra(1) / rday
-      fjulday = fjulday + rdttra(1) / rday
+      adatrj  = adatrj  + rdt / rday
+      fjulday = fjulday + rdt / rday
       IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
       IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
@@ -238,9 +258,4 @@
                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
@@ -302,5 +317,6 @@
       CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
       !
-      REAL(wp) ::   zkt, zndastp
+      REAL(wp) ::   zkt, zndastp, zdayfrac, ksecs, ktime
+      INTEGER  ::   ihour, iminute
       !!----------------------------------------------------------------------
 
@@ -327,18 +343,48 @@
             ! define ndastp and adatrj
             IF ( nrstdt == 2 ) THEN
-               ! read the parameters correspondting to nit000 - 1 (last time step of previous run)
+               ! read the parameters corresponding to nit000 - 1 (last time step of previous run)
                CALL iom_get( numror, 'ndastp', zndastp )
                ndastp = NINT( zndastp )
                CALL iom_get( numror, 'adatrj', adatrj  )
+	       CALL iom_get( numror, 'ntime', ktime )
+	       nn_time0=INT(ktime)
+               ! calculate start time in hours and minutes
+	       zdayfrac=adatrj-INT(adatrj)
+	       ksecs = NINT(zdayfrac*86400)	       ! Nearest second to catch rounding errors in adatrj	       
+	       ihour = INT(ksecs/3600)
+	       iminute = ksecs/60-ihour*60
+ 	        
+               ! Add to nn_time0
+               nhour   =   nn_time0 / 100
+               nminute = ( nn_time0 - nhour * 100 )
+	       nminute=nminute+iminute
+	       
+	       IF( nminute >= 60 ) THEN
+	          nminute=nminute-60
+		  nhour=nhour+1
+	       ENDIF
+	       nhour=nhour+ihour
+	       IF( nhour >= 24 ) THEN
+		  nhour=nhour-24
+	          adatrj=adatrj+1
+	       ENDIF	       
+	       nn_time0 = nhour * 100 + nminute
+	       adatrj = INT(adatrj)                    ! adatrj set to integer as nn_time0 updated	       
             ELSE
-               ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
-               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
-               adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+               ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
+               ndastp = ndate0        ! ndate0 read in the namelist in dom_nam
+               nhour   =   nn_time0 / 100
+               nminute = ( nn_time0 - nhour * 100 )
+               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
+               adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
                ! note this is wrong if time step has changed during run
             ENDIF
          ELSE
-            ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
-            ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
-            adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+            ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
+            ndastp = ndate0           ! ndate0 read in the namelist in dom_nam
+            nhour   =   nn_time0 / 100
+	    nminute = ( nn_time0 - nhour * 100 )
+            IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
+            adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
          ENDIF
          IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
@@ -348,4 +394,5 @@
             WRITE(numout,*) '   date ndastp                                      : ', ndastp
             WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
+	    WRITE(numout,*) '   nn_time0                                         : ',nn_time0
             WRITE(numout,*)
          ENDIF
@@ -363,4 +410,5 @@
          CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since
          !                                                                     ! the begining of the run [s]
+	 CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time
       ENDIF
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 6808)
@@ -7,7 +7,9 @@
    !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate 
    !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
-   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.4  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
    !!            3.5  ! 2012     (S. Mocavero, I. Epicoco) Add arrays associated
    !!                             to the optimization of BDY communications
+   !!            3.7  ! 2015-11  (G. Madec) introduce surface and scale factor ratio
+   !!             -   ! 2015-11  (G. Madec, A. Coward)  time varying zgr by default
    !!----------------------------------------------------------------------
 
@@ -20,6 +22,5 @@
 
    IMPLICIT NONE
-   PUBLIC             ! allows the acces to par_oce when dom_oce is used
-   !                  ! exception to coding rules... to be suppressed ???
+   PUBLIC             ! allows the acces to par_oce when dom_oce is used (exception to coding rules)
 
    PUBLIC dom_oce_alloc  ! Called from nemogcm.F90
@@ -32,16 +33,19 @@
    REAL(wp), PUBLIC ::   rn_bathy        !: depth of flat bottom (active if nn_bathy=0; if =0 depth=jpkm1)
    REAL(wp), PUBLIC ::   rn_hmin         !: minimum ocean depth (>0) or minimum number of ocean levels (<0)
+   REAL(wp), PUBLIC ::   rn_isfhmin      !: threshold to discriminate grounded ice to floating ice
    REAL(wp), PUBLIC ::   rn_e3zps_min    !: miminum thickness for partial steps (meters)
    REAL(wp), PUBLIC ::   rn_e3zps_rat    !: minimum thickness ration for partial steps
    INTEGER , PUBLIC ::   nn_msh          !: = 1 create a mesh-mask file
-   INTEGER , PUBLIC ::   nn_acc          !: = 0/1 use of the acceleration of convergence technique
    REAL(wp), PUBLIC ::   rn_atfp         !: asselin time filter parameter
-   REAL(wp), PUBLIC ::   rn_rdt          !: time step for the dynamics (and tracer if nacc=0)
-   REAL(wp), PUBLIC ::   rn_rdtmin       !: minimum time step on tracers
-   REAL(wp), PUBLIC ::   rn_rdtmax       !: maximum time step on tracers
-   REAL(wp), PUBLIC ::   rn_rdth         !: depth variation of tracer step
+   REAL(wp), PUBLIC ::   rn_rdt          !: time step for the dynamics and tracer
    INTEGER , PUBLIC ::   nn_closea       !: =0 suppress closed sea/lake from the ORCA domain or not (=1)
    INTEGER , PUBLIC ::   nn_euler        !: =0 start with forward time step or not (=1)
+   LOGICAL , PUBLIC ::   ln_iscpl       !: coupling with ice sheet
    LOGICAL , PUBLIC ::   ln_crs          !: Apply grid coarsening to dynamical model output or online passive tracers
+
+   !! Free surface parameters
+   !! =======================
+   LOGICAL , PUBLIC :: ln_dynspg_exp     !: Explicit free surface flag
+   LOGICAL , PUBLIC :: ln_dynspg_ts      !: Split-Explicit free surface flag
 
    !! Time splitting parameters
@@ -49,12 +53,12 @@
    LOGICAL,  PUBLIC :: ln_bt_fw          !: Forward integration of barotropic sub-stepping
    LOGICAL,  PUBLIC :: ln_bt_av          !: Time averaging of barotropic variables
-   LOGICAL,  PUBLIC :: ln_bt_nn_auto     !: Set number of barotropic iterations automatically
+   LOGICAL,  PUBLIC :: ln_bt_auto        !: Set number of barotropic iterations automatically
    INTEGER,  PUBLIC :: nn_bt_flt         !: Filter choice
    INTEGER,  PUBLIC :: nn_baro           !: Number of barotropic iterations during one baroclinic step (rdt)
-   REAL(wp), PUBLIC :: rn_bt_cmax        !: Maximum allowed courant number (used if ln_bt_nn_auto=T)
+   REAL(wp), PUBLIC :: rn_bt_cmax        !: Maximum allowed courant number (used if ln_bt_auto=T)
 
    !! Horizontal grid parameters for domhgr
    !! =====================================
-   INTEGER       ::   jphgr_msh        !: type of horizontal mesh
+   INTEGER       ::   jphgr_msh          !: type of horizontal mesh
    !                                       !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
    !                                       !  = 1 geographical mesh on the sphere with regular grid-spacing
@@ -63,29 +67,29 @@
    !                                       !  = 4 Mercator grid with T/U point at the equator
 
-   REAL(wp)      ::   ppglam0              !: longitude of first raw and column T-point (jphgr_msh = 1)
-   REAL(wp)      ::   ppgphi0              !: latitude  of first raw and column T-point (jphgr_msh = 1)
+   REAL(wp)      ::   ppglam0            !: longitude of first raw and column T-point (jphgr_msh = 1)
+   REAL(wp)      ::   ppgphi0            !: latitude  of first raw and column T-point (jphgr_msh = 1)
    !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3)
-   REAL(wp)      ::   ppe1_deg             !: zonal      grid-spacing (degrees)
-   REAL(wp)      ::   ppe2_deg             !: meridional grid-spacing (degrees)
-   REAL(wp)      ::   ppe1_m               !: zonal      grid-spacing (degrees)
-   REAL(wp)      ::   ppe2_m               !: meridional grid-spacing (degrees)
+   REAL(wp)      ::   ppe1_deg           !: zonal      grid-spacing (degrees)
+   REAL(wp)      ::   ppe2_deg           !: meridional grid-spacing (degrees)
+   REAL(wp)      ::   ppe1_m             !: zonal      grid-spacing (degrees)
+   REAL(wp)      ::   ppe2_m             !: meridional grid-spacing (degrees)
 
    !! Vertical grid parameter for domzgr
    !! ==================================
-   REAL(wp)      ::   ppsur                !: ORCA r4, r2 and r05 coefficients
-   REAL(wp)      ::   ppa0                 !: (default coefficients)
-   REAL(wp)      ::   ppa1                 !:
-   REAL(wp)      ::   ppkth                !:
-   REAL(wp)      ::   ppacr                !:
+   REAL(wp)      ::   ppsur              !: ORCA r4, r2 and r05 coefficients
+   REAL(wp)      ::   ppa0               !: (default coefficients)
+   REAL(wp)      ::   ppa1               !:
+   REAL(wp)      ::   ppkth              !:
+   REAL(wp)      ::   ppacr              !:
    !
    !  If both ppa0 ppa1 and ppsur are specified to 0, then
    !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
-   REAL(wp)      ::   ppdzmin              !: Minimum vertical spacing
-   REAL(wp)      ::   pphmax               !: Maximum depth
+   REAL(wp)      ::   ppdzmin            !: Minimum vertical spacing
+   REAL(wp)      ::   pphmax             !: Maximum depth
    !
-   LOGICAL       ::   ldbletanh            !: Use/do not use double tanf function for vertical coordinates
-   REAL(wp)      ::   ppa2                 !: Double tanh function parameters
-   REAL(wp)      ::   ppkth2               !:
-   REAL(wp)      ::   ppacr2               !:
+   LOGICAL       ::   ldbletanh          !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp)      ::   ppa2               !: Double tanh function parameters
+   REAL(wp)      ::   ppkth2             !:
+   REAL(wp)      ::   ppacr2             !:
 
    !                                    !! old non-DOCTOR names still used in the model
@@ -94,19 +98,11 @@
    REAL(wp), PUBLIC ::   e3zps_rat       !: minimum thickness ration for partial steps
    INTEGER , PUBLIC ::   nmsh            !: = 1 create a mesh-mask file
-   INTEGER , PUBLIC ::   nacc            !: = 0/1 use of the acceleration of convergence technique
    REAL(wp), PUBLIC ::   atfp            !: asselin time filter parameter
-   REAL(wp), PUBLIC ::   rdt             !: time step for the dynamics (and tracer if nacc=0)
-   REAL(wp), PUBLIC ::   rdtmin          !: minimum time step on tracers
-   REAL(wp), PUBLIC ::   rdtmax          !: maximum time step on tracers
-   REAL(wp), PUBLIC ::   rdth            !: depth variation of tracer step
+   REAL(wp), PUBLIC ::   rdt             !: time step for the dynamics and tracer
 
    !                                                  !!! associated variables
    INTEGER , PUBLIC                 ::   neuler        !: restart euler forward option (0=Euler)
    REAL(wp), PUBLIC                 ::   atfp1         !: asselin time filter coeff. (atfp1= 1-2*atfp)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdttra  !: vertical profile of tracer time step
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dtra  !: = 2*rdttra except at nit000 (=rdttra) if neuler=0
-
-   !                                         !!* Namelist namcla : cross land advection
-   INTEGER, PUBLIC ::   nn_cla               !: =1 cross land advection for exchanges through some straits (ORCA2)
+   REAL(wp), PUBLIC                 ::   r2dt          !: = 2*rdt except at nit000 (=rdt) if neuler=0
 
    !!----------------------------------------------------------------------
@@ -158,73 +154,54 @@
    !! horizontal curvilinear coordinate and scale factors
    !! ---------------------------------------------------------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamt, glamu   !: longitude of t-, u-, v- and f-points (degre)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamv, glamf   !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphit, gphiu   !: latitude  of t-, u-, v- and f-points (degre)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphiv, gphif   !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1t, e2t, r1_e1t, r1_e2t   !: horizontal scale factors and inverse at t-point (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1u, e2u, r1_e1u, r1_e2u   !: horizontal scale factors and inverse at u-point (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1v, e2v, r1_e1v, r1_e2v   !: horizontal scale factors and inverse at v-point (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1f, e2f, r1_e1f, r1_e2f   !: horizontal scale factors and inverse at f-point (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1e2t          !: surface at t-point (m2)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ff             !: coriolis factor (2.*omega*sin(yphi) ) (s-1)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   glamt , glamu, glamv , glamf    !: longitude at t, u, v, f-points [degree]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gphit , gphiu, gphiv , gphif    !: latitude  at t, u, v, f-points [degree]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1t   , e2t  , r1_e1t, r1_e2t   !: t-point horizontal scale factors    [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1u   , e2u  , r1_e1u, r1_e2u   !: horizontal scale factors at u-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1v   , e2v  , r1_e1v, r1_e2v   !: horizontal scale factors at v-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff                              !: coriolis factor                   [1/s]
 
    !!----------------------------------------------------------------------
    !! vertical coordinate and scale factors
    !! ---------------------------------------------------------------------
-   !                                 !!* Namelist namzgr : vertical coordinate *
-   LOGICAL, PUBLIC ::   ln_zco        !: z-coordinate - full step
-   LOGICAL, PUBLIC ::   ln_zps        !: z-coordinate - partial step
-   LOGICAL, PUBLIC ::   ln_sco        !: s-coordinate or hybrid z-s coordinate
-   LOGICAL, PUBLIC ::   ln_isfcav     !: presence of ISF 
-
-   !! All coordinates
-   !! ---------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdep3w_0           !: depth of t-points (sum of e3w) (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0, gdepw_0   !: analytical (time invariant) depth at t-w  points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3v_0  , e3f_0     !: analytical (time invariant) vertical scale factors at  v-f
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_0  , e3u_0     !:                                      t-u  points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3vw_0             !: analytical (time invariant) vertical scale factors at  vw
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w_0  , e3uw_0    !:                                      w-uw points (m)
-#if defined key_vvl
-   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .TRUE.    !: variable grid flag
-
-   !! All coordinates
-   !! ---------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdep3w_n           !: now depth of T-points (sum of e3w) (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_n, gdepw_n   !: now depth at T-W  points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_b, gdepw_b   !: before depth at T-W  points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_n              !: now    vertical scale factors at  t       point  (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3u_n  , e3v_n     !:            -      -      -    -   u --v   points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w_n  , e3f_n     !:            -      -      -    -   w --f   points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3uw_n , e3vw_n    !:            -      -      -    -   uw--vw  points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_b              !: before     -      -      -    -   t       points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w_b              !: before     -      -      -    -   t       points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3u_b  , e3v_b     !:   -        -      -      -    -   u --v   points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3uw_b , e3vw_b    !:   -        -      -      -    -   uw--vw  points (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_a              !: after      -      -      -    -   t       point  (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3u_a  , e3v_a     !:   -        -      -      -    -   u --v   points (m)
-#else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .FALSE.   !: fixed grid flag
-#endif
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hur  , hvr     !: Now    inverse of u and v-points ocean depth (1/m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu   , hv      !:        depth at u- and v-points (meters)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht             !:        depth at t-points (meters)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ehur_a, ehvr_a !: After  inverse of u and v-points ocean depth (1/m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ehu_a , ehv_a  !:        depth at u- and v-points (meters)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ehur_b, ehvr_b !: Before inverse of u and v-points ocean depth (1/m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ehu_b , ehv_b  !:        depth at u- and v-points (meters)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0           !: reference depth at t-       points (meters)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0 , hv_0    !: reference depth at u- and v-points (meters)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   re2u_e1u       !: scale factor coeffs at u points (e2u/e1u)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   re1v_e2v       !: scale factor coeffs at v points (e1v/e2v)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12t , r1_e12t !: horizontal cell surface and inverse at t points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12u , r1_e12u !: horizontal cell surface and inverse at u points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12v , r1_e12v !: horizontal cell surface and inverse at v points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12f , r1_e12f !: horizontal cell surface and inverse at f points
+   !                                !!* Namelist namzgr : vertical coordinate *
+   LOGICAL, PUBLIC ::   ln_zco       !: z-coordinate - full step
+   LOGICAL, PUBLIC ::   ln_zps       !: z-coordinate - partial step
+   LOGICAL, PUBLIC ::   ln_sco       !: s-coordinate or hybrid z-s coordinate
+   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF 
+   LOGICAL, PUBLIC ::   ln_linssh    !: variable grid flag
+
+   !                                                        !  ref.   ! before  !   now   ! after  !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0 ,   e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3u_0 ,   e3u_b ,   e3u_n ,  e3u_a   !: u- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3f_0           ,   e3f_n            !: f- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3w_0 ,   e3w_b ,   e3w_n            !: w- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m]
+
+   !                                                        !  ref.   ! before  !   now   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0 , gdept_b , gdept_n   !: t- depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0 , gdepw_b , gdepw_n   !: w- depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0           , gde3w_n   !: w- depth (sum of e3w) [m]
+   
+   !                                                      !  ref. ! before  !   now   !  after  !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0            ,    ht_n             !: t-depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0  ,    hu_b ,    hu_n ,    hu_a   !: u-depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hv_0  ,    hv_b ,    hv_n ,    hv_a   !: u-depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hu_b , r1_hu_n , r1_hu_a   !: inverse of u-depth [1/m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hv_b , r1_hv_n , r1_hv_a   !: inverse of v-depth [1/m]
+
 
    INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1)
    INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1) 
 
-   !! z-coordinate with full steps (also used in the other cases as reference z-coordinate)
+   !! 1D reference  vertical coordinate
    !! =-----------------====------
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gdept_1d, gdepw_1d !: reference depth of t- and w-points (m)
@@ -232,4 +209,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3tp    , e3wp     !: ocean bottom level thickness at T and W points
 
+!!gm  This should be removed from here....  ==>>> only used in domzgr at initialization phase
    !! s-coordinate and hybrid z-s-coordinate
    !! =----------------======---------------
@@ -245,4 +223,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu       !: and quasi-uniform spacing             t--u points (m)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rx1                !: Maximum grid stiffness ratio
+!!gm end
 
    !!----------------------------------------------------------------------
@@ -252,22 +231,17 @@
    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt               !: vertical index of the bottom last T- ocean level
    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku, mbkv         !: vertical index of the bottom last U- and W- ocean level
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy                              !: ocean depth (meters)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i, umask_i, vmask_i, fmask_i !: interior domain T-point mask
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bmask                              !: land/ocean mask of barotropic stream function
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy              !: ocean depth (meters)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i            !: interior domain T-point mask
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_h            !: internal domain T-point mask (Figure 8.5 NEMO book)
 
    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level                (ISF)
    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: first wet T-, U-, V-, F- ocean level (ISF)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                       (ISF)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask                   !: surface domain T-point mask 
-
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask, ssfmask    !: surface mask at T-,U-, V- and F-pts
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
-
-#if defined key_noslip_accurate
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  )  :: npcoa              !: ???
-   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: nicoa, njcoa       !: ???
-#endif
 
    !!----------------------------------------------------------------------
@@ -277,4 +251,6 @@
    INTEGER , PUBLIC ::   nmonth        !: current month
    INTEGER , PUBLIC ::   nday          !: current day of the month
+   INTEGER , PUBLIC ::   nhour         !: current hour
+   INTEGER , PUBLIC ::   nminute       !: current minute
    INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format
    INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year
@@ -313,5 +289,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -333,9 +309,9 @@
    INTEGER FUNCTION dom_oce_alloc()
       !!----------------------------------------------------------------------
-      INTEGER, DIMENSION(12) :: ierr
+      INTEGER, DIMENSION(13) :: ierr
       !!----------------------------------------------------------------------
       ierr(:) = 0
       !
-      ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj),  &
+      ALLOCATE( mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj),  &
          &      nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) )
          !
@@ -346,35 +322,34 @@
          &      tpol(jpiglo)  , fpol(jpiglo)                               , STAT=ierr(2) )
          !
-      ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,   & 
-         &      glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,   &  
-         &      glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,   &  
-         &      glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,   &
-         &      e1e2t(jpi,jpj) , ff   (jpi,jpj) , STAT=ierr(3) )     
-         !
-      ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) ,                         &
-         &      gdept_0 (jpi,jpj,jpk) , e3t_0(jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) ,                         &
-         &      gdepw_0 (jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , STAT=ierr(4) )
-         !
-#if defined key_vvl
-      ALLOCATE( gdep3w_n(jpi,jpj,jpk) , e3t_n (jpi,jpj,jpk) , e3u_n (jpi,jpj,jpk) ,                           &
-         &      gdept_n (jpi,jpj,jpk) , e3v_n (jpi,jpj,jpk) , e3w_n (jpi,jpj,jpk) ,                           &
-         &      gdepw_n (jpi,jpj,jpk) , e3f_n (jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) , e3uw_n(jpi,jpj,jpk) ,     &
-         &      e3t_b   (jpi,jpj,jpk) , e3u_b (jpi,jpj,jpk) , e3v_b (jpi,jpj,jpk) ,                           &
-         &      e3uw_b  (jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) ,                                                 &
-         &      gdept_b (jpi,jpj,jpk) ,gdepw_b(jpi,jpj,jpk) , e3w_b (jpi,jpj,jpk) ,                           &
-         &      e3t_a   (jpi,jpj,jpk) , e3u_a (jpi,jpj,jpk) , e3v_a (jpi,jpj,jpk) ,                           &
-         &      ehu_a    (jpi,jpj)    , ehv_a  (jpi,jpj),                                                     &
-         &      ehur_a   (jpi,jpj)    , ehvr_a (jpi,jpj),                                                     &
-         &      ehu_b    (jpi,jpj)    , ehv_b  (jpi,jpj),                                                     &
-         &      ehur_b   (jpi,jpj)    , ehvr_b (jpi,jpj),                                  STAT=ierr(5) )                          
-#endif
-         !
-      ALLOCATE( hu      (jpi,jpj) , hur     (jpi,jpj) , hu_0(jpi,jpj) , ht_0  (jpi,jpj) ,     &
-         &      hv      (jpi,jpj) , hvr     (jpi,jpj) , hv_0(jpi,jpj) , ht    (jpi,jpj) ,     &
-         &      re2u_e1u(jpi,jpj) , re1v_e2v(jpi,jpj) ,                                       &
-         &      e12t    (jpi,jpj) , r1_e12t (jpi,jpj) ,                                       &
-         &      e12u    (jpi,jpj) , r1_e12u (jpi,jpj) ,                                       &
-         &      e12v    (jpi,jpj) , r1_e12v (jpi,jpj) ,                                       &
-         &      e12f    (jpi,jpj) , r1_e12f (jpi,jpj) ,                                   STAT=ierr(6)  )
+      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     &
+         &      gphit(jpi,jpj) ,    gphiu(jpi,jpj) ,  gphiv(jpi,jpj) ,  gphif(jpi,jpj) ,     &
+         &       e1t (jpi,jpj) ,     e2t (jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,     &
+         &       e1u (jpi,jpj) ,     e2u (jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,     &
+         &       e1v (jpi,jpj) ,     e2v (jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,     &
+         &       e1f (jpi,jpj) ,     e2f (jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,     &
+         &      e1e2t(jpi,jpj) , r1_e1e2t(jpi,jpj)                                     ,     &
+         &      e1e2u(jpi,jpj) , r1_e1e2u(jpi,jpj) , e2_e1u(jpi,jpj)                   ,     &
+         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     &
+         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     &
+         &        ff (jpi,jpj)                                                         , STAT=ierr(3) )
+         !
+      ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) ,     &
+         &      gdept_b(jpi,jpj,jpk) , gdepw_b(jpi,jpj,jpk) ,                             &
+         &      gdept_n(jpi,jpj,jpk) , gdepw_n(jpi,jpj,jpk) , gde3w_n(jpi,jpj,jpk) , STAT=ierr(4) )
+         !
+      ALLOCATE( e3t_0(jpi,jpj,jpk) , e3u_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) ,   &
+         &      e3t_b(jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk) ,                      e3w_b(jpi,jpj,jpk) ,   & 
+         &      e3t_n(jpi,jpj,jpk) , e3u_n(jpi,jpj,jpk) , e3v_n(jpi,jpj,jpk) , e3f_n(jpi,jpj,jpk) , e3w_n(jpi,jpj,jpk) ,   & 
+         &      e3t_a(jpi,jpj,jpk) , e3u_a(jpi,jpj,jpk) , e3v_a(jpi,jpj,jpk) ,                                             &
+         !                                                          !
+         &      e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) ,         &
+         &      e3uw_b(jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) ,         &               
+         &      e3uw_n(jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) ,     STAT=ierr(5) )                       
+         !
+      ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) ,                                           &
+         &                      hu_b(jpi,jpj) , hv_b(jpi,jpj) , r1_hu_b(jpi,jpj) , r1_hv_b(jpi,jpj) ,     &
+         &      ht_n(jpi,jpj) , hu_n(jpi,jpj) , hv_n(jpi,jpj) , r1_hu_n(jpi,jpj) , r1_hv_n(jpi,jpj) ,     &
+         &                      hu_a(jpi,jpj) , hv_a(jpi,jpj) , r1_hu_a(jpi,jpj) , r1_hv_a(jpi,jpj) , STAT=ierr(6)  )
+         !
          !
       ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) ,                                     &
@@ -387,15 +362,15 @@
          &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     &
          &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     &
-         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(8) )
-
-      ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) ,                                      &
-         &     tmask_i(jpi,jpj) , umask_i(jpi,jpj), vmask_i(jpi,jpj), fmask_i(jpi,jpj), &
-         &     bmask(jpi,jpj)   ,                                                       &
-         &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) )
+         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1(jpi,jpj) , STAT=ierr(8) )
+
+      ALLOCATE( mbathy(jpi,jpj) , bathy  (jpi,jpj) ,                                       &
+         &     tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                                       & 
+         &     ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , &
+         &     mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) )
 
 ! (ISF) Allocation of basic array   
       ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj),     &
          &     mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) ,           &
-         &     mikf(jpi,jpj), ssmask(jpi,jpj), STAT=ierr(10) )
+         &     mikf(jpi,jpj), STAT=ierr(10) )
 
       ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     & 
@@ -403,8 +378,4 @@
 
       ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(12) )
-
-#if defined key_noslip_accurate
-      ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(12) )
-#endif
       !
       dom_oce_alloc = MAXVAL(ierr)
@@ -414,3 +385,2 @@
    !!======================================================================
 END MODULE dom_oce
-
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 6808)
@@ -13,4 +13,5 @@
    !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
    !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
+   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default
    !!----------------------------------------------------------------------
    
@@ -19,4 +20,5 @@
    !!   dom_nam        : read and contral domain namelists
    !!   dom_ctl        : control print for the ocean domain
+   !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate)
    !!----------------------------------------------------------------------
    USE oce             ! ocean variables
@@ -25,7 +27,4 @@
    USE phycst          ! physical constants
    USE closea          ! closed seas
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distributed memory computing library
-
    USE domhgr          ! domain: set the horizontal mesh
    USE domzgr          ! domain: set the vertical mesh
@@ -36,6 +35,10 @@
    USE c1d             ! 1D vertical configuration
    USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine)
+   !
+   USE in_out_manager  ! I/O manager
+   USE wrk_nemo        ! Memory Allocation
+   USE lib_mpp         ! distributed memory computing library
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
    USE timing          ! Timing
-   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
 
    IMPLICIT NONE
@@ -44,6 +47,4 @@
    PUBLIC   dom_init   ! called by opa.F90
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!-------------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -69,6 +70,7 @@
       !!              - 1D configuration, move Coriolis, u and v at T-point
       !!----------------------------------------------------------------------
-      INTEGER ::   jk          ! dummy loop argument
+      INTEGER ::   jk          ! dummy loop indices
       INTEGER ::   iconf = 0   ! local integers
+      REAL(wp), POINTER, DIMENSION(:,:) ::   z1_hu_0, z1_hv_0
       !!----------------------------------------------------------------------
       !
@@ -81,15 +83,17 @@
       ENDIF
       !
-                             CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
-                             CALL dom_clo      ! Closed seas and lake
-                             CALL dom_hgr      ! Horizontal mesh
-                             CALL dom_zgr      ! Vertical mesh and bathymetry
-                             CALL dom_msk      ! Masks
-      IF( ln_sco )           CALL dom_stiff    ! Maximum stiffness ratio/hydrostatic consistency
-      !
-      ht_0(:,:) = 0.0_wp                       ! Reference ocean depth at T-points
-      hu_0(:,:) = 0.0_wp                       ! Reference ocean depth at U-points
-      hv_0(:,:) = 0.0_wp                       ! Reference ocean depth at V-points
-      DO jk = 1, jpk
+      !                       !==  Reference coordinate system  ==!
+      !
+                     CALL dom_nam               ! read namelist ( namrun, namdom )
+                     CALL dom_clo               ! Closed seas and lake
+                     CALL dom_hgr               ! Horizontal mesh
+                     CALL dom_zgr               ! Vertical mesh and bathymetry
+                     CALL dom_msk               ! Masks
+      IF( ln_sco )   CALL dom_stiff             ! Maximum stiffness ratio/hydrostatic consistency
+      !
+      ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1)   ! Reference ocean thickness
+      hu_0(:,:) = e3u_0(:,:,1) * umask(:,:,1)
+      hv_0(:,:) = e3v_0(:,:,1) * vmask(:,:,1)
+      DO jk = 2, jpk
          ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
          hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
@@ -97,24 +101,46 @@
       END DO
       !
-      IF( lk_vvl )           CALL dom_vvl_init ! Vertical variable mesh
-      !
-      IF( lk_c1d         )   CALL cor_c1d      ! 1D configuration: Coriolis set at T-point
-      !
-      !
-      hu(:,:) = 0._wp                          ! Ocean depth at U-points
-      hv(:,:) = 0._wp                          ! Ocean depth at V-points
-      ht(:,:) = 0._wp                          ! Ocean depth at T-points
-      DO jk = 1, jpkm1
-         hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
-         hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
-         ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk)
-      END DO
-      !                                        ! Inverse of the local depth
-      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:)
-      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:)
-
-                             CALL dom_stp      ! time step
-      IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file
-      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control
+      !              !==  time varying part of coordinate system  ==!
+      !
+      IF( ln_linssh ) THEN          ! Fix in time : set to the reference one for all
+         !       before        !          now          !       after         !
+         ;  gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
+         ;  gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
+         ;                     ;   gde3w_n = gde3w_0   !        ---          !
+         !                                                                  
+         ;    e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
+         ;    e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
+         ;    e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
+         ;                     ;     e3f_n =   e3f_0   !        ---          !
+         ;    e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
+         ;   e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
+         ;   e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
+         !
+         CALL wrk_alloc( jpi,jpj,   z1_hu_0, z1_hv_0 )
+         !
+         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
+         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
+         !
+         !        before       !          now          !       after         !
+         ;                     ;      ht_n =    ht_0   !                     ! water column thickness
+         ;     hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   ! 
+         ;     hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
+         ;  r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
+         ;  r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
+         !
+         CALL wrk_dealloc( jpi,jpj,   z1_hu_0, z1_hv_0 )
+         !
+      ELSE                         ! time varying : initialize before/now/after variables
+         !
+         CALL dom_vvl_init 
+         !
+      ENDIF
+      !
+      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
+      !
+                             CALL dom_stp       ! time step
+      IF( nmsh /= 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file
+      IF( nmsh /= 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file
+      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
       !
       IF( nn_timing == 1 )   CALL timing_stop('dom_init')
@@ -131,20 +157,17 @@
       !! ** input   : - namrun namelist
       !!              - namdom namelist
-      !!              - namcla namelist
       !!              - namnc4 namelist   ! "key_netcdf4" only
       !!----------------------------------------------------------------------
       USE ioipsl
-      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               &
-         &             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
-      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   &
-         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,                  &
-         &             rn_rdtmax, rn_rdth     , nn_closea , ln_crs,    &
-         &             jphgr_msh, &
-         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
-         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
+      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
+                       nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
+         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
+         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
+         &             ln_cfmeta, ln_iscpl
+      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, rn_isfhmin, &
+         &             rn_atfp , rn_rdt   , nn_closea   , ln_crs      , jphgr_msh ,                  &
+         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m,                         &
+         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh,                  &
          &             ppa2, ppkth2, ppacr2
-      NAMELIST/namcla/ nn_cla
 #if defined key_netcdf4
       NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
@@ -155,9 +178,9 @@
       REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
       READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
 
       REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namrun )
       !
@@ -179,4 +202,5 @@
          WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
          WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
+         WRITE(numout,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0
          WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
          WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
@@ -187,9 +211,9 @@
          ENDIF
          WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
-         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
          WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
          WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
          WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
          WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
+         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl
       ENDIF
 
@@ -251,5 +275,5 @@
 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namdom )
-
+      !
       IF(lwp) THEN
          WRITE(numout,*)
@@ -259,4 +283,5 @@
          WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
          WRITE(numout,*) '      min number of ocean level (<0)       '
+         WRITE(numout,*) '      treshold to open the isf cavity   rn_isfhmin   = ', rn_isfhmin, ' (m)'
          WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
          WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
@@ -268,8 +293,4 @@
          WRITE(numout,*) '      ocean time step                       rn_rdt    = ', rn_rdt
          WRITE(numout,*) '      asselin time filter parameter         rn_atfp   = ', rn_atfp
-         WRITE(numout,*) '      acceleration of converge              nn_acc    = ', nn_acc
-         WRITE(numout,*) '        nn_acc=1: surface tracer rdt        rn_rdtmin = ', rn_rdtmin
-         WRITE(numout,*) '                  bottom  tracer rdt        rdtmax    = ', rn_rdtmax
-         WRITE(numout,*) '                  depth of transition       rn_rdth   = ', rn_rdth
          WRITE(numout,*) '      suppression of closed seas (=0)       nn_closea = ', nn_closea
          WRITE(numout,*) '      online coarsening of dynamical fields ln_crs    = ', ln_crs
@@ -293,37 +314,11 @@
          WRITE(numout,*) '                                      ppacr2            = ', ppacr2
       ENDIF
-
+      !
       ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
       e3zps_min = rn_e3zps_min
       e3zps_rat = rn_e3zps_rat
       nmsh      = nn_msh
-      nacc      = nn_acc
       atfp      = rn_atfp
       rdt       = rn_rdt
-      rdtmin    = rn_rdtmin
-      rdtmax    = rn_rdtmin
-      rdth      = rn_rdth
-
-      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection
-      READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
-905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection
-      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
-906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
-      IF(lwm) WRITE( numond, namcla )
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namcla'
-         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
-      ENDIF
-      IF ( nn_cla .EQ. 1 ) THEN
-         IF  ( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2 
-            CONTINUE
-         ELSE
-            CALL ctl_stop( 'STOP', 'Cross land advation iplemented only for ORCA2 configuration: cp_cfg = "orca" and jp_cfg = 2 ' )
-         ENDIF
-      ENDIF
 
 #if defined key_netcdf4
@@ -409,4 +404,5 @@
    END SUBROUTINE dom_ctl
 
+
    SUBROUTINE dom_stiff
       !!----------------------------------------------------------------------
@@ -425,41 +421,40 @@
       INTEGER  ::   ji, jj, jk 
       REAL(wp) ::   zrxmax
-      REAL(wp), DIMENSION(4) :: zr1
-      !!----------------------------------------------------------------------
-      rx1(:,:) = 0.e0
-      zrxmax   = 0.e0
-      zr1(:)   = 0.e0
-      
+      REAL(wp), DIMENSION(4) ::   zr1
+      !!----------------------------------------------------------------------
+      rx1(:,:) = 0._wp
+      zrxmax   = 0._wp
+      zr1(:)   = 0._wp
+      !
       DO ji = 2, jpim1
          DO jj = 2, jpjm1
             DO jk = 1, jpkm1
-               zr1(1) = umask(ji-1,jj  ,jk) *abs( (gdepw_0(ji  ,jj  ,jk  )-gdepw_0(ji-1,jj  ,jk  )  & 
-                    &                         +gdepw_0(ji  ,jj  ,jk+1)-gdepw_0(ji-1,jj  ,jk+1)) &
-                    &                        /(gdepw_0(ji  ,jj  ,jk  )+gdepw_0(ji-1,jj  ,jk  )  &
-                    &                         -gdepw_0(ji  ,jj  ,jk+1)-gdepw_0(ji-1,jj  ,jk+1) + rsmall) )
-               zr1(2) = umask(ji  ,jj  ,jk) *abs( (gdepw_0(ji+1,jj  ,jk  )-gdepw_0(ji  ,jj  ,jk  )  &
-                    &                         +gdepw_0(ji+1,jj  ,jk+1)-gdepw_0(ji  ,jj  ,jk+1)) &
-                    &                        /(gdepw_0(ji+1,jj  ,jk  )+gdepw_0(ji  ,jj  ,jk  )  &
-                    &                         -gdepw_0(ji+1,jj  ,jk+1)-gdepw_0(ji  ,jj  ,jk+1) + rsmall) )
-               zr1(3) = vmask(ji  ,jj  ,jk) *abs( (gdepw_0(ji  ,jj+1,jk  )-gdepw_0(ji  ,jj  ,jk  )  &
-                    &                         +gdepw_0(ji  ,jj+1,jk+1)-gdepw_0(ji  ,jj  ,jk+1)) &
-                    &                        /(gdepw_0(ji  ,jj+1,jk  )+gdepw_0(ji  ,jj  ,jk  )  &
-                    &                         -gdepw_0(ji  ,jj+1,jk+1)-gdepw_0(ji  ,jj  ,jk+1) + rsmall) )
-               zr1(4) = vmask(ji  ,jj-1,jk) *abs( (gdepw_0(ji  ,jj  ,jk  )-gdepw_0(ji  ,jj-1,jk  )  &
-                    &                         +gdepw_0(ji  ,jj  ,jk+1)-gdepw_0(ji  ,jj-1,jk+1)) &
-                    &                        /(gdepw_0(ji  ,jj  ,jk  )+gdepw_0(ji  ,jj-1,jk  )  &
-                    &                         -gdepw_0(ji,  jj  ,jk+1)-gdepw_0(ji  ,jj-1,jk+1) + rsmall) )
-               zrxmax = MAXVAL(zr1(1:4))
-               rx1(ji,jj) = MAX(rx1(ji,jj), zrxmax)
+               zr1(1) = ABS(  ( gdepw_0(ji  ,jj,jk  )-gdepw_0(ji-1,jj,jk  )               & 
+                    &          +gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) )             &
+                    &       / ( gdepw_0(ji  ,jj,jk  )+gdepw_0(ji-1,jj,jk  )               &
+                    &          -gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall )  ) * umask(ji-1,jj,jk)
+               zr1(2) = ABS(  ( gdepw_0(ji+1,jj,jk  )-gdepw_0(ji  ,jj,jk  )               &
+                    &          +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) )             &
+                    &       / ( gdepw_0(ji+1,jj,jk  )+gdepw_0(ji  ,jj,jk  )               &
+                    &          -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) + rsmall )  ) * umask(ji  ,jj,jk)
+               zr1(3) = ABS(  ( gdepw_0(ji,jj+1,jk  )-gdepw_0(ji,jj  ,jk  )               &
+                    &          +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) )             &
+                    &       / ( gdepw_0(ji,jj+1,jk  )+gdepw_0(ji,jj  ,jk  )               &
+                    &          -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) + rsmall )  ) * vmask(ji,jj  ,jk)
+               zr1(4) = ABS(  ( gdepw_0(ji,jj  ,jk  )-gdepw_0(ji,jj-1,jk  )               &
+                    &          +gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) )             &
+                    &       / ( gdepw_0(ji,jj  ,jk  )+gdepw_0(ji,jj-1,jk  )               &
+                    &          -gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall )  ) * vmask(ji,jj-1,jk)
+               zrxmax = MAXVAL( zr1(1:4) )
+               rx1(ji,jj) = MAX( rx1(ji,jj) , zrxmax )
             END DO
          END DO
       END DO
-
       CALL lbc_lnk( rx1, 'T', 1. )
-
-      zrxmax = MAXVAL(rx1)
-
+      !
+      zrxmax = MAXVAL( rx1 )
+      !
       IF( lk_mpp )   CALL mpp_max( zrxmax ) ! max over the global domain
-
+      !
       IF(lwp) THEN
          WRITE(numout,*)
@@ -467,8 +462,6 @@
          WRITE(numout,*) '~~~~~~~~~'
       ENDIF
-
+      !
    END SUBROUTINE dom_stiff
-
-
 
    !!======================================================================
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90	(revision 6808)
@@ -118,22 +118,24 @@
          WRITE(numout,*) '          south-west indices    jpizoom = ', jpizoom,   &
             &                                           ' jpjzoom = ', jpjzoom
-         WRITE(numout,*)
-         WRITE(numout,*) '          conversion local  ==> data i-index domain'
-         WRITE(numout,25)              (mig(ji),ji = 1,jpi)
-         WRITE(numout,*)
-         WRITE(numout,*) '          conversion data   ==> local  i-index domain'
-         WRITE(numout,*) '             starting index'
-         WRITE(numout,25)              (mi0(ji),ji = 1,jpidta)
-         WRITE(numout,*) '             ending index'
-         WRITE(numout,25)              (mi1(ji),ji = 1,jpidta)
-         WRITE(numout,*)
-         WRITE(numout,*) '          conversion local  ==> data j-index domain'
-         WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
-         WRITE(numout,*)
-         WRITE(numout,*) '          conversion data  ==> local j-index domain'
-         WRITE(numout,*) '             starting index'
-         WRITE(numout,25)              (mj0(jj),jj = 1,jpjdta)
-         WRITE(numout,*) '             ending index'
-         WRITE(numout,25)              (mj1(jj),jj = 1,jpjdta)
+         IF( nn_print >= 1 ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion local  ==> data i-index domain'
+            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion data   ==> local  i-index domain'
+            WRITE(numout,*) '             starting index'
+            WRITE(numout,25)              (mi0(ji),ji = 1,jpidta)
+            WRITE(numout,*) '             ending index'
+            WRITE(numout,25)              (mi1(ji),ji = 1,jpidta)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion local  ==> data j-index domain'
+            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion data  ==> local j-index domain'
+            WRITE(numout,*) '             starting index'
+            WRITE(numout,25)              (mj0(jj),jj = 1,jpjdta)
+            WRITE(numout,*) '             ending index'
+            WRITE(numout,25)              (mj1(jj),jj = 1,jpjdta)
+         ENDIF
       ENDIF
  25   FORMAT( 100(10x,19i4,/) )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 6808)
@@ -14,5 +14,6 @@
    !!                            use of parameters in par_CONFIG-Rxx.h90, not in namelist
    !!             -   ! 2004-05  (A. Koch-Larrouy) Add Gyre configuration 
-   !!            4.0  ! 2011-02  (G. Madec) add cell surface (e1e2t)
+   !!            3.7  ! 2015-09  (G. Madec, S. Flavoni) add cell surface and their inverse
+   !!                                       add optional read of e1e2u & e1e2v
    !!----------------------------------------------------------------------
 
@@ -23,4 +24,6 @@
    USE dom_oce        ! ocean space and time domain
    USE phycst         ! physical constants
+   USE domwri         ! write 'meshmask.nc' & 'coordinate_e1e2u_v.nc' files
+   !
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
@@ -35,5 +38,5 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -106,5 +109,5 @@
       REAL(wp) ::   zphi1, zsin_alpha, zim05, zjm05
       INTEGER  ::   isrow                ! index for ORCA1 starting row
-
+      INTEGER  ::   ie1e2u_v             ! fag for u- & v-surface read in coordinate file or not
       !!----------------------------------------------------------------------
       !
@@ -122,167 +125,35 @@
          WRITE(numout,*) '             meridional grid-spacing (meters)  ppe2_m   = ', ppe2_m  
       ENDIF
-
-
-      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
-
-      CASE ( 0 )                     !  curvilinear coordinate on the sphere read in coordinate.nc file
-
+      !
+      !
+      SELECT CASE( jphgr_msh )   !  type of horizontal mesh  
+      !
+      CASE ( 0 )                     !==  read in coordinate.nc file  ==!
+         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in "coordinate" file'
-
-         CALL hgr_read           ! Defaultl option  :   NetCDF file
-
-         !                                                ! =====================
-         IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
-            !                                             ! =====================
-            IF( nn_cla == 0 ) THEN
-               !
-               ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u = 20 km)
-               ij0 = 102   ;   ij1 = 102   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3
-               IF(lwp) WRITE(numout,*)
-               IF(lwp) WRITE(numout,*) '             orca_r2: Gibraltar    : e2u reduced to 20 km'
-               !
-               ii0 = 160   ;   ii1 = 160        ! Bab el Mandeb (e2u = 18 km)
-               ij0 =  88   ;   ij1 =  88   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  18.e3
-                                               e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  30.e3
-               IF(lwp) WRITE(numout,*)
-               IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb: e2u reduced to 30 km'
-               IF(lwp) WRITE(numout,*) '                                     e1v reduced to 18 km'
-            ENDIF
-
-            ii0 = 145   ;   ii1 = 146        ! Danish Straits (e2u = 10 km)
-            ij0 = 116   ;   ij1 = 116   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r2: Danish Straits : e2u reduced to 10 km'
-            !
+         !
+         ie1e2u_v = 0                  ! set to unread e1e2u and e1e2v
+         !
+         CALL hgr_read( ie1e2u_v )     ! read the coordinate.nc file
+         !
+         IF( ie1e2u_v == 0 ) THEN      ! e1e2u and e1e2v have not been read: compute them
+            !                          ! e2u and e1v does not include a reduction in some strait: apply reduction
+            e1e2u (:,:) = e1u(:,:) * e2u(:,:)   
+            e1e2v (:,:) = e1v(:,:) * e2v(:,:) 
          ENDIF
-
-            !                                             ! =====================
-         IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration
-            !                                             ! =====================
-            ! This dirty section will be suppressed by simplification process: all this will come back in input files
-            ! Currently these hard-wired indices relate to configuration with
-            ! extend grid (jpjglo=332)
-            ! which had a grid-size of 362x292.
-            ! 
-            isrow = 332 - jpjglo
-            !
-            ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait (e2u = 20 km)
-            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 = 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 = 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 = 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 = 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 = 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 = 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 = 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'
-            !
-            !
-         ENDIF
-
-         !                                                ! ======================
-         IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration
-            !                                             ! ======================
-            ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u = 20 km)
-            ij0 = 327   ;   ij1 = 327   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Gibraltar Strait'
-            !
-            ii0 = 627   ;   ii1 = 628        ! Bosphore Strait (e2u = 10 km)
-            ij0 = 343   ;   ij1 = 343   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Bosphore Strait'
-            !
-            ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u = 40 km)
-            ij0 = 232   ;   ij1 = 232   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  40.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Sumba Strait'
-            !
-            ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u = 15 km)
-            ij0 = 232   ;   ij1 = 232   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  15.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Ombai Strait'
-            !
-            ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u = 10 km)
-            ij0 = 270   ;   ij1 = 270   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Palk Strait'
-            !
-            ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v = 10 km)
-            ij0 = 232   ;   ij1 = 233   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e1v at the Lombok Strait'
-            !
-            !
-            ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v = 25 km)
-            ij0 = 276   ;   ij1 = 276   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  25.e3
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e1v at the Bab el Mandeb'
-            !
-         ENDIF
-
-
-         ! N.B. :  General case, lat and long function of both i and j indices:
-         !     e1t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdila( zti, ztj ) )**2   &
-         !                                  + (                           fsdiph( zti, ztj ) )**2  )
-         !     e1u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdila( zui, zuj ) )**2   &
-         !                                  + (                           fsdiph( zui, zuj ) )**2  )
-         !     e1v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdila( zvi, zvj ) )**2   &
-         !                                  + (                           fsdiph( zvi, zvj ) )**2  )
-         !     e1f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdila( zfi, zfj ) )**2   &
-         !                                  + (                           fsdiph( zfi, zfj ) )**2  )
-         !
-         !     e2t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdjla( zti, ztj ) )**2   &
-         !                                  + (                           fsdjph( zti, ztj ) )**2  )
-         !     e2u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdjla( zui, zuj ) )**2   &
-         !                                  + (                           fsdjph( zui, zuj ) )**2  )
-         !     e2v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdjla( zvi, zvj ) )**2   &
-         !                                  + (                           fsdjph( zvi, zvj ) )**2  )
-         !     e2f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdjla( zfi, zfj ) )**2   &
-         !                                  + (                           fsdjph( zfi, zfj ) )**2  )
-
-
-      CASE ( 1 )                     ! geographical mesh on the sphere with regular grid-spacing
-
+         !
+      CASE ( 1 )                     !==  geographical mesh on the sphere with regular (in degree) grid-spacing  ==!
+         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere with regular grid-spacing'
          IF(lwp) WRITE(numout,*) '          given by ppe1_deg and ppe2_deg' 
-
+         !
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - 1 + njmpp - 1 )
-               zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - 1 + njmpp - 1 )
-               zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5
-               zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5
+               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - 1 + njmpp - 1 )
+               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - 1 + njmpp - 1 )
+               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - 1 + njmpp - 1 ) + 0.5
+               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - 1 + njmpp - 1 ) + 0.5
          ! Longitude
                glamt(ji,jj) = ppglam0 + ppe1_deg * zti
@@ -307,17 +178,16 @@
             END DO
          END DO
-
-
-      CASE ( 2:3 )                   ! f- or beta-plane with regular grid-spacing
-
+         !
+      CASE ( 2:3 )                   !==  f- or beta-plane with regular grid-spacing  ==!
+         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          f- or beta-plane with regular grid-spacing'
          IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m' 
-
+         !
          ! Position coordinates (in kilometers)
          !                          ==========
-         glam0 = 0.e0
+         glam0 = 0._wp
          gphi0 = - ppe2_m * 1.e-3
-         
+         !
 #if defined key_agrif 
          IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only
@@ -332,16 +202,16 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 )       )
-               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 ) + 0.5 )
+               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 )       )
+               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) + 0.5 )
                glamv(ji,jj) = glamt(ji,jj)
                glamf(ji,jj) = glamu(ji,jj)
-   
-               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 )       )
+               !
+               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 )       )
                gphiu(ji,jj) = gphit(ji,jj)
-               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 ) + 0.5 )
+               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) + 0.5 )
                gphif(ji,jj) = gphiv(ji,jj)
             END DO
          END DO
-
+         !
          ! Horizontal scale factors (in meters)
          !                              ======
@@ -350,12 +220,12 @@
          e1v(:,:) = ppe1_m      ;      e2v(:,:) = ppe2_m
          e1f(:,:) = ppe1_m      ;      e2f(:,:) = ppe2_m
-
-      CASE ( 4 )                     ! geographical mesh on the sphere, isotropic MERCATOR type
-
+         !
+      CASE ( 4 )                     !==  geographical mesh on the sphere, isotropic MERCATOR type  ==!
+         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere, MERCATOR type'
          IF(lwp) WRITE(numout,*) '          longitudinal/latitudinal spacing given by ppe1_deg'
          IF ( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' )
-
+         !
          !  Find index corresponding to the equator, given the grid spacing e1_deg
          !  and the (approximate) southern latitude ppgphi0.
@@ -365,13 +235,13 @@
          ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg )
          IF(  ppgphi0 > 0 )  ijeq = -ijeq
-
+         !
          IF(lwp) WRITE(numout,*) '          Index of the equator on the MERCATOR grid:', ijeq
-
+         !
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - ijeq + njmpp - 1 )
-               zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - ijeq + njmpp - 1 )
-               zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5
-               zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5
+               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - ijeq + njmpp - 1 )
+               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - ijeq + njmpp - 1 )
+               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - ijeq + njmpp - 1 ) + 0.5
+               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - ijeq + njmpp - 1 ) + 0.5
          ! Longitude
                glamt(ji,jj) = ppglam0 + ppe1_deg * zti
@@ -396,53 +266,53 @@
             END DO
          END DO
-
-      CASE ( 5 )                   ! beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
-
+         !
+      CASE ( 5 )                   !==  beta-plane with regular grid-spacing and rotated domain ==! (GYRE configuration)
+         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          beta-plane with regular grid-spacing and rotated domain (GYRE configuration)'
          IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m'
-
+         !
          ! Position coordinates (in kilometers)
          !                          ==========
-
+         !
          ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN
-         zlam1 = -85
-         zphi1 = 29
+         zlam1 = -85._wp
+         zphi1 =  29._wp
          ! resolution in meters
-         ze1 = 106000. / FLOAT(jp_cfg)            
+         ze1 = 106000. / REAL( jp_cfg , wp )            
          ! benchmark: forced the resolution to be about 100 km
-         IF( nbench /= 0 )   ze1 = 106000.e0     
-         zsin_alpha = - SQRT( 2. ) / 2.
-         zcos_alpha =   SQRT( 2. ) / 2.
+         IF( nbench /= 0 )   ze1 = 106000._wp     
+         zsin_alpha = - SQRT( 2._wp ) * 0.5_wp
+         zcos_alpha =   SQRT( 2._wp ) * 0.5_wp
          ze1deg = ze1 / (ra * rad)
-         IF( nbench /= 0 )   ze1deg = ze1deg / FLOAT(jp_cfg)        ! benchmark: keep the lat/+lon
-         !                                                          ! at the right jp_cfg resolution
-         glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpjglo-2 )
-         gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpjglo-2 )
-
+         IF( nbench /= 0 )   ze1deg = ze1deg / REAL( jp_cfg , wp )   ! benchmark: keep the lat/+lon
+         !                                                           ! at the right jp_cfg resolution
+         glam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp )
+         gphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp )
+         !
          IF( nprint==1 .AND. lwp )   THEN
             WRITE(numout,*) '          ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha
             WRITE(numout,*) '          ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0
          ENDIF
-
+         !
          DO jj = 1, jpj
-           DO ji = 1, jpi
-             zim1 = FLOAT( ji + nimpp - 1 ) - 1.   ;   zim05 = FLOAT( ji + nimpp - 1 ) - 1.5
-             zjm1 = FLOAT( jj + njmpp - 1 ) - 1.   ;   zjm05 = FLOAT( jj + njmpp - 1 ) - 1.5
-
-             glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
-             gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
-
-             glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
-             gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
-
-             glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
-             gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
-
-             glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
-             gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
-           END DO
-          END DO
-
+            DO ji = 1, jpi
+               zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5
+               zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5
+               !
+               glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+               gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+               !
+               glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+               gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+               !
+               glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+               gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+               !
+               glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+               gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+            END DO
+         END DO
+         !
          ! Horizontal scale factors (in meters)
          !                              ======
@@ -451,40 +321,32 @@
          e1v(:,:) =  ze1     ;      e2v(:,:) = ze1
          e1f(:,:) =  ze1     ;      e2f(:,:) = ze1
-
+         !
       CASE DEFAULT
          WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh
          CALL ctl_stop( ctmp1 )
-
+         !
       END SELECT
       
-      ! T-cell surface
-      ! --------------
-      e1e2t(:,:) = e1t(:,:) * e2t(:,:)
-    
-      ! Useful shortcuts (JC: note the duplicated e2e2t array ! Need some cleaning)
-      ! ---------------------------------------------------------------------------
-      e12t    (:,:) = e1t(:,:) * e2t(:,:)
-      e12u    (:,:) = e1u(:,:) * e2u(:,:)
-      e12v    (:,:) = e1v(:,:) * e2v(:,:)
-      e12f    (:,:) = e1f(:,:) * e2f(:,:)
-      r1_e12t (:,:) = 1._wp    / e12t(:,:)
-      r1_e12u (:,:) = 1._wp    / e12u(:,:)
-      r1_e12v (:,:) = 1._wp    / e12v(:,:)
-      r1_e12f (:,:) = 1._wp    / e12f(:,:)
-      re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)
-      re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)
-      r1_e1t  (:,:) = 1._wp    / e1t(:,:)
-      r1_e1u  (:,:) = 1._wp    / e1u(:,:)
-      r1_e1v  (:,:) = 1._wp    / e1v(:,:)
-      r1_e1f  (:,:) = 1._wp    / e1f(:,:)
-      r1_e2t  (:,:) = 1._wp    / e2t(:,:)
-      r1_e2u  (:,:) = 1._wp    / e2u(:,:)
-      r1_e2v  (:,:) = 1._wp    / e2v(:,:)
-      r1_e2f  (:,:) = 1._wp    / e2f(:,:)
-
-      ! Control printing : Grid informations (if not restart)
-      ! ----------------
-
-      IF( lwp .AND. .NOT.ln_rstart ) THEN
+      ! associated horizontal metrics
+      ! -----------------------------
+      !
+      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:)
+      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:)
+      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:)
+      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:)
+      !
+      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:)
+      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:)
+      IF( jphgr_msh /= 0 ) THEN               ! e1e2u and e1e2v have not been set: compute them
+         e1e2u (:,:) = e1u(:,:) * e2u(:,:)   
+         e1e2v (:,:) = e1v(:,:) * e2v(:,:) 
+      ENDIF
+      r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in both cases
+      r1_e1e2v(:,:) = 1._wp / e1e2v(:,:)
+      !   
+      e2_e1u(:,:) = e2u(:,:) / e1u(:,:)
+      e1_e2v(:,:) = e1v(:,:) / e2v(:,:)
+
+      IF( lwp .AND. nn_print >=1 .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart)
          WRITE(numout,*)
          WRITE(numout,*) '          longitude and e1 scale factors'
@@ -496,5 +358,5 @@
 9300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
             f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 )
-         
+            !
          WRITE(numout,*)
          WRITE(numout,*) '          latitude and e2 scale factors'
@@ -506,17 +368,4 @@
       ENDIF
 
-      
-      IF( nprint == 1 .AND. lwp ) THEN
-         WRITE(numout,*) '          e1u e2u '
-         CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-         CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-         WRITE(numout,*) '          e1v e2v  '
-         CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-         CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-         WRITE(numout,*) '          e1f e2f  '
-         CALL prihre( e1f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-         CALL prihre( e2f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
-      ENDIF
-
 
       ! ================= !
@@ -525,31 +374,31 @@
 
       SELECT CASE( jphgr_msh )   ! type of horizontal mesh
-
+      !
       CASE ( 0, 1, 4 )               ! mesh on the sphere
-
+         !
          ff(:,:) = 2. * omega * SIN( rad * gphif(:,:) ) 
-
+         !
       CASE ( 2 )                     ! f-plane at ppgphi0 
-
+         !
          ff(:,:) = 2. * omega * SIN( rad * ppgphi0 )
-
+         !
          IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1)
-
+         !
       CASE ( 3 )                     ! beta-plane
-
+         !
          zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                       ! beta at latitude ppgphi0
-         zphi0   = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points
-         
+         zphi0   = ppgphi0 - REAL( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points
+         !
 #if defined key_agrif
-         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)
+         IF( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN       ! for EEL6 configuration only
+            IF( .NOT.Agrif_Root() ) THEN
+              zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad)
             ENDIF
          ENDIF
 #endif         
          zf0     = 2. * omega * SIN( rad * zphi0 )                              ! compute f0 1st point south
-
+         !
          ff(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south)
-         
+         !
          IF(lwp) THEN
             WRITE(numout,*) 
@@ -564,13 +413,13 @@
             IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff
          END IF
-
+         !
       CASE ( 5 )                     ! beta-plane and rotated domain (gyre configuration)
-
+         !
          zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
-         zphi0 = 15.e0                                                      ! latitude of the first row F-points
+         zphi0 = 15._wp                                                     ! latitude of the first row F-points
          zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
-
+         !
          ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
-
+         !
          IF(lwp) THEN
             WRITE(numout,*) 
@@ -578,5 +427,5 @@
             WRITE(numout,*) '          Coriolis parameter varies in this processor from ', ff(nldi,nldj),' to ', ff(nldi,nlej)
          ENDIF
-
+         !
          IF( lk_mpp ) THEN 
             zminff=ff(nldi,nldj)
@@ -586,5 +435,5 @@
             IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff
          END IF
-
+         !
       END SELECT
 
@@ -595,5 +444,5 @@
 
       IF( nperio == 2 ) THEN
-         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / FLOAT( jpi )
+         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi )
          IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' )
       ENDIF
@@ -604,19 +453,18 @@
 
 
-   SUBROUTINE hgr_read
+   SUBROUTINE hgr_read( ke1e2u_v )
       !!---------------------------------------------------------------------
       !!              ***  ROUTINE hgr_read  ***
       !!
-      !! ** Purpose :   Read a coordinate file in NetCDF format 
-      !!
-      !! ** Method  :   The mesh file has been defined trough a analytical 
-      !!      or semi-analytical method. It is read in a NetCDF file. 
-      !!     
+      !! ** Purpose :   Read a coordinate file in NetCDF format using IOM
+      !!
       !!----------------------------------------------------------------------
       USE iom
-
+      !!
+      INTEGER, INTENT( inout ) ::   ke1e2u_v   ! fag: e1e2u & e1e2v read in coordinate file (=1) or not (=0)
+      !
       INTEGER ::   inum   ! temporary logical unit
       !!----------------------------------------------------------------------
-
+      !
       IF(lwp) THEN
          WRITE(numout,*)
@@ -624,56 +472,38 @@
          WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk
       ENDIF
-      
+      !
       CALL iom_open( 'coordinates', inum )
-      
+      !
       CALL iom_get( inum, jpdom_data, 'glamt', glamt, lrowattr=ln_use_jattr )
       CALL iom_get( inum, jpdom_data, 'glamu', glamu, lrowattr=ln_use_jattr )
       CALL iom_get( inum, jpdom_data, 'glamv', glamv, lrowattr=ln_use_jattr )
       CALL iom_get( inum, jpdom_data, 'glamf', glamf, lrowattr=ln_use_jattr )
-      
+      !
       CALL iom_get( inum, jpdom_data, 'gphit', gphit, lrowattr=ln_use_jattr )
       CALL iom_get( inum, jpdom_data, 'gphiu', gphiu, lrowattr=ln_use_jattr )
       CALL iom_get( inum, jpdom_data, 'gphiv', gphiv, lrowattr=ln_use_jattr )
       CALL iom_get( inum, jpdom_data, 'gphif', gphif, lrowattr=ln_use_jattr )
-      
-      CALL iom_get( inum, jpdom_data, 'e1t', e1t, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e1u', e1u, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e1v', e1v, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e1f', e1f, lrowattr=ln_use_jattr )
-      
-      CALL iom_get( inum, jpdom_data, 'e2t', e2t, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e2u', e2u, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e2v', e2v, lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e2f', e2f, lrowattr=ln_use_jattr )
-      
+      !
+      CALL iom_get( inum, jpdom_data, 'e1t'  , e1t  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1u'  , e1u  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1v'  , e1v  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1f'  , e1f  , lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'e2t'  , e2t  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2u'  , e2u  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2v'  , e2v  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2f'  , e2f  , lrowattr=ln_use_jattr )
+      !
+      IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN
+         IF(lwp) WRITE(numout,*) 'hgr_read : e1e2u & e1e2v read in coordinates file'
+         CALL iom_get( inum, jpdom_data, 'e1e2u'  , e1e2u  , lrowattr=ln_use_jattr )
+         CALL iom_get( inum, jpdom_data, 'e1e2v'  , e1e2v  , lrowattr=ln_use_jattr )
+         ke1e2u_v = 1
+      ELSE
+         ke1e2u_v = 0
+      ENDIF
+      !
       CALL iom_close( inum )
       
-! need to be define for the extended grid south of -80S
-! some point are undefined but you need to have e1 and e2 .NE. 0
-      WHERE (e1t==0.0_wp)
-         e1t=1.0e2
-      END WHERE
-      WHERE (e1v==0.0_wp)
-         e1v=1.0e2
-      END WHERE
-      WHERE (e1u==0.0_wp)
-         e1u=1.0e2
-      END WHERE
-      WHERE (e1f==0.0_wp)
-         e1f=1.0e2
-      END WHERE
-      WHERE (e2t==0.0_wp)
-         e2t=1.0e2
-      END WHERE
-      WHERE (e2v==0.0_wp)
-         e2v=1.0e2
-      END WHERE
-      WHERE (e2u==0.0_wp)
-         e2u=1.0e2
-      END WHERE
-      WHERE (e2f==0.0_wp)
-         e2f=1.0e2
-      END WHERE
-       
     END SUBROUTINE hgr_read
     
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 6808)
@@ -7,6 +7,5 @@
    !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon)
    !!            7.0  ! 1996-01  (G. Madec)  suppression of common work arrays
-   !!             -   ! 1996-05  (G. Madec)  mask computed from tmask and sup-
-   !!                 !                      pression of the double computation of bmask
+   !!             -   ! 1996-05  (G. Madec)  mask computed from tmask
    !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F
    !!            8.1  ! 1997-07  (G. Madec)  modification of mbathy and fmask
@@ -17,16 +16,16 @@
    !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
    !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   dom_msk        : compute land/ocean mask
-   !!   dom_msk_nsa    : update land/ocean mask when no-slip accurate option is used.
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
+   !
    USE in_out_manager  ! I/O manager
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp
-   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
+   USE lib_mpp         !
    USE wrk_nemo        ! Memory allocation
    USE timing          ! Timing
@@ -35,6 +34,5 @@
    PRIVATE
 
-   PUBLIC   dom_msk         ! routine called by inidom.F90
-   PUBLIC   dom_msk_alloc   ! routine called by nemogcm.F90
+   PUBLIC   dom_msk    ! routine called by inidom.F90
 
    !                            !!* Namelist namlbc : lateral boundary condition *
@@ -43,7 +41,4 @@
    !                                            with analytical eqs.
 
-
-   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  icoord ! Workspace for dom_msk_nsa()
-
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
@@ -54,17 +49,4 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   
-   INTEGER FUNCTION dom_msk_alloc()
-      !!---------------------------------------------------------------------
-      !!                 ***  FUNCTION dom_msk_alloc  ***
-      !!---------------------------------------------------------------------
-      dom_msk_alloc = 0
-#if defined key_noslip_accurate
-      ALLOCATE(icoord(jpi*jpj*jpk,3), STAT=dom_msk_alloc)
-#endif
-      IF( dom_msk_alloc /= 0 )   CALL ctl_warn('dom_msk_alloc: failed to allocate icoord array')
-      !
-   END FUNCTION dom_msk_alloc
-
 
    SUBROUTINE dom_msk
@@ -73,6 +55,5 @@
       !!
       !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
-      !!      zontal velocity points (u & v), vorticity points (f) and baro-
-      !!      tropic stream function  points (b).
+      !!      zontal velocity points (u & v), vorticity points (f) points.
       !!
       !! ** Method  :   The ocean/land mask is computed from the basin bathy-
@@ -92,6 +73,4 @@
       !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1)
       !!                  and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk.
-      !!      b-point : the same definition as for f-point of the first ocean
-      !!                level (surface level) but with 0 along coastlines.
       !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated
       !!                rows/lines due to cyclic or North Fold boundaries as well
@@ -107,16 +86,9 @@
       !!
       !!      N.B. If nperio not equal to 0, the land/ocean mask arrays
-      !!      are defined with the proper value at lateral domain boundaries,
-      !!      but bmask. indeed, bmask defined the domain over which the
-      !!      barotropic stream function is computed. this domain cannot
-      !!      contain identical columns because the matrix associated with
-      !!      the barotropic stream function equation is then no more inverti-
-      !!      ble. therefore bmask is set to 0 along lateral domain boundaries
-      !!      even IF nperio is not zero.
+      !!      are defined with the proper value at lateral domain boundaries.
       !!
       !!      In case of open boundaries (lk_bdy=T):
       !!        - tmask is set to 1 on the points to be computed bay the open
       !!          boundaries routines.
-      !!        - bmask is  set to 0 on the open boundaries.
       !!
       !! ** Action :   tmask    : land/ocean mask at t-point (=0. or 1.)
@@ -125,10 +97,7 @@
       !!               fmask    : land/ocean mask at f-point (=0. or 1.)
       !!                          =rn_shlat along lateral boundaries
-      !!               bmask    : land/ocean mask at barotropic stream
-      !!                          function point (=0. or 1.) and set to 0 along lateral boundaries
       !!               tmask_i  : interior ocean mask
       !!----------------------------------------------------------------------
-      !
-      INTEGER  ::   ji, jj, jk      ! dummy loop indices
+      INTEGER  ::   ji, jj, jk               ! dummy loop indices
       INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers
       INTEGER  ::   ijf, ijl, ij0, ij1       !   -       -
@@ -199,27 +168,9 @@
       END DO  
 
-!!gm  ????
-#if defined key_zdfkpp
-      IF( cp_cfg == 'orca' ) THEN
-         IF( jp_cfg == 2 )   THEN       ! land point on Bab el Mandeb zonal section
-            ij0 =  87   ;   ij1 =  88
-            ii0 = 160   ;   ii1 = 161
-            tmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0._wp
-         ELSE
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,cform_war)
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*)'          A mask must be applied on Bab el Mandeb strait'
-            IF(lwp) WRITE(numout,*)'          in case of ORCAs configurations'
-            IF(lwp) WRITE(numout,*)'          This is a problem which is not yet solved'
-            IF(lwp) WRITE(numout,*)
-         ENDIF
-      ENDIF
-#endif
-!!gm end
-
       ! Interior domain mask (used for global sum)
       ! --------------------
       tmask_i(:,:) = ssmask(:,:)            ! (ISH) tmask_i = 1 even on the ice shelf
+
+      tmask_h(:,:) = 1._wp                 ! 0 on the halo and 1 elsewhere
       iif = jpreci                         ! ???
       iil = nlci - jpreci + 1
@@ -227,8 +178,8 @@
       ijl = nlcj - jprecj + 1
 
-      tmask_i( 1 :iif,   :   ) = 0._wp      ! first columns
-      tmask_i(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
-      tmask_i(   :   , 1 :ijf) = 0._wp      ! first rows
-      tmask_i(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
+      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns
+      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
+      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows
+      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
 
       ! north fold mask
@@ -241,8 +192,11 @@
          IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row
             DO ji = iif+1, iil-1
-               tmask_i(ji,nlej-1) = tmask_i(ji,nlej-1) * tpol(mig(ji))
+               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji))
             END DO
          ENDIF
       ENDIF
+     
+      tmask_i(:,:) = tmask_i(:,:) * tmask_h(:,:)
+
       IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
          tpol(     1    :jpiglo) = 0._wp
@@ -264,85 +218,33 @@
          END DO
       END DO
-      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet u point
+      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point
       DO jj = 1, jpjm1
          DO ji = 1, fs_jpim1   ! vector loop
-            umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:)))
-            vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:)))
+            ssumask(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:)))
+            ssvmask(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:)))
          END DO
          DO ji = 1, jpim1      ! NO vector opt.
-            fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   &
+            ssfmask(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   &
                &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:)))
          END DO
       END DO
-      CALL lbc_lnk( umask, 'U', 1._wp )      ! Lateral boundary conditions
-      CALL lbc_lnk( vmask, 'V', 1._wp )
-      CALL lbc_lnk( fmask, 'F', 1._wp )
-      CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions
-      CALL lbc_lnk( vmask_i, 'V', 1._wp )
-      CALL lbc_lnk( fmask_i, 'F', 1._wp )
+      CALL lbc_lnk( umask  , 'U', 1._wp )      ! Lateral boundary conditions
+      CALL lbc_lnk( vmask  , 'V', 1._wp )
+      CALL lbc_lnk( fmask  , 'F', 1._wp )
+      CALL lbc_lnk( ssumask, 'U', 1._wp )      ! Lateral boundary conditions
+      CALL lbc_lnk( ssvmask, 'V', 1._wp )
+      CALL lbc_lnk( ssfmask, 'F', 1._wp )
 
       ! 3. Ocean/land mask at wu-, wv- and w points 
       !----------------------------------------------
-      wmask (:,:,1) = tmask(:,:,1) ! ????????
-      wumask(:,:,1) = umask(:,:,1) ! ????????
-      wvmask(:,:,1) = vmask(:,:,1) ! ????????
-      DO jk=2,jpk
-         wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1)
-         wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1)   
-         wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1)
+      wmask (:,:,1) = tmask(:,:,1)     ! surface
+      wumask(:,:,1) = umask(:,:,1)
+      wvmask(:,:,1) = vmask(:,:,1)
+      DO jk = 2, jpk                   ! interior values
+         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
+         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)   
+         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
       END DO
 
-      ! 4. ocean/land mask for the elliptic equation
-      ! --------------------------------------------
-      bmask(:,:) = ssmask(:,:)       ! elliptic equation is written at t-point
-      !
-      !                               ! Boundary conditions
-      !                                    ! cyclic east-west : bmask must be set to 0. on rows 1 and jpi
-      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
-         bmask( 1 ,:) = 0._wp
-         bmask(jpi,:) = 0._wp
-      ENDIF
-      IF( nperio == 2 ) THEN               ! south symmetric :  bmask must be set to 0. on row 1
-         bmask(:, 1 ) = 0._wp
-      ENDIF
-      !                                    ! north fold : 
-      IF( nperio == 3 .OR. nperio == 4 ) THEN   ! T-pt pivot : bmask set to 0. on row jpj and on half jpjglo-1 row
-         DO ji = 1, jpi                      
-            ii = ji + nimpp - 1
-            bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii)
-            bmask(ji,jpj  ) = 0._wp
-         END DO
-      ENDIF
-      IF( nperio == 5 .OR. nperio == 6 ) THEN   ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj
-         bmask(:,jpj) = 0._wp
-      ENDIF
-      !
-      IF( lk_mpp ) THEN                    ! mpp specificities
-         !                                      ! bmask is set to zero on the overlap region
-         IF( nbondi /= -1 .AND. nbondi /= 2 )   bmask(  1 :jpreci,:) = 0._wp
-         IF( nbondi /=  1 .AND. nbondi /= 2 )   bmask(nlci:jpi   ,:) = 0._wp
-         IF( nbondj /= -1 .AND. nbondj /= 2 )   bmask(:,  1 :jprecj) = 0._wp
-         IF( nbondj /=  1 .AND. nbondj /= 2 )   bmask(:,nlcj:jpj   ) = 0._wp
-         !
-         IF( npolj == 3 .OR. npolj == 4 ) THEN  ! north fold : bmask must be set to 0. on rows jpj-1 and jpj
-            DO ji = 1, nlci
-               ii = ji + nimpp - 1
-               bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * tpol(ii)
-               bmask(ji,nlcj  ) = 0._wp
-            END DO
-         ENDIF
-         IF( npolj == 5 .OR. npolj == 6 ) THEN  ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj
-            DO ji = 1, nlci
-               bmask(ji,nlcj  ) = 0._wp
-            END DO
-         ENDIF
-      ENDIF
-
-
-      ! mask for second order calculation of vorticity
-      ! ----------------------------------------------
-      CALL dom_msk_nsa
-
-      
       ! Lateral boundary conditions on velocity (modify fmask)
       ! ---------------------------------------     
@@ -377,18 +279,16 @@
       IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA_R2 configuration
          !                                                 ! Increased lateral friction near of some straits
-         IF( nn_cla == 0 ) THEN
-            !                                ! Gibraltar strait  : partial slip (fmask=0.5)
-            ij0 = 101   ;   ij1 = 101
-            ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
-            ij0 = 102   ;   ij1 = 102
-            ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
-            !
-            !                                ! Bab el Mandeb : partial slip (fmask=1)
-            ij0 =  87   ;   ij1 =  88
-            ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
-            ij0 =  88   ;   ij1 =  88
-            ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
-            !
-         ENDIF
+         !                                ! Gibraltar strait  : partial slip (fmask=0.5)
+         ij0 = 101   ;   ij1 = 101
+         ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
+         ij0 = 102   ;   ij1 = 102
+         ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
+         !
+         !                                ! Bab el Mandeb : partial slip (fmask=1)
+         ij0 =  87   ;   ij1 =  88
+         ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
+         ij0 =  88   ;   ij1 =  88
+         ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
+         !
          !                                ! Danish straits  : strong slip (fmask > 2)
 ! We keep this as an example but it is instable in this case 
@@ -413,84 +313,39 @@
          IF(lwp) WRITE(numout,*) '      Gibraltar '
          ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait 
-         ij0 = 201 + isrow   ;   ij1 = 241 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+         ij0 = 241 - 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 = 208 + isrow   ;   ij1 = 248 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+         ij0 = 248 - 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 = 149 + isrow   ;   ij1 = 190 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+         ij0 = 189 - 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 = 124 + isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+         ij0 = 164 - 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 = 124 + isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+         ij0 = 164 - 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 = 124 + isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+         ij0 = 164 - 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 = 141 + isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+         ij0 = 181 - 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 = 141 + isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+         ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
          !
       ENDIF
       !
       CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
-
+      !
       ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 )
-            
-      IF( nprint == 1 .AND. lwp ) THEN      ! Control print
-         imsk(:,:) = INT( tmask_i(:,:) )
-         WRITE(numout,*) ' tmask_i : '
-         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
-               &                           1, jpj, 1, 1, numout)
-         WRITE (numout,*)
-         WRITE (numout,*) ' dommsk: tmask for each level'
-         WRITE (numout,*) ' ----------------------------'
-         DO jk = 1, jpk
-            imsk(:,:) = INT( tmask(:,:,jk) )
-
-            WRITE(numout,*)
-            WRITE(numout,*) ' level = ',jk
-            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
-               &                              1, jpj, 1, 1, numout)
-         END DO
-         WRITE(numout,*)
-         WRITE(numout,*) ' dom_msk: vmask for each level'
-         WRITE(numout,*) ' -----------------------------'
-         DO jk = 1, jpk
-            imsk(:,:) = INT( vmask(:,:,jk) )
-            WRITE(numout,*)
-            WRITE(numout,*) ' level = ',jk
-            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
-               &                              1, jpj, 1, 1, numout)
-         END DO
-         WRITE(numout,*)
-         WRITE(numout,*) ' dom_msk: fmask for each level'
-         WRITE(numout,*) ' -----------------------------'
-         DO jk = 1, jpk
-            imsk(:,:) = INT( fmask(:,:,jk) )
-            WRITE(numout,*)
-            WRITE(numout,*) ' level = ',jk
-            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
-               &                              1, jpj, 1, 1, numout )
-         END DO
-         WRITE(numout,*)
-         WRITE(numout,*) ' dom_msk: bmask '
-         WRITE(numout,*) ' ---------------'
-         WRITE(numout,*)
-         imsk(:,:) = INT( bmask(:,:) )
-         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
-            &                              1, jpj, 1, 1, numout )
-      ENDIF
       !
       CALL wrk_dealloc( jpi, jpj, imsk )
@@ -500,197 +355,4 @@
       !
    END SUBROUTINE dom_msk
-
-#if defined key_noslip_accurate
-   !!----------------------------------------------------------------------
-   !!   'key_noslip_accurate' :         accurate no-slip boundary condition
-   !!----------------------------------------------------------------------
-   
-   SUBROUTINE dom_msk_nsa
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE dom_msk_nsa  ***
-      !! 
-      !! ** Purpose :
-      !!
-      !! ** Method  :
-      !!
-      !! ** Action :
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk, jl      ! dummy loop indices
-      INTEGER  ::   ine, inw, ins, inn, itest, ierror, iind, ijnd
-      REAL(wp) ::   zaa
-      !!---------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dom_msk_nsa')
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   using Schchepetkin and O Brian scheme'
-      IF( lk_mpp )   CALL ctl_stop( ' mpp version is not yet implemented' )
-
-      ! mask for second order calculation of vorticity
-      ! ----------------------------------------------
-      ! noslip boundary condition: fmask=1  at convex corner, store
-      ! index of straight coast meshes ( 'west', refering to a coast,
-      ! means west of the ocean, aso)
-      
-      DO jk = 1, jpk
-         DO jl = 1, 4
-            npcoa(jl,jk) = 0
-            DO ji = 1, 2*(jpi+jpj)
-               nicoa(ji,jl,jk) = 0
-               njcoa(ji,jl,jk) = 0
-            END DO
-         END DO
-      END DO
-      
-      IF( jperio == 2 ) THEN
-         WRITE(numout,*) ' '
-         WRITE(numout,*) ' symetric boundary conditions need special'
-         WRITE(numout,*) ' treatment not implemented. we stop.'
-         STOP
-      ENDIF
-      
-      ! convex corners
-      
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zaa = tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   &
-                  &+ tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk)
-               IF( ABS(zaa-3._wp) <= 0.1_wp )   fmask(ji,jj,jk) = 1._wp
-            END DO
-         END DO
-      END DO
-
-      ! north-south straight coast
-
-      DO jk = 1, jpkm1
-         inw = 0
-         ine = 0
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               zaa = tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk)
-               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
-                  inw = inw + 1
-                  nicoa(inw,1,jk) = ji
-                  njcoa(inw,1,jk) = jj
-                  IF( nprint == 1 ) WRITE(numout,*) ' west  : ', jk, inw, ji, jj
-               ENDIF
-               zaa = tmask(ji,jj,jk) + tmask(ji,jj+1,jk)
-               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
-                  ine = ine + 1
-                  nicoa(ine,2,jk) = ji
-                  njcoa(ine,2,jk) = jj
-                  IF( nprint == 1 ) WRITE(numout,*) ' east  : ', jk, ine, ji, jj
-               ENDIF
-            END DO
-         END DO
-         npcoa(1,jk) = inw
-         npcoa(2,jk) = ine
-      END DO
-
-      ! west-east straight coast
-
-      DO jk = 1, jpkm1
-         ins = 0
-         inn = 0
-         DO jj = 2, jpjm1
-            DO ji =2, jpim1
-               zaa = tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk)
-               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
-                  ins = ins + 1
-                  nicoa(ins,3,jk) = ji
-                  njcoa(ins,3,jk) = jj
-                  IF( nprint == 1 ) WRITE(numout,*) ' south : ', jk, ins, ji, jj
-               ENDIF
-               zaa = tmask(ji+1,jj,jk) + tmask(ji,jj,jk)
-               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
-                  inn = inn + 1
-                  nicoa(inn,4,jk) = ji
-                  njcoa(inn,4,jk) = jj
-                  IF( nprint == 1 ) WRITE(numout,*) ' north : ', jk, inn, ji, jj
-               ENDIF
-            END DO
-         END DO
-         npcoa(3,jk) = ins
-         npcoa(4,jk) = inn
-      END DO
-
-      itest = 2 * ( jpi + jpj )
-      DO jk = 1, jpk
-         IF( npcoa(1,jk) > itest .OR. npcoa(2,jk) > itest .OR.   &
-             npcoa(3,jk) > itest .OR. npcoa(4,jk) > itest ) THEN
-            
-            WRITE(ctmp1,*) ' level jk = ',jk
-            WRITE(ctmp2,*) ' straight coast index arraies are too small.:'
-            WRITE(ctmp3,*) ' npe, npw, nps, npn = ', npcoa(1,jk), npcoa(2,jk),   &
-                &                                     npcoa(3,jk), npcoa(4,jk)
-            WRITE(ctmp4,*) ' 2*(jpi+jpj) = ',itest,'. we stop.'
-            CALL ctl_stop( ctmp1, ctmp2, ctmp3, ctmp4 )
-        ENDIF
-      END DO
-
-      ierror = 0
-      iind = 0
-      ijnd = 0
-      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 )   iind = 2
-      IF( nperio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6 )   ijnd = 2
-      DO jk = 1, jpk
-         DO jl = 1, npcoa(1,jk)
-            IF( nicoa(jl,1,jk)+3 > jpi+iind ) THEN
-               ierror = ierror+1
-               icoord(ierror,1) = nicoa(jl,1,jk)
-               icoord(ierror,2) = njcoa(jl,1,jk)
-               icoord(ierror,3) = jk
-            ENDIF
-         END DO
-         DO jl = 1, npcoa(2,jk)
-            IF(nicoa(jl,2,jk)-2 < 1-iind ) THEN
-               ierror = ierror + 1
-               icoord(ierror,1) = nicoa(jl,2,jk)
-               icoord(ierror,2) = njcoa(jl,2,jk)
-               icoord(ierror,3) = jk
-            ENDIF
-         END DO
-         DO jl = 1, npcoa(3,jk)
-            IF( njcoa(jl,3,jk)+3 > jpj+ijnd ) THEN
-               ierror = ierror + 1
-               icoord(ierror,1) = nicoa(jl,3,jk)
-               icoord(ierror,2) = njcoa(jl,3,jk)
-               icoord(ierror,3) = jk
-            ENDIF
-         END DO
-         DO jl = 1, npcoa(4,jk)
-            IF( njcoa(jl,4,jk)-2 < 1) THEN
-               ierror=ierror + 1
-               icoord(ierror,1) = nicoa(jl,4,jk)
-               icoord(ierror,2) = njcoa(jl,4,jk)
-               icoord(ierror,3) = jk
-            ENDIF
-         END DO
-      END DO
-      
-      IF( ierror > 0 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '              Problem on lateral conditions'
-         IF(lwp) WRITE(numout,*) '                 Bad marking off at points:'
-         DO jl = 1, ierror
-            IF(lwp) WRITE(numout,*) 'Level:',icoord(jl,3),   &
-               &                  '  Point(',icoord(jl,1),',',icoord(jl,2),')'
-         END DO
-         CALL ctl_stop( 'We stop...' )
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_msk_nsa')
-      !
-   END SUBROUTINE dom_msk_nsa
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :                                      Empty routine
-   !!----------------------------------------------------------------------
-   SUBROUTINE dom_msk_nsa       
-   END SUBROUTINE dom_msk_nsa
-#endif
    
    !!======================================================================
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90	(revision 6808)
@@ -28,5 +28,5 @@
 CONTAINS
 
-   SUBROUTINE dom_ngb( plon, plat, kii, kjj, cdgrid )
+   SUBROUTINE dom_ngb( plon, plat, kii, kjj, cdgrid, kkk )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE dom_ngb  ***
@@ -37,9 +37,10 @@
       !!                -> not good if located at too high latitude...
       !!----------------------------------------------------------------------
-      !
       REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
       INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
+      INTEGER         , INTENT(in   ), OPTIONAL :: kkk  ! k-index of the mask level used
       CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
       !
+      INTEGER :: ik         ! working level
       INTEGER , DIMENSION(2) ::   iloc
       REAL(wp)               ::   zlon, zmini
@@ -49,20 +50,26 @@
       IF( nn_timing == 1 )  CALL timing_start('dom_ngb')
       !
-      CALL wrk_alloc( jpi, jpj, zglam, zgphi, zmask, zdist )
+      CALL wrk_alloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
       !
       zmask(:,:) = 0._wp
+      ik = 1
+      IF ( PRESENT(kkk) ) ik=kkk
       SELECT CASE( cdgrid )
-      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,1)
-      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,1)
-      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,1)
-      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,1)
+      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik)
+      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik)
+      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik)
+      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik)
       END SELECT
 
-      zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
-      zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
-      IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270
-      IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
+      IF (jphgr_msh /= 2 .AND. jphgr_msh /= 3) THEN
+         zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
+         zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
+         IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270
+         IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
+         zglam(:,:) = zglam(:,:) - zlon
+      ELSE
+         zglam(:,:) = zglam(:,:) - plon
+      END IF
 
-      zglam(:,:) = zglam(:,:) - zlon
       zgphi(:,:) = zgphi(:,:) - plat
       zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
@@ -76,5 +83,5 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, zglam, zgphi, zmask, zdist )
+      CALL wrk_dealloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
       !
       IF( nn_timing == 1 )  CALL timing_stop('dom_ngb')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90	(revision 6808)
@@ -22,6 +22,4 @@
    PUBLIC   dom_stp   ! routine called by inidom.F90
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -41,17 +39,9 @@
       !!      filter parameter read in namelist
       !!              - Model time step:
-      !!      nacc = 0 : synchronous time intergration. 
-      !!      There is one time step only, defined by: rdt, rdttra(k)=rdt
-      !!      nacc = 1 : accelerating the convergence. There is 2 different
-      !!      time steps for dynamics and tracers:
-      !!        rdt      : dynamical part
-      !!        rdttra(k): temperature and salinity
-      !!      The tracer time step is a function of vertical level. the model
-      !!      reference time step ( i.e. for wind stress, surface heat and
-      !!      salt fluxes) is the surface tracer time step is rdttra(1).
-      !!         N.B. depth dependent acceleration of convergence is not im-
-      !!      plemented for s-coordinate.
+      !!                synchronous time intergration.
+      !!      There is one time step only, defined by: rdt for dynamics and
+      !!      tracer,wind stress, surface heat and salt fluxes
       !!
-      !! ** Action  : - rdttra   : vertical profile of tracer time step
+      !! ** Action  : [REMOVED - rdttra: vertical profile of tracer time step]
       !!              - atfp1    : = 1 - 2*atfp
       !!
@@ -72,37 +62,7 @@
       atfp1 = 1. - 2. * atfp
 
-      SELECT CASE ( nacc )
+      IF(lwp) WRITE(numout,*)'               synchronous time stepping'
+      IF(lwp) WRITE(numout,*)'               dynamics and tracer time step = ', rdt/3600., ' hours'
 
-         CASE ( 0 )                ! Synchronous time stepping
-            IF(lwp) WRITE(numout,*)'               synchronous time stepping'
-            IF(lwp) WRITE(numout,*)'               dynamics and tracer time step = ', rdt/3600., ' hours'
-
-            rdttra(:) = rdt
-
-         CASE ( 1 )                ! Accelerating the convergence
-            IF(lwp) WRITE(numout,*) '              no tracer damping in the turbocline'
-            IF(lwp) WRITE(numout,*)'               accelerating the convergence'
-            IF(lwp) WRITE(numout,*)'               dynamics time step = ', rdt/3600., ' hours'
-            IF( ln_sco .AND. rdtmin /= rdtmax .AND. lk_vvl )   &
-                 & CALL ctl_stop ( ' depth dependent acceleration of convergence not implemented in s-coordinates &
-                 &                   nor in variable volume' )
-            IF(lwp) WRITE(numout,*)'         tracers   time step :  dt (hours)  level'
-
-            DO jk = 1, jpk
-               IF( gdept_1d(jk) <= rdth ) rdttra(jk) = rdtmin
-               IF( gdept_1d(jk) >  rdth ) THEN
-                  rdttra(jk) = rdtmin + ( rdtmax - rdtmin )   &
-                                      * ( EXP( ( gdept_1d(jk ) - rdth ) / rdth ) - 1. )   &
-                                      / ( EXP( ( gdept_1d(jpk) - rdth ) / rdth ) - 1. )
-               ENDIF
-               IF(lwp) WRITE(numout,"(36x,f5.2,5x,i3)") rdttra(jk)/3600., jk
-            END DO  
-
-         CASE DEFAULT              ! E R R O R 
-
-            WRITE(ctmp1,*) ' nacc value e r r o r, nacc= ',nacc
-            CALL ctl_stop( ctmp1 )
-
-      END SELECT
 
    END SUBROUTINE dom_stp
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 6808)
@@ -10,6 +10,5 @@
    !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability
    !!----------------------------------------------------------------------
-   !!   'key_vvl'                              variable volume
-   !!----------------------------------------------------------------------
+
    !!----------------------------------------------------------------------
    !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness
@@ -19,14 +18,14 @@
    !!   dom_vvl_rst      : read/write restart file
    !!   dom_vvl_ctl      : Check the vvl options
-   !!   dom_vvl_orca_fix : Recompute some area-weighted interpolations of vertical scale factors 
-   !!                    : to account for manual changes to e[1,2][u,v] in some Straits 
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers
+   USE phycst          ! physical constant
    USE dom_oce         ! ocean space and time domain
    USE sbc_oce         ! ocean surface boundary condition
+   USE wet_dry         ! wetting and drying
+   USE restart         ! ocean restart
+   !
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O manager library
-   USE restart         ! ocean restart
    USE lib_mpp         ! distributed memory computing library
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
@@ -37,42 +36,37 @@
    PRIVATE
 
-   !! * Routine accessibility
    PUBLIC  dom_vvl_init       ! called by domain.F90
    PUBLIC  dom_vvl_sf_nxt     ! called by step.F90
    PUBLIC  dom_vvl_sf_swp     ! called by step.F90
    PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90
-   PRIVATE dom_vvl_orca_fix   ! called by dom_vvl_interpol
-
-   !!* Namelist nam_vvl
-   LOGICAL , PUBLIC                                      :: ln_vvl_zstar = .FALSE.              ! zstar  vertical coordinate
-   LOGICAL , PUBLIC                                      :: ln_vvl_ztilde = .FALSE.             ! ztilde vertical coordinate
-   LOGICAL , PUBLIC                                      :: ln_vvl_layer = .FALSE.              ! level  vertical coordinate
-   LOGICAL , PUBLIC                                      :: ln_vvl_ztilde_as_zstar = .FALSE.    ! ztilde vertical coordinate
-   LOGICAL , PUBLIC                                      :: ln_vvl_zstar_at_eqtor = .FALSE.     ! ztilde vertical coordinate
-   LOGICAL , PUBLIC                                      :: ln_vvl_kepe = .FALSE.               ! kinetic/potential energy transfer
-   !                                                                                            ! conservation: not used yet
-   REAL(wp)                                              :: rn_ahe3                   ! thickness diffusion coefficient
-   REAL(wp)                                              :: rn_rst_e3t                ! ztilde to zstar restoration timescale [days]
-   REAL(wp)                                              :: rn_lf_cutoff              ! cutoff frequency for low-pass filter  [days]
-   REAL(wp)                                              :: rn_zdef_max               ! maximum fractional e3t deformation
-   LOGICAL , PUBLIC                                      :: ln_vvl_dbg = .FALSE.      ! debug control prints
-
-   !! * Module variables
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                       ! thickness diffusion transport
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf                            ! low frequency part of hz divergence
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n           ! baroclinic scale factors
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a          ! baroclinic scale factors
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_e3t                        ! retoring period for scale factors
-   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                        ! retoring period for low freq. divergence
+
+   !                                                      !!* Namelist nam_vvl
+   LOGICAL , PUBLIC :: ln_vvl_zstar           = .FALSE.    ! zstar  vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_ztilde          = .FALSE.    ! ztilde vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_layer           = .FALSE.    ! level  vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar = .FALSE.    ! ztilde vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor  = .FALSE.    ! ztilde vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_kepe            = .FALSE.    ! kinetic/potential energy transfer
+   !                                                       ! conservation: not used yet
+   REAL(wp)         :: rn_ahe3                             ! thickness diffusion coefficient
+   REAL(wp)         :: rn_rst_e3t                          ! ztilde to zstar restoration timescale [days]
+   REAL(wp)         :: rn_lf_cutoff                        ! cutoff frequency for low-pass filter  [days]
+   REAL(wp)         :: rn_zdef_max                         ! maximum fractional e3t deformation
+   LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE.                ! debug control prints
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                ! thickness diffusion transport
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf                     ! low frequency part of hz divergence
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n    ! baroclinic scale factors
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a   ! baroclinic scale factors
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_e3t                 ! retoring period for scale factors
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO-Consortium (2010) 
+   !! NEMO/OPA 3.7 , NEMO-Consortium (2015) 
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -81,5 +75,5 @@
       !!                ***  FUNCTION dom_vvl_alloc  ***
       !!----------------------------------------------------------------------
-      IF( ln_vvl_zstar ) dom_vvl_alloc = 0
+      IF( ln_vvl_zstar )   dom_vvl_alloc = 0
       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
          ALLOCATE( tilde_e3t_b(jpi,jpj,jpk)  , tilde_e3t_n(jpi,jpj,jpk) , tilde_e3t_a(jpi,jpj,jpk) ,   &
@@ -88,6 +82,6 @@
          IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc )
          IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays')
-         un_td = 0.0_wp
-         vn_td = 0.0_wp
+         un_td = 0._wp
+         vn_td = 0._wp
       ENDIF
       IF( ln_vvl_ztilde ) THEN
@@ -96,5 +90,5 @@
          IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays')
       ENDIF
-
+      !
    END FUNCTION dom_vvl_alloc
 
@@ -110,11 +104,11 @@
       !!               - interpolate scale factors
       !!
-      !! ** Action  : - fse3t_(n/b) and tilde_e3t_(n/b)
-      !!              - Regrid: fse3(u/v)_n
-      !!                        fse3(u/v)_b       
-      !!                        fse3w_n           
-      !!                        fse3(u/v)w_b      
-      !!                        fse3(u/v)w_n      
-      !!                        fsdept_n, fsdepw_n and fsde3w_n
+      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b)
+      !!              - Regrid: e3(u/v)_n
+      !!                        e3(u/v)_b       
+      !!                        e3w_n           
+      !!                        e3(u/v)w_b      
+      !!                        e3(u/v)w_n      
+      !!                        gdept_n, gdepw_n and gde3w_n
       !!              - h(t/u/v)_0
       !!              - frq_rst_e3t and frq_rst_hdv
@@ -122,108 +116,110 @@
       !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling.
       !!----------------------------------------------------------------------
-      USE phycst,  ONLY : rpi, rsmall, rad
-      !! * Local declarations
-      INTEGER ::   ji,jj,jk
+      INTEGER ::   ji, jj, jk
       INTEGER ::   ii0, ii1, ij0, ij1
       REAL(wp)::   zcoef
       !!----------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_init')
-
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_init')
+      !
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-
-      ! choose vertical coordinate (z_star, z_tilde or layer)
-      ! ==========================
-      CALL dom_vvl_ctl
-
-      ! Allocate module arrays
-      ! ======================
+      !
+      CALL dom_vvl_ctl     ! choose vertical coordinate (z_star, z_tilde or layer)
+      !
+      !                    ! Allocate module arrays
       IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )
-
-      ! Read or initialize fse3t_(b/n), tilde_e3t_(b/n) and hdiv_lf (and e3t_a(jpk))
-      ! ============================================================================
+      !
+      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf
       CALL dom_vvl_rst( nit000, 'READ' )
-      fse3t_a(:,:,jpk) = e3t_0(:,:,jpk)
-
-      ! Reconstruction of all vertical scale factors at now and before time steps
-      ! =============================================================================
-      ! Horizontal scale factor interpolations
-      ! --------------------------------------
-      CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' )
-      CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' )
-      CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' )
-      CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' )
-      CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' )
-      ! Vertical scale factor interpolations
-      ! ------------------------------------
-      CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W'  )
-      CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' )
-      CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' )
-      CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3w_b (:,:,:), 'W'  )
-      CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' )
-      CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' )
-      ! t- and w- points depth
-      ! ----------------------
-      ! set the isf depth as it is in the initial step
-      fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)
-      fsdepw_n(:,:,1) = 0.0_wp
-      fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:)
-      fsdept_b(:,:,1) = 0.5_wp * fse3w_b(:,:,1)
-      fsdepw_b(:,:,1) = 0.0_wp
-
-      DO jk = 2, jpk
+      e3t_a(:,:,jpk) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all
+      !
+      !                    !== Set of all other vertical scale factors  ==!  (now and before)
+      !                                ! Horizontal interpolation of e3t
+      CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )    ! from T to U
+      CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+      CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )    ! from T to V 
+      CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )    ! from U to F
+      !                                ! Vertical interpolation of e3t,u,v 
+      CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )  ! from T to W
+      CALL dom_vvl_interpol( e3t_b(:,:,:), e3w_b (:,:,:), 'W'  )
+      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )  ! from U to UW
+      CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
+      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )  ! from V to UW
+      CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+      !
+      !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep)
+      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)       ! reference to the ocean surface (used for MLD and light penetration)
+      gdepw_n(:,:,1) = 0.0_wp
+      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)  ! reference to a common level z=0 for hpg
+      gdept_b(:,:,1) = 0.5_wp * e3w_b(:,:,1)
+      gdepw_b(:,:,1) = 0.0_wp
+      DO jk = 2, jpk                               ! vertical sum
          DO jj = 1,jpj
             DO ji = 1,jpi
-              !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
-                                                     ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
-                                                     ! 0.5 where jk = mikt  
-               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
-               fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1)
-               fsdept_n(ji,jj,jk) =      zcoef  * ( fsdepw_n(ji,jj,jk  ) + 0.5 * fse3w_n(ji,jj,jk))  &
-                   &                + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) +       fse3w_n(ji,jj,jk)) 
-               fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk) - sshn(ji,jj)
-               fsdepw_b(ji,jj,jk) = fsdepw_b(ji,jj,jk-1) + fse3t_b(ji,jj,jk-1)
-               fsdept_b(ji,jj,jk) =      zcoef  * ( fsdepw_b(ji,jj,jk  ) + 0.5 * fse3w_b(ji,jj,jk))  &
-                   &                + (1-zcoef) * ( fsdept_b(ji,jj,jk-1) +       fse3w_b(ji,jj,jk)) 
+               !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+               !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
+               !                             ! 0.5 where jk = mikt     
+!!gm ???????   BUG ?  gdept_n as well as gde3w_n  does not include the thickness of ISF ??
+               zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) )
+               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
+               gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  &
+                  &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk)) 
+               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj)
+               gdepw_b(ji,jj,jk) = gdepw_b(ji,jj,jk-1) + e3t_b(ji,jj,jk-1)
+               gdept_b(ji,jj,jk) =      zcoef  * ( gdepw_b(ji,jj,jk  ) + 0.5 * e3w_b(ji,jj,jk))  &
+                  &                + (1-zcoef) * ( gdept_b(ji,jj,jk-1) +       e3w_b(ji,jj,jk)) 
             END DO
          END DO
       END DO
-
-      ! Before depth and Inverse of the local depth of the water column at u- and v- points
-      ! -----------------------------------------------------------------------------------
-      hu_b(:,:) = 0.
-      hv_b(:,:) = 0.
-      DO jk = 1, jpkm1
-         hu_b(:,:) = hu_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk)
-         hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk)
+      !
+      !                    !==  thickness of the water column  !!   (ocean portion only)
+      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) ....
+      hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1)
+      hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1)
+      hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1)
+      hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1)
+      DO jk = 2, jpkm1
+         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
+         hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk)
+         hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
+         hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk)
+         hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
       END DO
-      hur_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1. - umask_i(:,:) )
-      hvr_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1. - vmask_i(:,:) )
-
-      ! Restoring frequencies for z_tilde coordinate
-      ! ============================================
+      !
+      !                    !==  inverse of water column thickness   ==!   (u- and v- points)
+      r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF
+      r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) )
+      r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) )
+      r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) )
+
+      !                    !==   z_tilde coordinate case  ==!   (Restoring frequencies)
       IF( ln_vvl_ztilde ) THEN
-         ! Values in days provided via the namelist; use rsmall to avoid possible division by zero errors with faulty settings
-         frq_rst_e3t(:,:) = 2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.0_wp )
-         frq_rst_hdv(:,:) = 2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp )
-         IF( ln_vvl_ztilde_as_zstar ) THEN
-            ! Ignore namelist settings and use these next two to emulate z-star using z-tilde
-            frq_rst_e3t(:,:) = 0.0_wp 
-            frq_rst_hdv(:,:) = 1.0_wp / rdt
+!!gm : idea: add here a READ in a file of custumized restoring frequency
+         !                                   ! Values in days provided via the namelist
+         !                                   ! use rsmall to avoid possible division by zero errors with faulty settings
+         frq_rst_e3t(:,:) = 2._wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.0_wp )
+         frq_rst_hdv(:,:) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp )
+         !
+         IF( ln_vvl_ztilde_as_zstar ) THEN   ! z-star emulation using z-tile
+            frq_rst_e3t(:,:) = 0._wp               !Ignore namelist settings
+            frq_rst_hdv(:,:) = 1._wp / rdt
          ENDIF
-         IF ( ln_vvl_zstar_at_eqtor ) THEN
+         IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator
             DO jj = 1, jpj
                DO ji = 1, jpi
+!!gm  case |gphi| >= 6 degrees is useless   initialized just above by default
                   IF( ABS(gphit(ji,jj)) >= 6.) THEN
                      ! values outside the equatorial band and transition zone (ztilde)
                      frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp )
                      frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp )
-                  ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN
+                  ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star
                      ! values inside the equatorial band (ztilde as zstar)
                      frq_rst_e3t(ji,jj) =  0.0_wp
                      frq_rst_hdv(ji,jj) =  1.0_wp / rdt
-                  ELSE
-                     ! values in the transition band (linearly vary from ztilde to ztilde as zstar values)
+                  ELSE                                      ! transition band (2.5 to 6 degrees N/S)
+                     !                                      ! (linearly transition from z-tilde to z-star)
                      frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   &
                         &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
@@ -236,6 +232,6 @@
                END DO
             END DO
-            IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN
-               ii0 = 103   ;   ii1 = 111        ! Suppress ztilde in the Foxe Basin for ORCA2
+            IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2
+               ii0 = 103   ;   ii1 = 111       
                ij0 = 128   ;   ij1 = 135   ;   
                frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp
@@ -244,7 +240,7 @@
          ENDIF
       ENDIF
-
+      !
       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_init')
-
+      !
    END SUBROUTINE dom_vvl_init
 
@@ -268,25 +264,27 @@
       !!               - tilde_e3t_a: after increment of vertical scale factor 
       !!                              in z_tilde case
-      !!               - fse3(t/u/v)_a
+      !!               - e3(t/u/v)_a
       !!
       !! Reference  : Leclair, M., and Madec, G. 2011, Ocean Modelling.
       !!----------------------------------------------------------------------
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zht, z_scale, zwu, zwv, zhdiv
-      !! * Arguments
-      INTEGER, INTENT( in )                  :: kt                    ! time step
-      INTEGER, INTENT( in ), OPTIONAL        :: kcall                 ! optional argument indicating call sequence
-      !! * Local declarations
-      INTEGER                                :: ji, jj, jk            ! dummy loop indices
-      INTEGER , DIMENSION(3)                 :: ijk_max, ijk_min      ! temporary integers
-      REAL(wp)                               :: z2dt                  ! temporary scalars
-      REAL(wp)                               :: z_tmin, z_tmax        ! temporary scalars
-      LOGICAL                                :: ll_do_bclinic         ! temporary logical
-      !!----------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_sf_nxt')
-      CALL wrk_alloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv )
-      CALL wrk_alloc( jpi, jpj, jpk, ze3t                     )
-
-      IF(kt == nit000)   THEN
+      INTEGER, INTENT( in )           ::   kt      ! time step
+      INTEGER, INTENT( in ), OPTIONAL ::   kcall   ! optional argument indicating call sequence
+      !
+      INTEGER                ::   ji, jj, jk            ! dummy loop indices
+      INTEGER , DIMENSION(3) ::   ijk_max, ijk_min      ! temporary integers
+      REAL(wp)               ::   z2dt, z_tmin, z_tmax  ! local scalars
+      LOGICAL                ::   ll_do_bclinic         ! local logical
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zht, z_scale, zwu, zwv, zhdiv
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_linssh )   RETURN      ! No calculation in linear free surface
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_sf_nxt')
+      !
+      CALL wrk_alloc( jpi,jpj,zht,   z_scale, zwu, zwv, zhdiv )
+      CALL wrk_alloc( jpi,jpj,jpk,   ze3t )
+
+      IF( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'dom_vvl_sf_nxt : compute after scale factors'
@@ -296,5 +294,5 @@
       ll_do_bclinic = .TRUE.
       IF( PRESENT(kcall) ) THEN
-         IF ( kcall == 2 .AND. ln_vvl_ztilde ) ll_do_bclinic = .FALSE.
+         IF( kcall == 2 .AND. ln_vvl_ztilde )   ll_do_bclinic = .FALSE.
       ENDIF
 
@@ -302,18 +300,16 @@
       ! After acale factors at t-points !
       ! ******************************* !
-
       !                                                ! --------------------------------------------- !
-                                                       ! z_star coordinate and barotropic z-tilde part !
+      !                                                ! z_star coordinate and barotropic z-tilde part !
       !                                                ! --------------------------------------------- !
-
+      !
       z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) )
       DO jk = 1, jpkm1
-         ! formally this is the same as fse3t_a = e3t_0*(1+ssha/ht_0)
-         fse3t_a(:,:,jk) = fse3t_b(:,:,jk) + fse3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)
+         ! formally this is the same as e3t_a = e3t_0*(1+ssha/ht_0)
+         e3t_a(:,:,jk) = e3t_b(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)
       END DO
-
+      !
       IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate !
          !                                                            ! ------baroclinic part------ !
-
          ! I - initialization
          ! ==================
@@ -321,9 +317,9 @@
          ! 1 - barotropic divergence
          ! -------------------------
-         zhdiv(:,:) = 0.
-         zht(:,:)   = 0.
+         zhdiv(:,:) = 0._wp
+         zht(:,:)   = 0._wp
          DO jk = 1, jpkm1
-            zhdiv(:,:) = zhdiv(:,:) + fse3t_n(:,:,jk) * hdivn(:,:,jk)
-            zht  (:,:) = zht  (:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk)
+            zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk)
+            zht  (:,:) = zht  (:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
          END DO
          zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask_i(:,:) )
@@ -332,15 +328,15 @@
          ! --------------------------------------------------
          IF( ln_vvl_ztilde ) THEN
-            IF( kt .GT. nit000 ) THEN
+            IF( kt > nit000 ) THEN
                DO jk = 1, jpkm1
                   hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:)   &
-                     &          * ( hdiv_lf(:,:,jk) - fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) )
+                     &          * ( hdiv_lf(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) )
                END DO
             ENDIF
-         END IF
+         ENDIF
 
          ! II - after z_tilde increments of vertical scale factors
          ! =======================================================
-         tilde_e3t_a(:,:,:) = 0.0_wp  ! tilde_e3t_a used to store tendency terms
+         tilde_e3t_a(:,:,:) = 0._wp  ! tilde_e3t_a used to store tendency terms
 
          ! 1 - High frequency divergence term
@@ -348,11 +344,11 @@
          IF( ln_vvl_ztilde ) THEN     ! z_tilde case
             DO jk = 1, jpkm1
-               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) )
+               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) )
             END DO
          ELSE                         ! layer case
             DO jk = 1, jpkm1
-               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk)
-            END DO
-         END IF
+               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk)
+            END DO
+         ENDIF
 
          ! 2 - Restoring term (z-tilde case only)
@@ -362,18 +358,17 @@
                tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - frq_rst_e3t(:,:) * tilde_e3t_b(:,:,jk)
             END DO
-         END IF
+         ENDIF
 
          ! 3 - Thickness diffusion term
          ! ----------------------------
-         zwu(:,:) = 0.0_wp
-         zwv(:,:) = 0.0_wp
-         ! a - first derivative: diffusive fluxes
-         DO jk = 1, jpkm1
+         zwu(:,:) = 0._wp
+         zwv(:,:) = 0._wp
+         DO jk = 1, jpkm1        ! a - first derivative: diffusive fluxes
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * re2u_e1u(ji,jj) &
-                                  & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) )
-                  vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * re1v_e2v(ji,jj) & 
-                                  & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) )
+                  un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           &
+                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) )
+                  vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           & 
+                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) )
                   zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk)
                   zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk)
@@ -381,6 +376,5 @@
             END DO
          END DO
-         ! b - correction for last oceanic u-v points
-         DO jj = 1, jpj
+         DO jj = 1, jpj          ! b - correction for last oceanic u-v points
             DO ji = 1, jpi
                un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj)
@@ -388,16 +382,15 @@
             END DO
          END DO
-         ! c - second derivative: divergence of diffusive fluxes
-         DO jk = 1, jpkm1
+         DO jk = 1, jpkm1        ! c - second derivative: divergence of diffusive fluxes
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    &
                      &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    &
-                     &                                            ) * r1_e12t(ji,jj)
+                     &                                            ) * r1_e1e2t(ji,jj)
                END DO
             END DO
          END DO
-         ! d - thickness diffusion transport: boundary conditions
-         !     (stored for tracer advction and continuity equation)
+         !                       ! d - thickness diffusion transport: boundary conditions
+         !                             (stored for tracer advction and continuity equation)
          CALL lbc_lnk( un_td , 'U' , -1._wp)
          CALL lbc_lnk( vn_td , 'V' , -1._wp)
@@ -417,5 +410,5 @@
          ! Maximum deformation control
          ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-         ze3t(:,:,jpk) = 0.0_wp
+         ze3t(:,:,jpk) = 0._wp
          DO jk = 1, jpkm1
             ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
@@ -426,5 +419,5 @@
          IF( lk_mpp )   CALL mpp_min( z_tmin )                 ! min over the global domain
          ! - ML - test: for the moment, stop simulation for too large e3_t variations
-         IF( ( z_tmax .GT. rn_zdef_max ) .OR. ( z_tmin .LT. - rn_zdef_max ) ) THEN
+         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN
             IF( lk_mpp ) THEN
                CALL mpp_maxloc( ze3t, tmask, z_tmax, ijk_max(1), ijk_max(2), ijk_max(3) )
@@ -469,5 +462,5 @@
          z_scale(:,:) =  - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) )
          DO jk = 1, jpkm1
-            dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + fse3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)
+            dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)
          END DO
 
@@ -477,5 +470,5 @@
       !                                           ! ---baroclinic part--------- !
          DO jk = 1, jpkm1
-            fse3t_a(:,:,jk) = fse3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk)
+            e3t_a(:,:,jk) = e3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk)
          END DO
       ENDIF
@@ -492,25 +485,25 @@
          zht(:,:) = 0.0_wp
          DO jk = 1, jpkm1
-            zht(:,:) = zht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk)
+            zht(:,:) = zht(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
          END DO
          z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) )
          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(fse3t_n))) =', z_tmax
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax
          !
          zht(:,:) = 0.0_wp
          DO jk = 1, jpkm1
-            zht(:,:) = zht(:,:) + fse3t_a(:,:,jk) * tmask(:,:,jk)
+            zht(:,:) = zht(:,:) + e3t_a(:,:,jk) * tmask(:,:,jk)
          END DO
          z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) )
          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(fse3t_a))) =', z_tmax
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax
          !
          zht(:,:) = 0.0_wp
          DO jk = 1, jpkm1
-            zht(:,:) = zht(:,:) + fse3t_b(:,:,jk) * tmask(:,:,jk)
+            zht(:,:) = zht(:,:) + e3t_b(:,:,jk) * tmask(:,:,jk)
          END DO
          z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) )
          IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
-         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(fse3t_b))) =', z_tmax
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t_b))) =', z_tmax
          !
          z_tmax = MAXVAL( tmask(:,:,1) *  ABS( sshb(:,:) ) )
@@ -531,6 +524,6 @@
       ! *********************************** !
 
-      CALL dom_vvl_interpol( fse3t_a(:,:,:), fse3u_a(:,:,:), 'U' )
-      CALL dom_vvl_interpol( fse3t_a(:,:,:), fse3v_a(:,:,:), 'V' )
+      CALL dom_vvl_interpol( e3t_a(:,:,:), e3u_a(:,:,:), 'U' )
+      CALL dom_vvl_interpol( e3t_a(:,:,:), e3v_a(:,:,:), 'V' )
 
       ! *********************************** !
@@ -538,19 +531,20 @@
       ! *********************************** !
 
-      hu_a(:,:) = 0._wp                        ! Ocean depth at U-points
-      hv_a(:,:) = 0._wp                        ! Ocean depth at V-points
-      DO jk = 1, jpkm1
-         hu_a(:,:) = hu_a(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk)
-         hv_a(:,:) = hv_a(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk)
+      hu_a(:,:) = e3u_a(:,:,1) * umask(:,:,1)
+      hv_a(:,:) = e3v_a(:,:,1) * vmask(:,:,1)
+      DO jk = 2, jpkm1
+         hu_a(:,:) = hu_a(:,:) + e3u_a(:,:,jk) * umask(:,:,jk)
+         hv_a(:,:) = hv_a(:,:) + e3v_a(:,:,jk) * vmask(:,:,jk)
       END DO
       !                                        ! Inverse of the local depth
-      hur_a(:,:) = 1._wp / ( hu_a(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:)
-      hvr_a(:,:) = 1._wp / ( hv_a(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:)
-
-      CALL wrk_dealloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv )
-      CALL wrk_dealloc( jpi, jpj, jpk, ze3t                     )
-
+!!gm BUG ?  don't understand the use of umask_i here .....
+      r1_hu_a(:,:) = ssumask(:,:) / ( hu_a(:,:) + 1._wp - ssumask(:,:) )
+      r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) )
+      !
+      CALL wrk_dealloc( jpi,jpj,       zht, z_scale, zwu, zwv, zhdiv )
+      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t )
+      !
       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_sf_nxt')
-
+      !
    END SUBROUTINE dom_vvl_sf_nxt
 
@@ -568,11 +562,11 @@
       !!               - recompute depths and water height fields
       !!
-      !! ** Action  :  - fse3t_(b/n), tilde_e3t_(b/n) and fse3(u/v)_n ready for next time step
+      !! ** Action  :  - e3t_(b/n), tilde_e3t_(b/n) and e3(u/v)_n ready for next time step
       !!               - Recompute:
-      !!                    fse3(u/v)_b       
-      !!                    fse3w_n           
-      !!                    fse3(u/v)w_b      
-      !!                    fse3(u/v)w_n      
-      !!                    fsdept_n, fsdepw_n  and fsde3w_n
+      !!                    e3(u/v)_b       
+      !!                    e3w_n           
+      !!                    e3(u/v)w_b      
+      !!                    e3(u/v)w_n      
+      !!                    gdept_n, gdepw_n  and gde3w_n
       !!                    h(u/v) and h(u/v)r
       !!
@@ -580,11 +574,12 @@
       !!              Leclair, M., and G. Madec, 2011, Ocean Modelling.
       !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in )               :: kt       ! time step
-      !! * Local declarations
-      INTEGER                             :: ji,jj,jk       ! dummy loop indices
-      REAL(wp)                            :: zcoef
-      !!----------------------------------------------------------------------
-
+      INTEGER, INTENT( in ) ::   kt   ! time step
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zcoef        ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_linssh )   RETURN      ! No calculation in linear free surface
+      !
       IF( nn_timing == 1 )  CALL timing_start('dom_vvl_sf_swp')
       !
@@ -597,5 +592,5 @@
       ! Time filter and swap of scale factors
       ! =====================================
-      ! - ML - fse3(t/u/v)_b are allready computed in dynnxt.
+      ! - ML - e3(t/u/v)_b are allready computed in dynnxt.
       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
          IF( neuler == 0 .AND. kt == nit000 ) THEN
@@ -607,10 +602,10 @@
          tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:)
       ENDIF
-      fsdept_b(:,:,:) = fsdept_n(:,:,:)
-      fsdepw_b(:,:,:) = fsdepw_n(:,:,:)
-
-      fse3t_n(:,:,:) = fse3t_a(:,:,:)
-      fse3u_n(:,:,:) = fse3u_a(:,:,:)
-      fse3v_n(:,:,:) = fse3v_a(:,:,:)
+      gdept_b(:,:,:) = gdept_n(:,:,:)
+      gdepw_b(:,:,:) = gdepw_n(:,:,:)
+
+      e3t_n(:,:,:) = e3t_a(:,:,:)
+      e3u_n(:,:,:) = e3u_a(:,:,:)
+      e3v_n(:,:,:) = e3v_a(:,:,:)
 
       ! Compute all missing vertical scale factor and depths
@@ -618,22 +613,21 @@
       ! Horizontal scale factor interpolations
       ! --------------------------------------
-      ! - ML - fse3u_b and fse3v_b are allready computed in dynnxt
+      ! - ML - e3u_b and e3v_b are allready computed in dynnxt
       ! - JC - hu_b, hv_b, hur_b, hvr_b also
-      CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n (:,:,:), 'F'  )
+      
+      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F'  )
+      
       ! Vertical scale factor interpolations
-      ! ------------------------------------
-      CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W'  )
-      CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' )
-      CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' )
-      CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3w_b (:,:,:), 'W'  )
-      CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' )
-      CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' )
-      ! t- and w- points depth
-      ! ----------------------
-      ! set the isf depth as it is in the initial step
-      fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)
-      fsdepw_n(:,:,1) = 0.0_wp
-      fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:)
-
+      CALL dom_vvl_interpol( e3t_n(:,:,:),  e3w_n(:,:,:), 'W'  )
+      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
+      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
+      CALL dom_vvl_interpol( e3t_b(:,:,:),  e3w_b(:,:,:), 'W'  )
+      CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
+      CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+
+      ! t- and w- points depth (set the isf depth as it is in the initial step)
+      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+      gdepw_n(:,:,1) = 0.0_wp
+      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
       DO jk = 2, jpk
          DO jj = 1,jpj
@@ -642,44 +636,38 @@
                                                                  ! 1 for jk = mikt
                zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
-               fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1)
-               fsdept_n(ji,jj,jk) =      zcoef  * ( fsdepw_n(ji,jj,jk  ) + 0.5 * fse3w_n(ji,jj,jk))  &
-                   &                + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) +       fse3w_n(ji,jj,jk)) 
-               fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk) - sshn(ji,jj)
+               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
+               gdept_n(ji,jj,jk) =    zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk) )  &
+                   &             + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk) ) 
+               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj)
             END DO
          END DO
       END DO
 
-      ! Local depth and Inverse of the local depth of the water column at u- and v- points
-      ! ----------------------------------------------------------------------------------
-      hu (:,:) = hu_a (:,:)
-      hv (:,:) = hv_a (:,:)
-
-      ! Inverse of the local depth
-      hur(:,:) = hur_a(:,:)
-      hvr(:,:) = hvr_a(:,:)
-
-      ! Local depth of the water column at t- points
-      ! --------------------------------------------
-      ht(:,:) = 0.
-      DO jk = 1, jpkm1
-         ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk)
+      ! Local depth and Inverse of the local depth of the water
+      ! -------------------------------------------------------
+      hu_n(:,:) = hu_a(:,:)   ;   r1_hu_n(:,:) = r1_hu_a(:,:)
+      hv_n(:,:) = hv_a(:,:)   ;   r1_hv_n(:,:) = r1_hv_a(:,:)
+      !
+      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)
+      DO jk = 2, jpkm1
+         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
       END DO
 
       ! Write outputs
       ! =============
-      CALL iom_put(     "e3t" , fse3t_n  (:,:,:) )
-      CALL iom_put(     "e3u" , fse3u_n  (:,:,:) )
-      CALL iom_put(     "e3v" , fse3v_n  (:,:,:) )
-      CALL iom_put(     "e3w" , fse3w_n  (:,:,:) )
-      CALL iom_put( "tpt_dep" , fsde3w_n (:,:,:) )
+      CALL iom_put(     "e3t",   e3t_n(:,:,:) )
+      CALL iom_put(     "e3u",   e3u_n(:,:,:) )
+      CALL iom_put(     "e3v",   e3v_n(:,:,:) )
+      CALL iom_put(     "e3w",   e3w_n(:,:,:) )
+      CALL iom_put( "tpt_dep", gde3w_n(:,:,:) )
       IF( iom_use("e3tdef") )   &
-         CALL iom_put( "e3tdef"  , ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
+         CALL iom_put( "e3tdef", ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100. * tmask(:,:,:) ) ** 2 )
 
       ! write restart file
       ! ==================
-      IF( lrst_oce ) CALL dom_vvl_rst( kt, 'WRITE' )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_sf_swp')
-
+      IF( lrst_oce )   CALL dom_vvl_rst( kt, 'WRITE' )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_sf_swp')
+      !
    END SUBROUTINE dom_vvl_sf_swp
 
@@ -695,109 +683,104 @@
       !!                - vertical interpolation: simple averaging
       !!----------------------------------------------------------------------
-      !! * Arguments
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in    ) ::  pe3_in     ! input e3 to be interpolated
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::  pe3_out    ! output interpolated e3
-      CHARACTER(LEN=*), INTENT( in )                    ::  pout       ! grid point of out scale factors
-      !                                                                !   =  'U', 'V', 'W, 'F', 'UW' or 'VW'
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk                                          ! dummy loop indices
-      LOGICAL ::   l_is_orca                                           ! local logical
-      !!----------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_interpol')
-         !
-      l_is_orca = .FALSE.
-      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) l_is_orca = .TRUE.      ! ORCA R2 configuration - will need to correct some locations
-
-      SELECT CASE ( pout )
-         !               ! ------------------------------------- !
-      CASE( 'U' )        ! interpolation from T-point to U-point !
-         !               ! ------------------------------------- !
-         ! horizontal surface weighted interpolation
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::  pe3_in    ! input e3 to be interpolated
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::  pe3_out   ! output interpolated e3
+      CHARACTER(LEN=*)                , INTENT(in   ) ::  pout      ! grid point of out scale factors
+      !                                                             !   =  'U', 'V', 'W, 'F', 'UW' or 'VW'
+      !
+      INTEGER ::   ji, jj, jk                                       ! dummy loop indices
+      REAL(wp) ::  zlnwd                                            ! =1./0. when ln_wd = T/F
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_interpol')
+      !
+      IF(ln_wd) THEN
+        zlnwd = 1.0_wp
+      ELSE
+        zlnwd = 0.0_wp
+      END IF
+      !
+      SELECT CASE ( pout )    !==  type of interpolation  ==!
+         !
+      CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean
          DO jk = 1, jpk
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e12u(ji,jj)                                   &
-                     &                       * (   e12t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
-                     &                           + e12t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
+                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   &
+                     &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
+                     &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
                END DO
             END DO
          END DO
-         !
-         IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout )
-         ! boundary conditions
          CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:)
-         !               ! ------------------------------------- !
-      CASE( 'V' )        ! interpolation from T-point to V-point !
-         !               ! ------------------------------------- !
-         ! horizontal surface weighted interpolation
+         !
+      CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean
          DO jk = 1, jpk
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e12v(ji,jj)                                   &
-                     &                       * (   e12t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
-                     &                           + e12t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
+                  pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   &
+                     &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
+                     &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
                END DO
             END DO
          END DO
-         !
-         IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout )
-         ! boundary conditions
          CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:)
-         !               ! ------------------------------------- !
-      CASE( 'F' )        ! interpolation from U-point to F-point !
-         !               ! ------------------------------------- !
-         ! horizontal surface weighted interpolation
+         !
+      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean
          DO jk = 1, jpk
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e12f(ji,jj)               &
-                     &                       * (   e12u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
-                     &                           + e12u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
+                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) &
+                     &                       *    r1_e1e2f(ji,jj)                                                  &
+                     &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
+                     &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
                END DO
             END DO
          END DO
-         !
-         IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout )
-         ! boundary conditions
          CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:)
-         !               ! ------------------------------------- !
-      CASE( 'W' )        ! interpolation from T-point to W-point !
-         !               ! ------------------------------------- !
-         ! vertical simple interpolation
+         !
+      CASE( 'W' )                   !* from T- to W-point : vertical simple mean
+         !
          pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1)
-         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
+         ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing
+!!gm BUG? use here wmask in case of ISF ?  to be checked
          DO jk = 2, jpk
-            pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )   &
-               &                            +            0.5_wp * tmask(:,:,jk)   * ( pe3_in(:,:,jk  ) - e3t_0(:,:,jk  ) )
-         END DO
-         !               ! -------------------------------------- !
-      CASE( 'UW' )       ! interpolation from U-point to UW-point !
-         !               ! -------------------------------------- !
-         ! vertical simple interpolation
+            pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )   &
+               &                            * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )                               &
+               &                            +            0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )     &
+               &                            * ( pe3_in(:,:,jk  ) - e3t_0(:,:,jk  ) )
+         END DO
+         !
+      CASE( 'UW' )                  !* from U- to UW-point : vertical simple mean
+         !
          pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1)
          ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
+!!gm BUG? use here wumask in case of ISF ?  to be checked
          DO jk = 2, jpk
-            pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * umask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) )   &
-               &                             +            0.5_wp * umask(:,:,jk)   * ( pe3_in(:,:,jk  ) - e3u_0(:,:,jk  ) )
-         END DO
-         !               ! -------------------------------------- !
-      CASE( 'VW' )       ! interpolation from V-point to VW-point !
-         !               ! -------------------------------------- !
-         ! vertical simple interpolation
+            pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  &
+               &                             * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) )                              &
+               &                             +            0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    &
+               &                             * ( pe3_in(:,:,jk  ) - e3u_0(:,:,jk  ) )
+         END DO
+         !
+      CASE( 'VW' )                  !* from V- to VW-point : vertical simple mean
+         !
          pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1)
          ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
+!!gm BUG? use here wvmask in case of ISF ?  to be checked
          DO jk = 2, jpk
-            pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * vmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) )   &
-               &                             +            0.5_wp * vmask(:,:,jk)   * ( pe3_in(:,:,jk  ) - e3v_0(:,:,jk  ) )
+            pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  &
+               &                             * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) )                              &
+               &                             +            0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    &
+               &                             * ( pe3_in(:,:,jk  ) - e3v_0(:,:,jk  ) )
          END DO
       END SELECT
       !
-
-      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_interpol')
-
+      IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_interpol')
+      !
    END SUBROUTINE dom_vvl_interpol
+
 
    SUBROUTINE dom_vvl_rst( kt, cdrw )
@@ -813,9 +796,8 @@
       !!                they are set to 0.
       !!----------------------------------------------------------------------
-      !! * Arguments
       INTEGER         , INTENT(in) ::   kt     ! ocean time-step
       CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
-      !! * Local declarations
-      INTEGER ::   jk
+      !
+      INTEGER ::   ji, jj, jk
       INTEGER ::   id1, id2, id3, id4, id5     ! local integers
       !!----------------------------------------------------------------------
@@ -828,6 +810,6 @@
             CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
             !
-            id1 = iom_varid( numror, 'fse3t_b', ldstop = .FALSE. )
-            id2 = iom_varid( numror, 'fse3t_n', ldstop = .FALSE. )
+            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. )
+            id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. )
             id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. )
             id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. )
@@ -837,39 +819,39 @@
             !                             ! --------- !
             IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist
-               CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )
-               CALL iom_get( numror, jpdom_autoglo, 'fse3t_n', fse3t_n(:,:,:) )
+               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) )
+               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) )
                ! needed to restart if land processor not computed 
-               IF(lwp) write(numout,*) 'dom_vvl_rst : fse3t_b and fse3t_n found in restart files'
+               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t_b and e3t_n found in restart files'
                WHERE ( tmask(:,:,:) == 0.0_wp ) 
-                  fse3t_n(:,:,:) = e3t_0(:,:,:)
-                  fse3t_b(:,:,:) = e3t_0(:,:,:)
+                  e3t_n(:,:,:) = e3t_0(:,:,:)
+                  e3t_b(:,:,:) = e3t_0(:,:,:)
                END WHERE
                IF( neuler == 0 ) THEN
-                  fse3t_b(:,:,:) = fse3t_n(:,:,:)
+                  e3t_b(:,:,:) = e3t_n(:,:,:)
                ENDIF
             ELSE IF( id1 > 0 ) THEN
-               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : fse3t_n not found in restart files'
-               IF(lwp) write(numout,*) 'fse3t_n set equal to fse3t_b.'
+               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart files'
+               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.'
                IF(lwp) write(numout,*) 'neuler is forced to 0'
-               CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )
-               fse3t_n(:,:,:) = fse3t_b(:,:,:)
+               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) )
+               e3t_n(:,:,:) = e3t_b(:,:,:)
                neuler = 0
             ELSE IF( id2 > 0 ) THEN
-               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : fse3t_b not found in restart files'
-               IF(lwp) write(numout,*) 'fse3t_b set equal to fse3t_n.'
+               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_b not found in restart files'
+               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.'
                IF(lwp) write(numout,*) 'neuler is forced to 0'
-               CALL iom_get( numror, jpdom_autoglo, 'fse3t_n', fse3t_n(:,:,:) )
-               fse3t_b(:,:,:) = fse3t_n(:,:,:)
+               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) )
+               e3t_b(:,:,:) = e3t_n(:,:,:)
                neuler = 0
             ELSE
-               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : fse3t_n not found in restart file'
+               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart file'
                IF(lwp) write(numout,*) 'Compute scale factor from sshn'
                IF(lwp) write(numout,*) 'neuler is forced to 0'
-               DO jk=1,jpk
-                  fse3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) &
-                      &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) &
-                      &            + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk))
+               DO jk = 1, jpk
+                  e3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) &
+                      &                          / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
+                      &          + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk))
                END DO
-               fse3t_b(:,:,:) = fse3t_n(:,:,:)
+               e3t_b(:,:,:) = e3t_n(:,:,:)
                neuler = 0
             ENDIF
@@ -902,7 +884,23 @@
             !
          ELSE                                   !* Initialize at "rest"
-            fse3t_b(:,:,:) = e3t_0(:,:,:)
-            fse3t_n(:,:,:) = e3t_0(:,:,:)
+            e3t_b(:,:,:) = e3t_0(:,:,:)
+            e3t_n(:,:,:) = e3t_0(:,:,:)
             sshn(:,:) = 0.0_wp
+
+            IF( ln_wd ) THEN
+              DO jj = 1, jpj
+                DO ji = 1, jpi
+                  IF( e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1 ) THEN
+                     e3t_b(ji,jj,:) = 0.5_wp * rn_wdmin1 
+                     e3t_n(ji,jj,:) = 0.5_wp * rn_wdmin1 
+                     e3t_a(ji,jj,:) = 0.5_wp * rn_wdmin1 
+                     sshb(ji,jj) = rn_wdmin1 - bathy(ji,jj)
+                     sshn(ji,jj) = rn_wdmin1 - bathy(ji,jj)
+                     ssha(ji,jj) = rn_wdmin1 - bathy(ji,jj)
+                  ENDIF
+                ENDDO
+              ENDDO
+            END IF
+
             IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN
                tilde_e3t_b(:,:,:) = 0.0_wp
@@ -911,5 +909,5 @@
             END IF
          ENDIF
-
+         !
       ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
          !                                   ! ===================
@@ -918,6 +916,6 @@
          !                                           ! all cases !
          !                                           ! --------- !
-         CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) )
-         CALL iom_rstput( kt, nitrst, numrow, 'fse3t_n', fse3t_n(:,:,:) )
+         CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:) )
+         CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) )
          !                                           ! ----------------------- !
          IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases !
@@ -931,8 +929,9 @@
             CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) )
          ENDIF
-
-      ENDIF
+         !
+      ENDIF
+      !
       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_rst')
-
+      !
    END SUBROUTINE dom_vvl_rst
 
@@ -945,21 +944,20 @@
       !!                for vertical coordinate
       !!----------------------------------------------------------------------
-      INTEGER ::   ioptio
-      INTEGER ::   ios
-
+      INTEGER ::   ioptio, ios
+      !!
       NAMELIST/nam_vvl/ ln_vvl_zstar, ln_vvl_ztilde, ln_vvl_layer, ln_vvl_ztilde_as_zstar, &
-                      & ln_vvl_zstar_at_eqtor      , rn_ahe3     , rn_rst_e3t            , &
-                      & rn_lf_cutoff               , rn_zdef_max , ln_vvl_dbg                ! not yet implemented: ln_vvl_kepe
+         &              ln_vvl_zstar_at_eqtor      , rn_ahe3     , rn_rst_e3t            , &
+         &              rn_lf_cutoff               , rn_zdef_max , ln_vvl_dbg                ! not yet implemented: ln_vvl_kepe
       !!---------------------------------------------------------------------- 
-
+      !
       REWIND( numnam_ref )              ! Namelist nam_vvl in reference namelist : 
       READ  ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in reference namelist', lwp )
-
+      !
       REWIND( numnam_cfg )              ! Namelist nam_vvl in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, nam_vvl, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, nam_vvl )
-
+      !
       IF(lwp) THEN                    ! Namelist print
          WRITE(numout,*)
@@ -994,14 +992,14 @@
          WRITE(numout,*) '                                         ln_vvl_dbg     = ', ln_vvl_dbg
       ENDIF
-
+      !
       ioptio = 0                      ! Parameter control
-      IF( ln_vvl_ztilde_as_zstar ) ln_vvl_ztilde = .true.
-      IF( ln_vvl_zstar           )        ioptio = ioptio + 1
-      IF( ln_vvl_ztilde          )        ioptio = ioptio + 1
-      IF( ln_vvl_layer           )        ioptio = ioptio + 1
-
+      IF( ln_vvl_ztilde_as_zstar )   ln_vvl_ztilde = .true.
+      IF( ln_vvl_zstar           )   ioptio = ioptio + 1
+      IF( ln_vvl_ztilde          )   ioptio = ioptio + 1
+      IF( ln_vvl_layer           )   ioptio = ioptio + 1
+      !
       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' )
-      IF( .NOT. ln_vvl_zstar .AND. nn_isf .NE. 0) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
-
+      IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
+      !
       IF(lwp) THEN                   ! Print the choice
          WRITE(numout,*)
@@ -1014,404 +1012,11 @@
          ! IF( .NOT. ln_vvl_kepe ) WRITE(numout,*) '              kinetic to potential energy transfer : option not used'
       ENDIF
-
+      !
 #if defined key_agrif
-      IF (.NOT.Agrif_Root()) CALL ctl_stop( 'AGRIF not implemented with non-linear free surface (key_vvl)' )
+      IF(.NOT.Agrif_Root() )   CALL ctl_stop( 'AGRIF not implemented with non-linear free surface' )
 #endif
-
+      !
    END SUBROUTINE dom_vvl_ctl
-
-   SUBROUTINE dom_vvl_orca_fix( pe3_in, pe3_out, pout )
-      !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE dom_vvl_orca_fix  ***
-      !!                     
-      !! ** Purpose :   Correct surface weighted, horizontally interpolated, 
-      !!                scale factors at locations that have been individually
-      !!                modified in domhgr. Such modifications break the
-      !!                relationship between e12t and e1u*e2u etc.
-      !!                Recompute some scale factors ignoring the modified metric.
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in    ) ::  pe3_in     ! input e3 to be interpolated
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::  pe3_out    ! output interpolated e3
-      CHARACTER(LEN=*), INTENT( in )                    ::  pout       ! grid point of out scale factors
-      !                                                                !   =  'U', 'V', 'W, 'F', 'UW' or 'VW'
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk                                          ! dummy loop indices
-      INTEGER ::   ij0, ij1, ii0, ii1                                  ! dummy loop indices
-      INTEGER ::   isrow                                               ! index for ORCA1 starting row
-      !! acc
-      !! Hmm with the time splitting these "fixes" seem to do more harm than good. Temporarily disabled for
-      !! the ORCA2 tests (by changing jp_cfg test from 2 to 3) pending further investigations
-      !! 
-      !                                                ! =====================
-      IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN    ! ORCA R2 configuration
-         !                                             ! =====================
-      !! acc
-         IF( nn_cla == 0 ) THEN
-            !
-            ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u was modified)
-            ij0 = 102   ;   ij1 = 102
-            DO jk = 1, jpkm1
-               DO jj = mj0(ij0), mj1(ij1)
-                  DO ji = mi0(ii0), mi1(ii1)
-                     SELECT CASE ( pout )
-                     CASE( 'U' )
-                        pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                       &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                       &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                       &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                     CASE( 'F' )
-                        pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                       &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                       &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                       &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                     END SELECT
-                  END DO
-               END DO
-            END DO
-            !
-            ii0 = 160   ;   ii1 = 160        ! Bab el Mandeb (e2u and e1v were modified)
-            ij0 =  88   ;   ij1 =  88
-            DO jk = 1, jpkm1
-               DO jj = mj0(ij0), mj1(ij1)
-                  DO ji = mi0(ii0), mi1(ii1)
-                     SELECT CASE ( pout )
-                     CASE( 'U' )
-                        pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                       &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                       &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                       &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                     CASE( 'V' )
-                        pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                       &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                       &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                       &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                     CASE( 'F' )
-                        pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                       &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                       &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                       &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                     END SELECT
-                  END DO
-               END DO
-            END DO
-         ENDIF
-
-         ii0 = 145   ;   ii1 = 146        ! Danish Straits (e2u was modified)
-         ij0 = 116   ;   ij1 = 116
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-      ENDIF
-      !
-         !                                             ! =====================
-      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration
-         !                                             ! =====================
-         ! This dirty section will be suppressed by simplification process:
-         ! all this will come back in input files
-         ! Currently these hard-wired indices relate to configuration with
-         ! extend grid (jpjglo=332)
-         ! which had a grid-size of 362x292.
-         isrow = 332 - jpjglo
-         !
-         ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait (e2u was modified)
-         ij0 = 241 - isrow   ;   ij1 = 241 - isrow
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u was modified)
-         ij0 = 248 - isrow   ;   ij1 = 248 - isrow
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &  
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &  
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v was modified)
-         ij0 = 164 - isrow   ;   ij1 = 165 - isrow
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on]
-         ij0 = 164 - isrow   ;   ij1 = 165 - isrow
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  53          ;   ii1 =  53        ! Ombai Strait (e1v was modified)
-         ij0 = 164 - isrow  ;   ij1 = 165  - isrow  
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  56            ;   ii1 =  56        ! Timor Passage (e1v was modified)
-         ij0 = 164 - isrow    ;   ij1 = 165  - isrow  
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  55            ;   ii1 =  55        ! West Halmahera Strait (e1v was modified)
-         ij0 = 181 - isrow    ;   ij1 = 182 - isrow  
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  58            ;   ii1 =  58        ! East Halmahera Strait (e1v was modified)
-         ij0 = 181 - isrow    ;   ij1 = 182 - isrow  
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-      ENDIF
-         !                                             ! =====================
-      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration
-         !                                             ! =====================
-         !
-         ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u was modified)
-         ij0 = 327   ;   ij1 = 327
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 = 627   ;   ii1 = 628        ! Bosphorus Strait (e2u was modified)
-         ij0 = 343   ;   ij1 = 343
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &  
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &  
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u was modified)
-         ij0 = 232   ;   ij1 = 232
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u was modified)
-         ij0 = 232   ;   ij1 = 232
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u was modified)
-         ij0 = 270   ;   ij1 = 270
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'U' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &
-                    &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) &
-                    &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &
-                    &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk)
-                  CASE( 'F' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &
-                    &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) &
-                    &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &
-                    &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v was modified)
-         ij0 = 232   ;   ij1 = 233
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-         !
-         ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v was modified)
-         ij0 = 276   ;   ij1 = 276
-         DO jk = 1, jpkm1
-            DO jj = mj0(ij0), mj1(ij1)
-               DO ji = mi0(ii0), mi1(ii1)
-                  SELECT CASE ( pout )
-                  CASE( 'V' )
-                     pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        &
-                    &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) &
-                    &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &
-                    &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk)
-                  END SELECT
-               END DO
-            END DO
-         END DO
-      ENDIF
-   END SUBROUTINE dom_vvl_orca_fix
 
    !!======================================================================
 END MODULE domvvl
-
-
-
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 6808)
@@ -7,11 +7,10 @@
    !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
    !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file
-   !!            3.0  ! 2008-01  (S. Masson) add dom_uniq 
-   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.0  ! 2008-01  (S. Masson)  add dom_uniq 
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   dom_wri        : create and write mesh and mask file(s)
-   !!   dom_uniq       :
+   !!   dom_uniq       : identify unique point of a grid (TUVF)
    !!----------------------------------------------------------------------
    USE dom_oce         ! ocean space and time domain
@@ -26,6 +25,6 @@
    PRIVATE
 
-   PUBLIC dom_wri        ! routine called by inidom.F90
-
+   PUBLIC   dom_wri              ! routine called by inidom.F90
+   PUBLIC   dom_wri_coordinate   ! routine called by domhgr.F90
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
@@ -36,4 +35,69 @@
    !!----------------------------------------------------------------------
 CONTAINS
+
+   SUBROUTINE dom_wri_coordinate
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_wri_coordinate  ***
+      !!                   
+      !! ** Purpose :   Create the NetCDF file which contains all the
+      !!              standard coordinate information plus the surface,
+      !!              e1e2u and e1e2v. By doing so, those surface will
+      !!              not be changed by the reduction of e1u or e2v scale 
+      !!              factors in some straits. 
+      !!                 NB: call just after the read of standard coordinate
+      !!              and the reduction of scale factors in some straits
+      !!
+      !! ** output file :   coordinate_e1e2u_v.nc
+      !!----------------------------------------------------------------------
+      INTEGER           ::   inum0    ! temprary units for 'coordinate_e1e2u_v.nc' file
+      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations)
+      !                                   !  workspaces
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw 
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_wri_coordinate')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_wri_coordinate : create NetCDF coordinate file'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~'
+      
+      clnam0 = 'coordinate_e1e2u_v'  ! filename (mesh and mask informations)
+      
+      !  create 'coordinate_e1e2u_v.nc' file
+      ! ============================
+      !
+      CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib )
+      !
+      !                                                         ! horizontal mesh (inum3)
+      CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r4 )     !    ! latitude
+      CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r4 )
+      
+      CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r4 )     !    ! longitude
+      CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r4 )
+      
+      CALL iom_rstput( 0, 0, inum0, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors
+      CALL iom_rstput( 0, 0, inum0, 'e1u', e1u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e1v', e1v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e1f', e1f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum0, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors
+      CALL iom_rstput( 0, 0, inum0, 'e2u', e2u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e2v', e2v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e2f', e2f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum0, 'e1e2u', e1e2u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e1e2v', e1e2v, ktype = jp_r8 )
+
+      CALL iom_close( inum0 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_wri_coordinate')
+      !
+   END SUBROUTINE dom_wri_coordinate
+
 
    SUBROUTINE dom_wri
@@ -215,4 +279,6 @@
          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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 6808)
@@ -2,5 +2,5 @@
    !!==============================================================================
    !!                       ***  MODULE domzgr   ***
-   !! Ocean initialization : domain initialization
+   !! Ocean domain : definition of the vertical coordinate system
    !!==============================================================================
    !! History :  OPA  ! 1995-12  (G. Madec)  Original code : s vertical coordinate
@@ -18,4 +18,5 @@
    !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  modify C1D case  
    !!            3.6  ! 2014-11  (P. Mathiot and C. Harris) add ice shelf capabilitye  
+   !!            3.?  ! 2015-11  (H. Liu) Modifications for Wetting/Drying
    !!----------------------------------------------------------------------
 
@@ -36,6 +37,8 @@
    USE oce               ! ocean variables
    USE dom_oce           ! ocean domain
+   USE wet_dry           ! wetting and drying
    USE closea            ! closed seas
    USE c1d               ! 1D vertical configuration
+   !
    USE in_out_manager    ! I/O manager
    USE iom               ! I/O library
@@ -73,5 +76,4 @@
 
   !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -102,5 +104,5 @@
       INTEGER ::   ios
       !
-      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh
       !!----------------------------------------------------------------------
       !
@@ -120,10 +122,13 @@
          WRITE(numout,*) 'dom_zgr : vertical coordinate'
          WRITE(numout,*) '~~~~~~~'
-         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
-         WRITE(numout,*) '             z-coordinate - full steps      ln_zco    = ', ln_zco
-         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps    = ', ln_zps
-         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
-         WRITE(numout,*) '             ice shelf cavities             ln_isfcav = ', ln_isfcav
+         WRITE(numout,*) '   Namelist namzgr : set vertical coordinate'
+         WRITE(numout,*) '      z-coordinate - full steps      ln_zco    = ', ln_zco
+         WRITE(numout,*) '      z-coordinate - partial steps   ln_zps    = ', ln_zps
+         WRITE(numout,*) '      s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
+         WRITE(numout,*) '      ice shelf cavities             ln_isfcav = ', ln_isfcav
+         WRITE(numout,*) '      linear free surface            ln_linssh = ', ln_linssh
       ENDIF
+
+      IF( ln_linssh .AND. lwp) WRITE(numout,*) '   linear free surface: the vertical mesh does not change in time'
 
       ioptio = 0                       ! Check Vertical coordinate options
@@ -155,18 +160,18 @@
       !
       IF( nprint == 1 .AND. lwp )   THEN
-         WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) )
+         WRITE(numout,*) ' MIN val mbathy  ', MINVAL(  mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) )
          WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   &
-            &                   ' w ',   MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gdep3w_0(:,:,:) )
-         WRITE(numout,*) ' MIN val e3    t ', MINVAL( e3t_0(:,:,:) ), ' f ', MINVAL( e3f_0(:,:,:) ),  &
-            &                   ' u ',   MINVAL( e3u_0(:,:,:) ), ' u ', MINVAL( e3v_0(:,:,:) ),  &
-            &                   ' uw',   MINVAL( e3uw_0(:,:,:)), ' vw', MINVAL( e3vw_0(:,:,:)),   &
-            &                   ' w ',   MINVAL( e3w_0(:,:,:) )
+            &                          ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL(   e3t_0(:,:,:) ), ' f ', MINVAL(   e3f_0(:,:,:) ),  &
+            &                          ' u ', MINVAL(   e3u_0(:,:,:) ), ' u ', MINVAL(   e3v_0(:,:,:) ),  &
+            &                          ' uw', MINVAL(  e3uw_0(:,:,:) ), ' vw', MINVAL(  e3vw_0(:,:,:)),   &
+            &                          ' w ', MINVAL(   e3w_0(:,:,:) )
 
          WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   &
-            &                   ' w ',   MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gdep3w_0(:,:,:) )
-         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( e3t_0(:,:,:) ), ' f ', MAXVAL( e3f_0(:,:,:) ),  &
-            &                   ' u ',   MAXVAL( e3u_0(:,:,:) ), ' u ', MAXVAL( e3v_0(:,:,:) ),  &
-            &                   ' uw',   MAXVAL( e3uw_0(:,:,:)), ' vw', MAXVAL( e3vw_0(:,:,:)),   &
-            &                   ' w ',   MAXVAL( e3w_0(:,:,:) )
+            &                          ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde3w_0(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL(   e3t_0(:,:,:) ), ' f ', MAXVAL(   e3f_0(:,:,:) ),  &
+            &                          ' u ', MAXVAL(   e3u_0(:,:,:) ), ' u ', MAXVAL(   e3v_0(:,:,:) ),  &
+            &                          ' uw', MAXVAL(  e3uw_0(:,:,:) ), ' vw', MAXVAL(  e3vw_0(:,:,:) ),  &
+            &                          ' w ', MAXVAL(   e3w_0(:,:,:) )
       ENDIF
       !
@@ -219,7 +224,13 @@
          &  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 )  )
@@ -236,5 +247,9 @@
               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
@@ -260,6 +275,10 @@
       ! Reference z-coordinate (depth - scale factor at T- and W-points)
       ! ======================
-      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid       
+      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid 
+#if defined key_agrif
+         za1 = zhmax / FLOAT(jpkdta-1) 
+#else
          za1 = zhmax / FLOAT(jpk-1) 
+#endif
          DO jk = 1, jpk
             zw = FLOAT( jk )
@@ -365,5 +384,5 @@
       !!              - bathy : meter bathymetry (in meters)
       !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jl, jk            ! dummy loop indices
+      INTEGER  ::   ji, jj, jk            ! dummy loop indices
       INTEGER  ::   inum                      ! temporary logical unit
       INTEGER  ::   ierror                    ! error flag
@@ -487,25 +506,24 @@
             IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
                !                                             ! =====================
-               IF( nn_cla == 0 ) THEN
-                  ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open 
-                  ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995)
-                  DO ji = mi0(ii0), mi1(ii1)
-                     DO jj = mj0(ij0), mj1(ij1)
-                        mbathy(ji,jj) = 15
-                     END DO
+               !
+               ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open 
+               ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                  DO jj = mj0(ij0), mj1(ij1)
+                     mbathy(ji,jj) = 15
                   END DO
-                  IF(lwp) WRITE(numout,*)
-                  IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
-                  !
-                  ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open
-                  ij0 = 88    ;   ij1 = 88                   ! (Thomson, Ocean Modelling, 1995)
-                  DO ji = mi0(ii0), mi1(ii1)
-                     DO jj = mj0(ij0), mj1(ij1)
-                        mbathy(ji,jj) = 12
-                     END DO
+               END DO
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+               !
+               ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open
+               ij0 = 88    ;   ij1 = 88                   ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                  DO jj = mj0(ij0), mj1(ij1)
+                     mbathy(ji,jj) = 12
                   END DO
-                  IF(lwp) WRITE(numout,*)
-                  IF(lwp) WRITE(numout,*) '      orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
-               ENDIF
+               END DO
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '      orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
                !
             ENDIF
@@ -528,29 +546,34 @@
                CALL iom_close( inum )
                WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp
+
+               ! set grounded point to 0 
+               ! (a treshold could be set here if needed, or set it offline based on the grounded fraction)
+               WHERE ( bathy(:,:) <= risfdep(:,:) + rn_isfhmin )
+                  misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp
+                  mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp
+               END WHERE
             END IF
             !       
             IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
-               !
-              IF( nn_cla == 0 ) THEN
-                 ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open 
-                 ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995)
-                 DO ji = mi0(ii0), mi1(ii1)
-                    DO jj = mj0(ij0), mj1(ij1)
-                       bathy(ji,jj) = 284._wp
-                    END DO
+            !
+              ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open 
+              ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995)
+              DO ji = mi0(ii0), mi1(ii1)
+                 DO jj = mj0(ij0), mj1(ij1)
+                    bathy(ji,jj) = 284._wp
                  END DO
-                 IF(lwp) WRITE(numout,*)     
-                 IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
-                 !
-                 ii0 = 160   ;   ii1 = 160                   ! Bab el mandeb Strait open
-                 ij0 = 88    ;   ij1 = 88                    ! (Thomson, Ocean Modelling, 1995)
-                 DO ji = mi0(ii0), mi1(ii1)
-                    DO jj = mj0(ij0), mj1(ij1)
-                       bathy(ji,jj) = 137._wp
-                    END DO
+               END DO
+              IF(lwp) WRITE(numout,*)     
+              IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+              !
+              ii0 = 160   ;   ii1 = 160                   ! Bab el mandeb Strait open
+              ij0 = 88    ;   ij1 = 88                    ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                 DO jj = mj0(ij0), mj1(ij1)
+                    bathy(ji,jj) = 137._wp
                  END DO
-                 IF(lwp) WRITE(numout,*)
-                 IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
-              ENDIF
+              END DO
+              IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
               !
            ENDIF
@@ -567,11 +590,4 @@
       !                       
       IF ( .not. ln_sco ) THEN                                !==  set a minimum depth  ==!
-         ! patch to avoid case bathy = ice shelf draft and bathy between 0 and zhmin
-         IF ( ln_isfcav ) THEN
-            WHERE (bathy == risfdep)
-               bathy   = 0.0_wp ; risfdep = 0.0_wp
-            END WHERE
-         END IF
-         ! end patch
          IF( rn_hmin < 0._wp ) THEN    ;   ik = - INT( rn_hmin )                                      ! from a nb of level
          ELSE                          ;   ik = MINLOC( gdepw_1d, mask = gdepw_1d > rn_hmin, dim = 1 )  ! from a depth
@@ -663,9 +679,7 @@
       !!              - update bathy : meter bathymetry (in meters)
       !!----------------------------------------------------------------------
-      !!
       INTEGER ::   ji, jj, jl                    ! dummy loop indices
       INTEGER ::   icompt, ibtest, ikmax         ! temporary integers
       REAL(wp), POINTER, DIMENSION(:,:) ::  zbathy
-
       !!----------------------------------------------------------------------
       !
@@ -764,12 +778,4 @@
          IF(lwp) WRITE(numout,*) ' you can decrease jpk to ', ikmax+1
       ENDIF
-
-      IF( lwp .AND. nprint == 1 ) THEN      ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) ' bathymetric field :   number of non-zero T-levels '
-         WRITE(numout,*) ' ------------------'
-         CALL prihin( mbathy, jpi, jpj, 1, jpi, 1, 1, jpj, 1, 3, numout )
-         WRITE(numout,*)
-      ENDIF
       !
       CALL wrk_dealloc( jpi, jpj, zbathy )
@@ -792,5 +798,4 @@
       !!                                     (min value = 1 over land)
       !!----------------------------------------------------------------------
-      !!
       INTEGER ::   ji, jj   ! dummy loop indices
       REAL(wp), POINTER, DIMENSION(:,:) ::  zmbk
@@ -824,7 +829,8 @@
    END SUBROUTINE zgr_bot_level
 
-      SUBROUTINE zgr_top_level
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE zgr_bot_level  ***
+
+   SUBROUTINE zgr_top_level
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_top_level  ***
       !!
       !! ** Purpose :   defines the vertical index of ocean top (mik. arrays)
@@ -836,5 +842,4 @@
       !!                                     (min value = 1)
       !!----------------------------------------------------------------------
-      !!
       INTEGER ::   ji, jj   ! dummy loop indices
       REAL(wp), POINTER, DIMENSION(:,:) ::  zmik
@@ -870,9 +875,10 @@
    END SUBROUTINE zgr_top_level
 
+
    SUBROUTINE zgr_zco
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zgr_zco  ***
       !!
-      !! ** Purpose :   define the z-coordinate system
+      !! ** Purpose :   define the reference z-coordinate system
       !!
       !! ** Method  :   set 3D coord. arrays to reference 1D array 
@@ -884,14 +890,14 @@
       !
       DO jk = 1, jpk
-         gdept_0 (:,:,jk) = gdept_1d(jk)
-         gdepw_0 (:,:,jk) = gdepw_1d(jk)
-         gdep3w_0(:,:,jk) = gdepw_1d(jk)
-         e3t_0   (:,:,jk) = e3t_1d  (jk)
-         e3u_0   (:,:,jk) = e3t_1d  (jk)
-         e3v_0   (:,:,jk) = e3t_1d  (jk)
-         e3f_0   (:,:,jk) = e3t_1d  (jk)
-         e3w_0   (:,:,jk) = e3w_1d  (jk)
-         e3uw_0  (:,:,jk) = e3w_1d  (jk)
-         e3vw_0  (:,:,jk) = e3w_1d  (jk)
+         gdept_0(:,:,jk) = gdept_1d(jk)
+         gdepw_0(:,:,jk) = gdepw_1d(jk)
+         gde3w_0(:,:,jk) = gdepw_1d(jk)
+         e3t_0  (:,:,jk) = e3t_1d  (jk)
+         e3u_0  (:,:,jk) = e3t_1d  (jk)
+         e3v_0  (:,:,jk) = e3t_1d  (jk)
+         e3f_0  (:,:,jk) = e3t_1d  (jk)
+         e3w_0  (:,:,jk) = e3w_1d  (jk)
+         e3uw_0 (:,:,jk) = e3w_1d  (jk)
+         e3vw_0 (:,:,jk) = e3w_1d  (jk)
       END DO
       !
@@ -906,5 +912,5 @@
       !!                     
       !! ** Purpose :   the depth and vertical scale factor in partial step
-      !!      z-coordinate case
+      !!              reference z-coordinate case
       !!
       !! ** Method  :   Partial steps : computes the 3D vertical scale factors
@@ -946,13 +952,10 @@
       !!  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
       !!----------------------------------------------------------------------
-      !!
       INTEGER  ::   ji, jj, jk       ! dummy loop indices
       INTEGER  ::   ik, it, ikb, ikt ! temporary integers
-      LOGICAL  ::   ll_print         ! Allow  control print for debugging
       REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
       REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t
-      REAL(wp) ::   zmax             ! Maximum depth
       REAL(wp) ::   zdiff            ! temporary scalar
-      REAL(wp) ::   zrefdep          ! temporary scalar
+      REAL(wp) ::   zmax             ! temporary scalar
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zprt
       !!---------------------------------------------------------------------
@@ -960,5 +963,5 @@
       IF( nn_timing == 1 )  CALL timing_start('zgr_zps')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zprt )
+      CALL wrk_alloc( jpi,jpj,jpk,   zprt )
       !
       IF(lwp) WRITE(numout,*)
@@ -966,13 +969,4 @@
       IF(lwp) WRITE(numout,*) '    ~~~~~~~ '
       IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used'
-
-      ll_print = .FALSE.                   ! Local variable for debugging
-      
-      IF(lwp .AND. ll_print) THEN          ! control print of the ocean depth
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_zgr_zps:  bathy (in hundred of meters)'
-         CALL prihre( bathy, jpi, jpj, 1,jpi, 1, 1, jpj, 1, 1.e-2, numout )
-      ENDIF
-
 
       ! bathymetry in level (from bathy_meter)
@@ -993,6 +987,4 @@
       END DO
 
-      IF ( ln_isfcav ) CALL zgr_isf
-
       ! Scale factors and depth at T- and W-points
       DO jk = 1, jpk                        ! intitialization to the reference z-coordinate
@@ -1002,5 +994,736 @@
          e3w_0  (:,:,jk) = e3w_1d  (jk)
       END DO
+      
+      ! Bathy, iceshelf draft, scale factor and depth at T- and W- points in case of isf
+      IF ( ln_isfcav ) CALL zgr_isf
+
+      ! Scale factors and depth at T- and W-points
+      IF ( .NOT. ln_isfcav ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ik = mbathy(ji,jj)
+               IF( ik > 0 ) THEN               ! ocean point only
+                  ! max ocean level case
+                  IF( ik == jpkm1 ) THEN
+                     zdepwp = bathy(ji,jj)
+                     ze3tp  = bathy(ji,jj) - gdepw_1d(ik)
+                     ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) )
+                     e3t_0(ji,jj,ik  ) = ze3tp
+                     e3t_0(ji,jj,ik+1) = ze3tp
+                     e3w_0(ji,jj,ik  ) = ze3wp
+                     e3w_0(ji,jj,ik+1) = ze3tp
+                     gdepw_0(ji,jj,ik+1) = zdepwp
+                     gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp
+                     gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
+                     !
+                  ELSE                         ! standard case
+                     IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj)
+                     ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
+                     ENDIF
+   !gm Bug?  check the gdepw_1d
+                     !       ... on ik
+                     gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   &
+                        &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   &
+                        &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) ))
+                     e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   & 
+                        &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik) ) 
+                     e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   &
+                        &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
+                     !       ... on ik+1
+                     e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+                     e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+                     gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik)
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+         !
+         it = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ik = mbathy(ji,jj)
+               IF( ik > 0 ) THEN               ! ocean point only
+                  e3tp (ji,jj) = e3t_0(ji,jj,ik)
+                  e3wp (ji,jj) = e3w_0(ji,jj,ik)
+                  ! test
+                  zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  )
+                  IF( zdiff <= 0._wp .AND. lwp ) THEN 
+                     it = it + 1
+                     WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj
+                     WRITE(numout,*) ' bathy = ', bathy(ji,jj)
+                     WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff
+                     WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  )
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+      END IF
+      !
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3u_0 (:,:,jk) = e3t_1d(jk)
+         e3v_0 (:,:,jk) = e3t_1d(jk)
+         e3uw_0(:,:,jk) = e3w_1d(jk)
+         e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+
+      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
+               e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
+               e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) )
+               e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) )
+            END DO
+         END DO
+      END DO
+      IF ( ln_isfcav ) THEN
+      ! (ISF) define e3uw (adapted for 2 cells in the water column)
+         DO jj = 2, jpjm1 
+            DO ji = 2, fs_jpim1   ! vector opt. 
+               ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj))
+               ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj))
+               IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) &
+                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) )
+               ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1))
+               ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1))
+               IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) &
+                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) )
+            END DO
+         END DO
+      END IF
+
+      CALL lbc_lnk( e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_0, 'U', 1._wp )   ! lateral boundary conditions
+      CALL lbc_lnk( e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_0, 'V', 1._wp )
+      !
+
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk)
+         WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+      
+      ! Scale factor at F-point
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( e3f_0, 'F', 1._wp )       ! Lateral boundary conditions
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+!!gm  bug ? :  must be a do loop with mj0,mj1
       ! 
+      e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2
+      e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:) 
+      e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:) 
+      e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:) 
+      e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:) 
+
+      ! Control of the sign
+      IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' )
+      IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' )
+      IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' )
+      IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' )
+     
+      ! Compute gde3w_0 (vertical sum of e3w)
+      IF ( ln_isfcav ) THEN ! if cavity
+         WHERE( misfdep == 0 )   misfdep = 1
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               gde3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1)
+               DO jk = 2, misfdep(ji,jj)
+                  gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
+               END DO
+               IF( misfdep(ji,jj) >= 2 )   gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj))
+               DO jk = misfdep(ji,jj) + 1, jpk
+                  gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
+               END DO
+            END DO
+         END DO
+      ELSE ! no cavity
+         gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1)
+         DO jk = 2, jpk
+            gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk)
+         END DO
+      END IF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zprt )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_zps')
+      !
+   END SUBROUTINE zgr_zps
+
+
+   SUBROUTINE zgr_isf
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_isf  ***
+      !!   
+      !! ** Purpose :   check the bathymetry in levels
+      !!   
+      !! ** Method  :   THe water column have to contained at least 2 cells
+      !!                Bathymetry and isfdraft are modified (dig/close) to respect
+      !!                this criterion.
+      !!   
+      !! ** Action  : - test compatibility between isfdraft and bathy 
+      !!              - bathy and isfdraft are modified
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jl, jk       ! dummy loop indices
+      INTEGER  ::   ik, it               ! temporary integers
+      INTEGER  ::   icompt, ibtest       ! (ISF)
+      INTEGER  ::   ibtestim1, ibtestip1 ! (ISF)
+      INTEGER  ::   ibtestjm1, ibtestjp1 ! (ISF)
+      REAL(wp) ::   zdepth           ! Ajusted ocean depth to avoid too small e3t
+      REAL(wp) ::   zmax             ! Maximum and minimum depth
+      REAL(wp) ::   zbathydiff       ! isf temporary scalar
+      REAL(wp) ::   zrisfdepdiff     ! isf temporary scalar
+      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
+      REAL(wp) ::   zdepwp           ! Ajusted ocean depth to avoid too small e3t
+      REAL(wp) ::   zdiff            ! temporary scalar
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zrisfdep, zbathy, zmask   ! 2D workspace (ISH)
+      INTEGER , POINTER, DIMENSION(:,:)   ::   zmbathy, zmisfdep         ! 2D workspace (ISH)
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('zgr_isf')
+      !
+      CALL wrk_alloc( jpi,jpj,   zbathy, zmask, zrisfdep)
+      CALL wrk_alloc( jpi,jpj,   zmisfdep, zmbathy )
+
+      ! (ISF) compute misfdep
+      WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) /= 0 ) ;   misfdep(:,:) = 1   ! open water : set misfdep to 1  
+      ELSEWHERE                      ;                         misfdep(:,:) = 2   ! iceshelf : initialize misfdep to second level 
+      END WHERE  
+
+      ! Compute misfdep for ocean points (i.e. first wet level) 
+      ! find the first ocean level such that the first level thickness 
+      ! is larger than the bot_level of e3zps_min and e3zps_rat * e3t_0 (where 
+      ! e3t_0 is the reference level thickness 
+      DO jk = 2, jpkm1 
+         zdepth = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
+         WHERE( 0._wp < risfdep(:,:) .AND. risfdep(:,:) >= zdepth )   misfdep(:,:) = jk+1 
+      END DO 
+      WHERE ( 0._wp < risfdep(:,:) .AND. risfdep(:,:) <= e3t_1d(1) )
+         risfdep(:,:) = 0. ; misfdep(:,:) = 1
+      END WHERE
+
+      ! remove very shallow ice shelf (less than ~ 10m if 75L)
+      WHERE (risfdep(:,:) <= 10._wp .AND. misfdep(:,:) > 1)
+         misfdep = 0; risfdep = 0.0_wp;
+         mbathy  = 0; bathy   = 0.0_wp;
+      END WHERE
+      WHERE (bathy(:,:) <= 30.0_wp .AND. gphit < -60._wp)
+         misfdep = 0; risfdep = 0.0_wp;
+         mbathy  = 0; bathy   = 0.0_wp;
+      END WHERE
+ 
+! basic check for the compatibility of bathy and risfdep. I think it should be offline because it is not perfect and cannot solved all the situation
+      icompt = 0 
+! run the bathy check 10 times to be sure all the modif in the bathy or iceshelf draft are compatible together
+      DO jl = 1, 10     
+         ! check at each iteration if isf is grounded or not (1cm treshold have to be update after first coupling experiments)
+         WHERE (bathy(:,:) <= risfdep(:,:) + rn_isfhmin)
+            misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp
+            mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp
+         END WHERE
+         WHERE (mbathy(:,:) <= 0) 
+            misfdep(:,:) = 0; risfdep(:,:) = 0._wp 
+            mbathy (:,:) = 0; bathy  (:,:) = 0._wp
+         END WHERE
+         IF( lk_mpp ) THEN
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF
+         IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN 
+            misfdep( 1 ,:) = misfdep(jpim1,:)            ! local domain is cyclic east-west 
+            misfdep(jpi,:) = misfdep(  2  ,:) 
+            mbathy( 1 ,:)  = mbathy(jpim1,:)             ! local domain is cyclic east-west
+            mbathy(jpi,:)  = mbathy(  2  ,:)
+         ENDIF
+
+         ! split last cell if possible (only where water column is 2 cell or less)
+         ! if coupled to ice sheet, we do not modify the bathymetry (can be discuss).
+         IF ( .NOT. ln_iscpl) THEN
+            DO jk = jpkm1, 1, -1
+               zmax = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+               WHERE( gdepw_1d(jk) < bathy(:,:) .AND. bathy(:,:) <= zmax .AND. misfdep + 1 >= mbathy)
+                  mbathy(:,:) = jk
+                  bathy(:,:)  = zmax
+               END WHERE
+            END DO
+         END IF
+ 
+         ! split top cell if possible (only where water column is 2 cell or less)
+         DO jk = 2, jpkm1
+            zmax = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+            WHERE( gdepw_1d(jk+1) > risfdep(:,:) .AND. risfdep(:,:) >= zmax .AND. misfdep + 1 >= mbathy)
+               misfdep(:,:) = jk
+               risfdep(:,:) = zmax
+            END WHERE
+         END DO
+
+ 
+ ! Case where bathy and risfdep compatible but not the level variable mbathy/misfdep because of partial cell condition
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! find the minimum change option:
+               ! test bathy
+               IF (risfdep(ji,jj) > 1) THEN
+                  IF ( .NOT. ln_iscpl ) THEN
+                     zbathydiff  =ABS(bathy(ji,jj)   - (gdepw_1d(mbathy (ji,jj)+1) &
+                         &            + MIN( e3zps_min, e3t_1d(mbathy (ji,jj)+1)*e3zps_rat )))
+                     zrisfdepdiff=ABS(risfdep(ji,jj) - (gdepw_1d(misfdep(ji,jj)  ) &
+                         &            - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat )))
+                     IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) <  misfdep(ji,jj)) THEN
+                        IF (zbathydiff <= zrisfdepdiff) THEN
+                           bathy(ji,jj) = gdepw_1d(mbathy(ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj)+1)*e3zps_rat )
+                           mbathy(ji,jj)= mbathy(ji,jj) + 1
+                        ELSE
+                           risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat )
+                           misfdep(ji,jj) = misfdep(ji,jj) - 1
+                        END IF
+                     ENDIF
+                  ELSE
+                     IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) <  misfdep(ji,jj)) THEN
+                        risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat )
+                        misfdep(ji,jj) = misfdep(ji,jj) - 1
+                     END IF
+                  END IF
+               END IF
+            END DO
+         END DO
+ 
+         ! At least 2 levels for water thickness at T, U, and V point.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! find the minimum change option:
+               ! test bathy
+               IF( misfdep(ji,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN
+                  IF ( .NOT. ln_iscpl ) THEN 
+                     zbathydiff  =ABS(bathy(ji,jj)   - ( gdepw_1d(mbathy (ji,jj)+1) &
+                         &                             + MIN( e3zps_min,e3t_1d(mbathy (ji,jj)+1)*e3zps_rat )))
+                     zrisfdepdiff=ABS(risfdep(ji,jj) - ( gdepw_1d(misfdep(ji,jj)  ) & 
+                         &                             - MIN( e3zps_min,e3t_1d(misfdep(ji,jj)-1)*e3zps_rat )))
+                     IF (zbathydiff <= zrisfdepdiff) THEN
+                        mbathy(ji,jj) = mbathy(ji,jj) + 1
+                        bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat )
+                     ELSE
+                        misfdep(ji,jj)= misfdep(ji,jj) - 1
+                        risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj))*e3zps_rat )
+                     END IF
+                  ELSE
+                     misfdep(ji,jj)= misfdep(ji,jj) - 1
+                     risfdep(ji,jj)= gdepw_1d(misfdep(ji,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj))*e3zps_rat )
+                  END IF
+               ENDIF
+            END DO
+         END DO
+ 
+ ! point V mbathy(ji,jj) == misfdep(ji,jj+1) 
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               IF( misfdep(ji,jj+1) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN
+                  IF ( .NOT. ln_iscpl ) THEN 
+                     zbathydiff  =ABS(bathy(ji,jj    ) - ( gdepw_1d(mbathy (ji,jj)+1) &
+                          &                              + MIN( e3zps_min, e3t_1d(mbathy (ji,jj  )+1)*e3zps_rat )))
+                     zrisfdepdiff=ABS(risfdep(ji,jj+1) - ( gdepw_1d(misfdep(ji,jj+1)) &
+                          &                              - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1)-1)*e3zps_rat )))
+                     IF (zbathydiff <= zrisfdepdiff) THEN
+                        mbathy(ji,jj) = mbathy(ji,jj) + 1
+                        bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj  )) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj   )+1)*e3zps_rat )
+                     ELSE
+                        misfdep(ji,jj+1)  = misfdep(ji,jj+1) - 1
+                        risfdep (ji,jj+1) = gdepw_1d(misfdep(ji,jj+1)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1))*e3zps_rat )
+                     END IF
+                  ELSE
+                     misfdep(ji,jj+1)  = misfdep(ji,jj+1) - 1
+                     risfdep (ji,jj+1) = gdepw_1d(misfdep(ji,jj+1)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1))*e3zps_rat )
+                  END IF
+               ENDIF
+            END DO
+         END DO
+ 
+         IF( lk_mpp ) THEN
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF
+ ! point V misdep(ji,jj) == mbathy(ji,jj+1) 
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               IF( misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) > 1) THEN
+                  IF ( .NOT. ln_iscpl ) THEN 
+                     zbathydiff  =ABS(  bathy(ji,jj+1) - ( gdepw_1d(mbathy (ji,jj+1)+1) &
+                           &                             + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat )))
+                     zrisfdepdiff=ABS(risfdep(ji,jj  ) - ( gdepw_1d(misfdep(ji,jj  )  ) &
+                           &                             - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )-1)*e3zps_rat )))
+                     IF (zbathydiff <= zrisfdepdiff) THEN
+                        mbathy (ji,jj+1) = mbathy(ji,jj+1) + 1
+                        bathy  (ji,jj+1) = gdepw_1d(mbathy (ji,jj+1)  ) + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat )
+                     ELSE
+                        misfdep(ji,jj)   = misfdep(ji,jj) - 1
+                        risfdep(ji,jj)   = gdepw_1d(misfdep(ji,jj  )+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )  )*e3zps_rat )
+                     END IF
+                  ELSE
+                     misfdep(ji,jj)   = misfdep(ji,jj) - 1
+                     risfdep(ji,jj)   = gdepw_1d(misfdep(ji,jj  )+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )  )*e3zps_rat )
+                  END IF
+               ENDIF
+            END DO
+         END DO
+ 
+ 
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF 
+ 
+ ! point U mbathy(ji,jj) == misfdep(ji,jj+1) 
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               IF( misfdep(ji+1,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN
+                  IF ( .NOT. ln_iscpl ) THEN 
+                  zbathydiff  =ABS(  bathy(ji  ,jj) - ( gdepw_1d(mbathy (ji,jj)+1) &
+                       &                              + MIN( e3zps_min, e3t_1d(mbathy (ji  ,jj)+1)*e3zps_rat )))
+                  zrisfdepdiff=ABS(risfdep(ji+1,jj) - ( gdepw_1d(misfdep(ji+1,jj)) &
+                       &                              - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj)-1)*e3zps_rat )))
+                  IF (zbathydiff <= zrisfdepdiff) THEN
+                     mbathy(ji,jj) = mbathy(ji,jj) + 1
+                     bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat )
+                  ELSE
+                     misfdep(ji+1,jj)= misfdep(ji+1,jj) - 1
+                     risfdep(ji+1,jj) = gdepw_1d(misfdep(ji+1,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj))*e3zps_rat )
+                  END IF
+                  ELSE
+                     misfdep(ji+1,jj)= misfdep(ji+1,jj) - 1
+                     risfdep(ji+1,jj) = gdepw_1d(misfdep(ji+1,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj))*e3zps_rat )
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+ 
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF 
+ 
+ ! point U misfdep(ji,jj) == bathy(ji,jj+1) 
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               IF( misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) > 1) THEN
+                  IF ( .NOT. ln_iscpl ) THEN 
+                     zbathydiff  =ABS(  bathy(ji+1,jj) - ( gdepw_1d(mbathy (ji+1,jj)+1) &
+                          &                              + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj)+1)*e3zps_rat )))
+                     zrisfdepdiff=ABS(risfdep(ji  ,jj) - ( gdepw_1d(misfdep(ji  ,jj)  ) &
+                          &                              - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)-1)*e3zps_rat )))
+                     IF (zbathydiff <= zrisfdepdiff) THEN
+                        mbathy(ji+1,jj)  = mbathy (ji+1,jj) + 1
+                        bathy (ji+1,jj)  = gdepw_1d(mbathy (ji+1,jj)  ) + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj) +1)*e3zps_rat )
+                     ELSE
+                        misfdep(ji,jj)   = misfdep(ji  ,jj) - 1
+                        risfdep(ji,jj)   = gdepw_1d(misfdep(ji  ,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)   )*e3zps_rat )
+                     END IF
+                  ELSE
+                     misfdep(ji,jj)   = misfdep(ji  ,jj) - 1
+                     risfdep(ji,jj)   = gdepw_1d(misfdep(ji  ,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)   )*e3zps_rat )
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+ 
+         IF( lk_mpp ) THEN
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF
+      END DO
+      ! end dig bathy/ice shelf to be compatible
+      ! now fill single point in "coastline" of ice shelf, bathy, hole, and test again one cell tickness
+      DO jl = 1,20
+ 
+ ! remove single point "bay" on isf coast line in the ice shelf draft'
+         DO jk = 2, jpk
+            WHERE (misfdep==0) misfdep=jpk
+            zmask=0._wp
+            WHERE (misfdep <= jk) zmask=1
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  IF (misfdep(ji,jj) == jk) THEN
+                     ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1)
+                     IF (ibtest <= 1) THEN
+                        risfdep(ji,jj)=gdepw_1d(jk+1) ; misfdep(ji,jj)=jk+1
+                        IF (misfdep(ji,jj) > mbathy(ji,jj)) misfdep(ji,jj) = jpk
+                     END IF
+                  END IF
+               END DO
+            END DO
+         END DO
+         WHERE (misfdep==jpk)
+             misfdep=0 ; risfdep=0._wp ; mbathy=0 ; bathy=0._wp
+         END WHERE
+         IF( lk_mpp ) THEN
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF
+ 
+ ! remove single point "bay" on bathy coast line beneath an ice shelf'
+         DO jk = jpk,1,-1
+            zmask=0._wp
+            WHERE (mbathy >= jk ) zmask=1
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  IF (mbathy(ji,jj) == jk .AND. misfdep(ji,jj) >= 2) THEN
+                     ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1)
+                     IF (ibtest <= 1) THEN
+                        bathy(ji,jj)=gdepw_1d(jk) ; mbathy(ji,jj)=jk-1
+                        IF (misfdep(ji,jj) > mbathy(ji,jj)) mbathy(ji,jj) = 0
+                     END IF
+                  END IF
+               END DO
+            END DO
+         END DO
+         WHERE (mbathy==0)
+             misfdep=0 ; risfdep=0._wp ; mbathy=0 ; bathy=0._wp
+         END WHERE
+         IF( lk_mpp ) THEN
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF
+ 
+ ! fill hole in ice shelf
+         zmisfdep = misfdep
+         zrisfdep = risfdep
+         WHERE (zmisfdep <= 1._wp) zmisfdep=jpk
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ibtestim1 = zmisfdep(ji-1,jj  ) ; ibtestip1 = zmisfdep(ji+1,jj  )
+               ibtestjm1 = zmisfdep(ji  ,jj-1) ; ibtestjp1 = zmisfdep(ji  ,jj+1)
+               IF( zmisfdep(ji,jj) >= mbathy(ji-1,jj  ) ) ibtestim1 = jpk
+               IF( zmisfdep(ji,jj) >= mbathy(ji+1,jj  ) ) ibtestip1 = jpk
+               IF( zmisfdep(ji,jj) >= mbathy(ji  ,jj-1) ) ibtestjm1 = jpk
+               IF( zmisfdep(ji,jj) >= mbathy(ji  ,jj+1) ) ibtestjp1 = jpk
+               ibtest=MIN(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1)
+               IF( ibtest == jpk .AND. misfdep(ji,jj) >= 2) THEN
+                  mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp
+               END IF
+               IF( zmisfdep(ji,jj) < ibtest .AND. misfdep(ji,jj) >= 2) THEN
+                  misfdep(ji,jj) = ibtest
+                  risfdep(ji,jj) = gdepw_1d(ibtest)
+               ENDIF
+            ENDDO
+         ENDDO
+ 
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
+            CALL lbc_lnk( zbathy,  'T', 1. ) 
+            misfdep(:,:) = INT( zbathy(:,:) ) 
+
+            CALL lbc_lnk( risfdep, 'T', 1. ) 
+            CALL lbc_lnk( bathy,   'T', 1. )
+
+            zbathy(:,:) = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy,  'T', 1. )
+            mbathy(:,:) = INT( zbathy(:,:) )
+         ENDIF 
+ !
+ !! fill hole in bathymetry
+         zmbathy (:,:)=mbathy (:,:)
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ibtestim1 = zmbathy(ji-1,jj  ) ; ibtestip1 = zmbathy(ji+1,jj  )
+               ibtestjm1 = zmbathy(ji  ,jj-1) ; ibtestjp1 = zmbathy(ji  ,jj+1)
+               IF( zmbathy(ji,jj) <  misfdep(ji-1,jj  ) ) ibtestim1 = 0
+               IF( zmbathy(ji,jj) <  misfdep(ji+1,jj  ) ) ibtestip1 = 0
+               IF( zmbathy(ji,jj) <  misfdep(ji  ,jj-1) ) ibtestjm1 = 0
+               IF( zmbathy(ji,jj) <  misfdep(ji  ,jj+1) ) ibtestjp1 = 0
+               ibtest=MAX(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1)
+               IF( ibtest == 0 .AND. misfdep(ji,jj) >= 2) THEN
+                  mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp ;
+               END IF
+               IF( ibtest < zmbathy(ji,jj) .AND. misfdep(ji,jj) >= 2) THEN
+                  mbathy(ji,jj) = ibtest
+                  bathy(ji,jj)  = gdepw_1d(ibtest+1) 
+               ENDIF
+            END DO
+         END DO
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
+            CALL lbc_lnk( zbathy,  'T', 1. ) 
+            misfdep(:,:) = INT( zbathy(:,:) ) 
+
+            CALL lbc_lnk( risfdep, 'T', 1. ) 
+            CALL lbc_lnk( bathy,   'T', 1. )
+
+            zbathy(:,:) = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy,  'T', 1. )
+            mbathy(:,:) = INT( zbathy(:,:) )
+         ENDIF 
+ ! if not compatible after all check (ie U point water column less than 2 cells), mask U
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               IF (mbathy(ji,jj) == misfdep(ji+1,jj) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji+1,jj) >= 1) THEN
+                  mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ;
+               END IF
+            END DO
+         END DO
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
+            CALL lbc_lnk( zbathy,  'T', 1. ) 
+            misfdep(:,:) = INT( zbathy(:,:) ) 
+
+            CALL lbc_lnk( risfdep, 'T', 1. ) 
+            CALL lbc_lnk( bathy,   'T', 1. )
+
+            zbathy(:,:) = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy,  'T', 1. )
+            mbathy(:,:) = INT( zbathy(:,:) )
+         ENDIF 
+ ! if not compatible after all check (ie U point water column less than 2 cells), mask U
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               IF (misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji+1,jj) >= 1) THEN
+                  mbathy(ji+1,jj)  = mbathy(ji+1,jj) - 1;   bathy(ji+1,jj)   = gdepw_1d(mbathy(ji+1,jj)+1) ;
+               END IF
+            END DO
+         END DO
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
+            CALL lbc_lnk( zbathy, 'T', 1. ) 
+            misfdep(:,:) = INT( zbathy(:,:) ) 
+
+            CALL lbc_lnk( risfdep,'T', 1. ) 
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:) = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:) = INT( zbathy(:,:) )
+         ENDIF 
+ ! if not compatible after all check (ie V point water column less than 2 cells), mask V
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               IF (mbathy(ji,jj) == misfdep(ji,jj+1) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji,jj+1) >= 1) THEN
+                  mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ;
+               END IF
+            END DO
+         END DO
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
+            CALL lbc_lnk( zbathy, 'T', 1. ) 
+            misfdep(:,:) = INT( zbathy(:,:) ) 
+
+            CALL lbc_lnk( risfdep,'T', 1. ) 
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:) = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:) = INT( zbathy(:,:) )
+         ENDIF 
+ ! if not compatible after all check (ie V point water column less than 2 cells), mask V
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               IF (misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji,jj+1) >= 1) THEN
+                  mbathy(ji,jj+1)  = mbathy(ji,jj+1) - 1 ; bathy(ji,jj+1) = gdepw_1d(mbathy(ji,jj+1)+1) ;
+               END IF
+            END DO
+         END DO
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
+            CALL lbc_lnk( zbathy, 'T', 1. ) 
+            misfdep(:,:) = INT( zbathy(:,:) ) 
+
+            CALL lbc_lnk( risfdep,'T', 1. ) 
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:) = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:) = INT( zbathy(:,:) )
+         ENDIF 
+ ! if not compatible after all check, mask T
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF (mbathy(ji,jj) <= misfdep(ji,jj)) THEN
+                  misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0._wp ; mbathy(ji,jj)  = 0 ; bathy(ji,jj)   = 0._wp ;
+               END IF
+            END DO
+         END DO
+ 
+         WHERE (mbathy(:,:) == 1)
+            mbathy = 0; bathy = 0.0_wp ; misfdep = 0 ; risfdep = 0.0_wp
+         END WHERE
+      END DO 
+! end check compatibility ice shelf/bathy
+      ! remove very shallow ice shelf (less than ~ 10m if 75L)
+      WHERE (risfdep(:,:) <= 10._wp)
+         misfdep = 1; risfdep = 0.0_wp;
+      END WHERE
+
+      IF( icompt == 0 ) THEN 
+         IF(lwp) WRITE(numout,*)'     no points with ice shelf too close to bathymetry' 
+      ELSE 
+         IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points with ice shelf thickness reduced to avoid bathymetry' 
+      ENDIF 
+
+      ! compute scale factor and depth at T- and W- points
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -1024,4 +1747,5 @@
                   ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
                   ENDIF
+      !            gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
 !gm Bug?  check the gdepw_1d
                   !       ... on ik
@@ -1029,12 +1753,9 @@
                      &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   &
                      &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) ))
-                  e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   & 
-                     &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik) ) 
-                  e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   &
-                     &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
+                  e3t_0  (ji,jj,ik  ) = gdepw_0(ji,jj,ik+1) - gdepw_1d(ik  )
+                  e3w_0  (ji,jj,ik  ) = gdept_0(ji,jj,ik  ) - gdept_1d(ik-1)
                   !       ... on ik+1
                   e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
                   e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
-                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik)
                ENDIF
             ENDIF
@@ -1062,687 +1783,58 @@
       END DO
       !
-      IF ( ln_isfcav ) THEN
       ! (ISF) Definition of e3t, u, v, w for ISF case
-         DO jj = 1, jpj 
-            DO ji = 1, jpi 
-               ik = misfdep(ji,jj) 
-               IF( ik > 1 ) THEN               ! ice shelf point only 
-                  IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik) 
-                  gdepw_0(ji,jj,ik) = risfdep(ji,jj) 
+      DO jj = 1, jpj 
+         DO ji = 1, jpi 
+            ik = misfdep(ji,jj) 
+            IF( ik > 1 ) THEN               ! ice shelf point only 
+               IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik) 
+               gdepw_0(ji,jj,ik) = risfdep(ji,jj) 
 !gm Bug?  check the gdepw_0 
-               !       ... on ik 
-                  gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   & 
-                     &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   & 
-                     &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      ) 
-                  e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) 
-                  e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik)
-
-                  IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column) 
-                     e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik) 
-                  ENDIF 
-               !       ... on ik / ik-1 
-                  e3w_0  (ji,jj,ik  ) = 2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik)) 
-                  e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1)
+            !       ... on ik 
+               gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   & 
+                  &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   & 
+                  &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      ) 
+               e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) 
+               e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik)
+
+               IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column) 
+                  e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik) 
+               ENDIF 
+            !       ... on ik / ik-1 
+               e3w_0  (ji,jj,ik  ) = e3t_0  (ji,jj,ik) !2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik)) 
+               e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1)
 ! The next line isn't required and doesn't affect results - included for consistency with bathymetry code 
-                  gdept_0(ji,jj,ik-1) = gdept_1d(ik-1)
+               gdept_0(ji,jj,ik-1) = gdept_1d(ik-1)
+            ENDIF 
+         END DO 
+      END DO 
+   
+      it = 0 
+      DO jj = 1, jpj 
+         DO ji = 1, jpi 
+            ik = misfdep(ji,jj) 
+            IF( ik > 1 ) THEN               ! ice shelf point only 
+               e3tp (ji,jj) = e3t_0(ji,jj,ik  ) 
+               e3wp (ji,jj) = e3w_0(ji,jj,ik+1 ) 
+            ! test 
+               zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  ) 
+               IF( zdiff <= 0. .AND. lwp ) THEN  
+                  it = it + 1 
+                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
+                  WRITE(numout,*) ' risfdep = ', risfdep(ji,jj) 
+                  WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 
+                  WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj) 
                ENDIF 
-            END DO 
+            ENDIF 
          END DO 
-      ! 
-         it = 0 
-         DO jj = 1, jpj 
-            DO ji = 1, jpi 
-               ik = misfdep(ji,jj) 
-               IF( ik > 1 ) THEN               ! ice shelf point only 
-                  e3tp (ji,jj) = e3t_0(ji,jj,ik  ) 
-                  e3wp (ji,jj) = e3w_0(ji,jj,ik+1 ) 
-               ! test 
-                  zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  ) 
-                  IF( zdiff <= 0. .AND. lwp ) THEN  
-                     it = it + 1 
-                     WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
-                     WRITE(numout,*) ' risfdep = ', risfdep(ji,jj) 
-                     WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 
-                     WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj) 
-                  ENDIF 
-               ENDIF 
-            END DO 
-         END DO 
-      END IF
-      ! END (ISF)
-
-      ! Scale factors and depth at U-, V-, UW and VW-points
-      DO jk = 1, jpk                        ! initialisation to z-scale factors
-         e3u_0 (:,:,jk) = e3t_1d(jk)
-         e3v_0 (:,:,jk) = e3t_1d(jk)
-         e3uw_0(:,:,jk) = e3w_1d(jk)
-         e3vw_0(:,:,jk) = e3w_1d(jk)
-      END DO
-      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
-               e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
-               e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) )
-               e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) )
-            END DO
-         END DO
-      END DO
-      IF ( ln_isfcav ) THEN
-      ! (ISF) define e3uw (adapted for 2 cells in the water column)
-         DO jj = 2, jpjm1 
-            DO ji = 2, fs_jpim1   ! vector opt. 
-               ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj))
-               ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj))
-               IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) &
-                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) )
-               ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1))
-               ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1))
-               IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) &
-                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) )
-            END DO
-         END DO
-      END IF
-
-      CALL lbc_lnk( e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_0, 'U', 1._wp )   ! lateral boundary conditions
-      CALL lbc_lnk( e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_0, 'V', 1._wp )
-      !
-      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
-         WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk)
-         WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk)
-         WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk)
-         WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk)
-      END DO
-      
-      ! Scale factor at F-point
-      DO jk = 1, jpk                        ! initialisation to z-scale factors
-         e3f_0(:,:,jk) = e3t_1d(jk)
-      END DO
-      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( e3f_0, 'F', 1._wp )       ! Lateral boundary conditions
-      !
-      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
-         WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk)
-      END DO
-!!gm  bug ? :  must be a do loop with mj0,mj1
-      ! 
-      e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2
-      e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:) 
-      e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:) 
-      e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:) 
-      e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:) 
-
-      ! Control of the sign
-      IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' )
-      IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' )
-      IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' )
-      IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' )
-     
-      ! Compute gdep3w_0 (vertical sum of e3w)
-      IF ( ln_isfcav ) THEN ! if cavity
-         WHERE (misfdep == 0) misfdep = 1
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               gdep3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1)
-               DO jk = 2, misfdep(ji,jj)
-                  gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
-               END DO
-               IF (misfdep(ji,jj) .GE. 2) gdep3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj))
-               DO jk = misfdep(ji,jj) + 1, jpk
-                  gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
-               END DO
-            END DO
-         END DO
-      ELSE ! no cavity
-         gdep3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1)
-         DO jk = 2, jpk
-            gdep3w_0(:,:,jk) = gdep3w_0(:,:,jk-1) + e3w_0(:,:,jk)
-         END DO
-      END IF
-      !                                               ! ================= !
-      IF(lwp .AND. ll_print) THEN                     !   Control print   !
-         !                                            ! ================= !
-         DO jj = 1,jpj
-            DO ji = 1, jpi
-               ik = MAX( mbathy(ji,jj), 1 )
-               zprt(ji,jj,1) = e3t_0   (ji,jj,ik)
-               zprt(ji,jj,2) = e3w_0   (ji,jj,ik)
-               zprt(ji,jj,3) = e3u_0   (ji,jj,ik)
-               zprt(ji,jj,4) = e3v_0   (ji,jj,ik)
-               zprt(ji,jj,5) = e3f_0   (ji,jj,ik)
-               zprt(ji,jj,6) = gdep3w_0(ji,jj,ik)
-            END DO
-         END DO
-         WRITE(numout,*)
-         WRITE(numout,*) 'domzgr e3t(mbathy)'      ;   CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'domzgr e3w(mbathy)'      ;   CALL prihre(zprt(:,:,2),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'domzgr e3u(mbathy)'      ;   CALL prihre(zprt(:,:,3),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'domzgr e3v(mbathy)'      ;   CALL prihre(zprt(:,:,4),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'domzgr e3f(mbathy)'      ;   CALL prihre(zprt(:,:,5),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'domzgr gdep3w(mbathy)'   ;   CALL prihre(zprt(:,:,6),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-      ENDIF  
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zprt )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('zgr_zps')
-      !
-   END SUBROUTINE zgr_zps
-
-   SUBROUTINE zgr_isf
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE zgr_isf  ***
-      !!   
-      !! ** Purpose :   check the bathymetry in levels
-      !!   
-      !! ** Method  :   THe water column have to contained at least 2 cells
-      !!                Bathymetry and isfdraft are modified (dig/close) to respect
-      !!                this criterion.
-      !!                 
-      !!   
-      !! ** Action  : - test compatibility between isfdraft and bathy 
-      !!              - bathy and isfdraft are modified
-      !!----------------------------------------------------------------------
-      !!   
-      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      INTEGER  ::   ik, it           ! temporary integers
-      INTEGER  ::   id, jd, nprocd
-      INTEGER  ::   icompt, ibtest, ibtestim1, ibtestip1, ibtestjm1, ibtestjp1   ! (ISF)
-      LOGICAL  ::   ll_print         ! Allow  control print for debugging
-      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
-      REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t
-      REAL(wp) ::   zmax, zmin       ! Maximum and minimum depth
-      REAL(wp) ::   zdiff            ! temporary scalar
-      REAL(wp) ::   zrefdep          ! temporary scalar
-      REAL(wp) ::   zbathydiff, zrisfdepdiff  ! isf temporary scalar
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zrisfdep, zbathy, zmask   ! 2D workspace (ISH)
-      INTEGER , POINTER, DIMENSION(:,:)   ::   zmbathy, zmisfdep         ! 2D workspace (ISH)
-      !!---------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('zgr_isf')
-      !
-      CALL wrk_alloc( jpi, jpj, zbathy, zmask, zrisfdep)
-      CALL wrk_alloc( jpi, jpj, zmisfdep, zmbathy )
-
-
-      ! (ISF) compute misfdep
-      WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) .NE. 0) ;   misfdep(:,:) = 1   ! open water : set misfdep to 1  
-      ELSEWHERE                      ;                          misfdep(:,:) = 2   ! iceshelf : initialize misfdep to second level 
-      END WHERE  
-
-      ! Compute misfdep for ocean points (i.e. first wet level) 
-      ! find the first ocean level such that the first level thickness 
-      ! is larger than the bot_level of e3zps_min and e3zps_rat * e3t_0 (where 
-      ! e3t_0 is the reference level thickness 
-      DO jk = 2, jpkm1 
-         zdepth = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
-         WHERE( 0._wp < risfdep(:,:) .AND. risfdep(:,:) >= zdepth )   misfdep(:,:) = jk+1 
       END DO 
-      WHERE (risfdep(:,:) <= e3t_1d(1) .AND. risfdep(:,:) .GT. 0._wp)
-         risfdep(:,:) = 0. ; misfdep(:,:) = 1
-      END WHERE
- 
-! basic check for the compatibility of bathy and risfdep. I think it should be offline because it is not perfect and cannot solved all the situation
-      icompt = 0 
-! run the bathy check 10 times to be sure all the modif in the bathy or iceshelf draft are compatible together
-      DO jl = 1, 10     
-         WHERE (bathy(:,:) .EQ. risfdep(:,:) )
-            misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp
-            mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp
-         END WHERE
-         WHERE (mbathy(:,:) <= 0) 
-            misfdep(:,:) = 0; risfdep(:,:) = 0._wp 
-            mbathy (:,:) = 0; bathy  (:,:) = 0._wp
-         ENDWHERE
-         IF( lk_mpp ) THEN
-            zbathy(:,:) = FLOAT( misfdep(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            misfdep(:,:) = INT( zbathy(:,:) )
-            CALL lbc_lnk( risfdep, 'T', 1. )
-            CALL lbc_lnk( bathy, 'T', 1. )
-            zbathy(:,:) = FLOAT( mbathy(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            mbathy(:,:) = INT( zbathy(:,:) )
-         ENDIF
-         IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN 
-            misfdep( 1 ,:) = misfdep(jpim1,:)           ! local domain is cyclic east-west 
-            misfdep(jpi,:) = misfdep(  2  ,:) 
-         ENDIF
-
-         IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN
-            mbathy( 1 ,:) = mbathy(jpim1,:)             ! local domain is cyclic east-west
-            mbathy(jpi,:) = mbathy(  2  ,:)
-         ENDIF
-
-         ! split last cell if possible (only where water column is 2 cell or less)
-         DO jk = jpkm1, 1, -1
-            zmax = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
-            WHERE( gdepw_1d(jk) < bathy(:,:) .AND. bathy(:,:) <= zmax .AND. misfdep + 1 >= mbathy)
-               mbathy(:,:) = jk
-               bathy(:,:)  = zmax
-            END WHERE
-         END DO
- 
-         ! split top cell if possible (only where water column is 2 cell or less)
-         DO jk = 2, jpkm1
-            zmax = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
-            WHERE( gdepw_1d(jk+1) > risfdep(:,:) .AND. risfdep(:,:) >= zmax .AND. misfdep + 1 >= mbathy)
-               misfdep(:,:) = jk
-               risfdep(:,:) = zmax
-            END WHERE
-         END DO
-
- 
- ! Case where bathy and risfdep compatible but not the level variable mbathy/misfdep because of partial cell condition
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! find the minimum change option:
-               ! test bathy
-               IF (risfdep(ji,jj) .GT. 1) THEN
-               zbathydiff =ABS(bathy(ji,jj)   - (gdepw_1d(mbathy (ji,jj)+1) &
-                 &   + MIN( e3zps_min, e3t_1d(mbathy (ji,jj)+1)*e3zps_rat )))
-               zrisfdepdiff=ABS(risfdep(ji,jj) - (gdepw_1d(misfdep(ji,jj)  ) &
-                 &   - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat )))
- 
-                  IF (bathy(ji,jj) .GT. risfdep(ji,jj) .AND. mbathy(ji,jj) .LT. misfdep(ji,jj)) THEN
-                     IF (zbathydiff .LE. zrisfdepdiff) THEN
-                        bathy(ji,jj) = gdepw_1d(mbathy(ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj)+1)*e3zps_rat )
-                        mbathy(ji,jj)= mbathy(ji,jj) + 1
-                     ELSE
-                        risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat )
-                        misfdep(ji,jj) = misfdep(ji,jj) - 1
-                     END IF
-                  END IF
-               END IF
-            END DO
-         END DO
- 
-          ! At least 2 levels for water thickness at T, U, and V point.
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! find the minimum change option:
-               ! test bathy
-               IF( misfdep(ji,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT. 1) THEN
-                  zbathydiff  =ABS(bathy(ji,jj)  - (gdepw_1d(mbathy (ji,jj)+1)&
-                    & + MIN( e3zps_min,e3t_1d(mbathy (ji,jj)+1)*e3zps_rat )))
-                  zrisfdepdiff=ABS(risfdep(ji,jj) - (gdepw_1d(misfdep(ji,jj)  )  &
-                    & - MIN( e3zps_min,e3t_1d(misfdep(ji,jj)-1)*e3zps_rat )))
-                  IF (zbathydiff .LE. zrisfdepdiff) THEN
-                     mbathy(ji,jj) = mbathy(ji,jj) + 1
-                     bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat )
-                  ELSE
-                     misfdep(ji,jj)= misfdep(ji,jj) - 1
-                     risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj))*e3zps_rat )
-                  END IF
-               ENDIF
-            END DO
-         END DO
- 
- ! point V mbathy(ji,jj) EQ misfdep(ji,jj+1) 
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               IF( misfdep(ji,jj+1) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT. 1) THEN
-                  zbathydiff =ABS(bathy(ji,jj    ) - (gdepw_1d(mbathy (ji,jj)+1)   &
-                    &   + MIN( e3zps_min, e3t_1d(mbathy (ji,jj  )+1)*e3zps_rat )))
-                  zrisfdepdiff=ABS(risfdep(ji,jj+1) - (gdepw_1d(misfdep(ji,jj+1))  &
-                    &  - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1)-1)*e3zps_rat )))
-                  IF (zbathydiff .LE. zrisfdepdiff) THEN
-                     mbathy(ji,jj) = mbathy(ji,jj) + 1
-                     bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj  )) &
-                   &    + MIN( e3zps_min, e3t_1d(mbathy(ji,jj   )+1)*e3zps_rat )
-                  ELSE
-                     misfdep(ji,jj+1)  = misfdep(ji,jj+1) - 1
-                     risfdep (ji,jj+1) = gdepw_1d(misfdep(ji,jj+1)+1) &
-                   &   - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1))*e3zps_rat )
-                  END IF
-               ENDIF
-            END DO
-         END DO
- 
-         IF( lk_mpp ) THEN
-            zbathy(:,:) = FLOAT( misfdep(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            misfdep(:,:) = INT( zbathy(:,:) )
-            CALL lbc_lnk( risfdep, 'T', 1. )
-            CALL lbc_lnk( bathy, 'T', 1. )
-            zbathy(:,:) = FLOAT( mbathy(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            mbathy(:,:) = INT( zbathy(:,:) )
-         ENDIF
- ! point V misdep(ji,jj) EQ mbathy(ji,jj+1) 
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               IF( misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) .GT. 1) THEN
-                  zbathydiff =ABS(  bathy(ji,jj+1) - (gdepw_1d(mbathy (ji,jj+1)+1) &
-                   &   + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat )))
-                  zrisfdepdiff=ABS(risfdep(ji,jj  ) - (gdepw_1d(misfdep(ji,jj  )  )  &
-                   &   - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )-1)*e3zps_rat )))
-                  IF (zbathydiff .LE. zrisfdepdiff) THEN
-                     mbathy (ji,jj+1) = mbathy(ji,jj+1) + 1
-                     bathy  (ji,jj+1) = gdepw_1d(mbathy (ji,jj+1)  ) + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat )
-                  ELSE
-                     misfdep(ji,jj)   = misfdep(ji,jj) - 1
-                     risfdep(ji,jj)   = gdepw_1d(misfdep(ji,jj  )+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )  )*e3zps_rat )
-                  END IF
-               ENDIF
-            END DO
-         END DO
- 
- 
-         IF( lk_mpp ) THEN 
-            zbathy(:,:) = FLOAT( misfdep(:,:) ) 
-            CALL lbc_lnk( zbathy, 'T', 1. ) 
-            misfdep(:,:) = INT( zbathy(:,:) ) 
-            CALL lbc_lnk( risfdep, 'T', 1. ) 
-            CALL lbc_lnk( bathy, 'T', 1. )
-            zbathy(:,:) = FLOAT( mbathy(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            mbathy(:,:) = INT( zbathy(:,:) )
-         ENDIF 
- 
- ! point U mbathy(ji,jj) EQ misfdep(ji,jj+1) 
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               IF( misfdep(ji+1,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT. 1) THEN
-                  zbathydiff =ABS(  bathy(ji  ,jj) - (gdepw_1d(mbathy (ji,jj)+1) &
-                    &   + MIN( e3zps_min, e3t_1d(mbathy (ji  ,jj)+1)*e3zps_rat )))
-                  zrisfdepdiff=ABS(risfdep(ji+1,jj) - (gdepw_1d(misfdep(ji+1,jj)) &
-                    &  - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj)-1)*e3zps_rat )))
-                  IF (zbathydiff .LE. zrisfdepdiff) THEN
-                     mbathy(ji,jj) = mbathy(ji,jj) + 1
-                     bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat )
-                  ELSE
-                     misfdep(ji+1,jj)= misfdep(ji+1,jj) - 1
-                     risfdep(ji+1,jj) = gdepw_1d(misfdep(ji+1,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj))*e3zps_rat )
-                  END IF
-               ENDIF
-            ENDDO
-         ENDDO
- 
-         IF( lk_mpp ) THEN 
-            zbathy(:,:) = FLOAT( misfdep(:,:) ) 
-            CALL lbc_lnk( zbathy, 'T', 1. ) 
-            misfdep(:,:) = INT( zbathy(:,:) ) 
-            CALL lbc_lnk( risfdep, 'T', 1. ) 
-            CALL lbc_lnk( bathy, 'T', 1. )
-            zbathy(:,:) = FLOAT( mbathy(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            mbathy(:,:) = INT( zbathy(:,:) )
-         ENDIF 
- 
- ! point U misfdep(ji,jj) EQ bathy(ji,jj+1) 
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               IF( misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) .GT. 1) THEN
-                  zbathydiff =ABS(  bathy(ji+1,jj) - (gdepw_1d(mbathy (ji+1,jj)+1) &
-                      &   + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj)+1)*e3zps_rat )))
-                  zrisfdepdiff=ABS(risfdep(ji  ,jj) - (gdepw_1d(misfdep(ji  ,jj)  )  &
-                      &  - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)-1)*e3zps_rat )))
-                  IF (zbathydiff .LE. zrisfdepdiff) THEN
-                     mbathy(ji+1,jj)  = mbathy (ji+1,jj) + 1
-                     bathy (ji+1,jj)  = gdepw_1d(mbathy (ji+1,jj)  )  &
-                      &   + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj) +1)*e3zps_rat )
-                  ELSE
-                     misfdep(ji,jj)   = misfdep(ji  ,jj) - 1
-                     risfdep(ji,jj)   = gdepw_1d(misfdep(ji  ,jj)+1) &
-                      &   - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)   )*e3zps_rat )
-                  END IF
-               ENDIF
-            ENDDO
-         ENDDO
- 
-         IF( lk_mpp ) THEN
-            zbathy(:,:) = FLOAT( misfdep(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            misfdep(:,:) = INT( zbathy(:,:) )
-            CALL lbc_lnk( risfdep, 'T', 1. )
-            CALL lbc_lnk( bathy, 'T', 1. )
-            zbathy(:,:) = FLOAT( mbathy(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            mbathy(:,:) = INT( zbathy(:,:) )
-         ENDIF
-      END DO
-      ! end dig bathy/ice shelf to be compatible
-      ! now fill single point in "coastline" of ice shelf, bathy, hole, and test again one cell tickness
-      DO jl = 1,20
- 
- ! remove single point "bay" on isf coast line in the ice shelf draft'
-         DO jk = 2, jpk
-            WHERE (misfdep==0) misfdep=jpk
-            zmask=0
-            WHERE (misfdep .LE. jk) zmask=1
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  IF (misfdep(ji,jj) .EQ. jk) THEN
-                     ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1)
-                     IF (ibtest .LE. 1) THEN
-                        risfdep(ji,jj)=gdepw_1d(jk+1) ; misfdep(ji,jj)=jk+1
-                        IF (misfdep(ji,jj) .GT. mbathy(ji,jj)) misfdep(ji,jj) = jpk
-                     END IF
-                  END IF
-               END DO
-            END DO
-         END DO
-         WHERE (misfdep==jpk)
-             misfdep=0 ; risfdep=0. ; mbathy=0 ; bathy=0.
-         END WHERE
-         IF( lk_mpp ) THEN
-            zbathy(:,:) = FLOAT( misfdep(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            misfdep(:,:) = INT( zbathy(:,:) )
-            CALL lbc_lnk( risfdep, 'T', 1. )
-            CALL lbc_lnk( bathy, 'T', 1. )
-            zbathy(:,:) = FLOAT( mbathy(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            mbathy(:,:) = INT( zbathy(:,:) )
-         ENDIF
- 
- ! remove single point "bay" on bathy coast line beneath an ice shelf'
-         DO jk = jpk,1,-1
-            zmask=0
-            WHERE (mbathy .GE. jk ) zmask=1
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  IF (mbathy(ji,jj) .EQ. jk .AND. misfdep(ji,jj) .GE. 2) THEN
-                     ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1)
-                     IF (ibtest .LE. 1) THEN
-                        bathy(ji,jj)=gdepw_1d(jk) ; mbathy(ji,jj)=jk-1
-                        IF (misfdep(ji,jj) .GT. mbathy(ji,jj)) mbathy(ji,jj) = 0
-                     END IF
-                  END IF
-               END DO
-            END DO
-         END DO
-         WHERE (mbathy==0)
-             misfdep=0 ; risfdep=0. ; mbathy=0 ; bathy=0.
-         END WHERE
-         IF( lk_mpp ) THEN
-            zbathy(:,:) = FLOAT( misfdep(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            misfdep(:,:) = INT( zbathy(:,:) )
-            CALL lbc_lnk( risfdep, 'T', 1. )
-            CALL lbc_lnk( bathy, 'T', 1. )
-            zbathy(:,:) = FLOAT( mbathy(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            mbathy(:,:) = INT( zbathy(:,:) )
-         ENDIF
- 
- ! fill hole in ice shelf
-         zmisfdep = misfdep
-         zrisfdep = risfdep
-         WHERE (zmisfdep .LE. 1) zmisfdep=jpk
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               ibtestim1 = zmisfdep(ji-1,jj  ) ; ibtestip1 = zmisfdep(ji+1,jj  )
-               ibtestjm1 = zmisfdep(ji  ,jj-1) ; ibtestjp1 = zmisfdep(ji  ,jj+1)
-               IF( zmisfdep(ji,jj) .GE. mbathy(ji-1,jj  ) ) ibtestim1 = jpk!MAX(0, mbathy(ji-1,jj  ) - 1)
-               IF( zmisfdep(ji,jj) .GE. mbathy(ji+1,jj  ) ) ibtestip1 = jpk!MAX(0, mbathy(ji+1,jj  ) - 1)
-               IF( zmisfdep(ji,jj) .GE. mbathy(ji  ,jj-1) ) ibtestjm1 = jpk!MAX(0, mbathy(ji  ,jj-1) - 1)
-               IF( zmisfdep(ji,jj) .GE. mbathy(ji  ,jj+1) ) ibtestjp1 = jpk!MAX(0, mbathy(ji  ,jj+1) - 1)
-               ibtest=MIN(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1)
-               IF( ibtest == jpk .AND. misfdep(ji,jj) .GE. 2) THEN
-                  mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp
-               END IF
-               IF( zmisfdep(ji,jj) < ibtest .AND. misfdep(ji,jj) .GE. 2) THEN
-                  misfdep(ji,jj) = ibtest
-                  risfdep(ji,jj) = gdepw_1d(ibtest)
-               ENDIF
-            ENDDO
-         ENDDO
- 
-         IF( lk_mpp ) THEN 
-            zbathy(:,:) = FLOAT( misfdep(:,:) ) 
-            CALL lbc_lnk( zbathy, 'T', 1. ) 
-            misfdep(:,:) = INT( zbathy(:,:) ) 
-            CALL lbc_lnk( risfdep, 'T', 1. ) 
-            CALL lbc_lnk( bathy, 'T', 1. )
-            zbathy(:,:) = FLOAT( mbathy(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            mbathy(:,:) = INT( zbathy(:,:) )
-         ENDIF 
- !
- !! fill hole in bathymetry
-         zmbathy (:,:)=mbathy (:,:)
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               ibtestim1 = zmbathy(ji-1,jj  ) ; ibtestip1 = zmbathy(ji+1,jj  )
-               ibtestjm1 = zmbathy(ji  ,jj-1) ; ibtestjp1 = zmbathy(ji  ,jj+1)
-               IF( zmbathy(ji,jj) .LT. misfdep(ji-1,jj  ) ) ibtestim1 = 0!MIN(jpk-1, misfdep(ji-1,jj  ) + 1)
-               IF( zmbathy(ji,jj) .LT. misfdep(ji+1,jj  ) ) ibtestip1 = 0
-               IF( zmbathy(ji,jj) .LT. misfdep(ji  ,jj-1) ) ibtestjm1 = 0
-               IF( zmbathy(ji,jj) .LT. misfdep(ji  ,jj+1) ) ibtestjp1 = 0
-               ibtest=MAX(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1)
-               IF( ibtest == 0 .AND. misfdep(ji,jj) .GE. 2) THEN
-                  mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp ;
-               END IF
-               IF( ibtest < zmbathy(ji,jj) .AND. misfdep(ji,jj) .GE. 2) THEN
-                  mbathy(ji,jj) = ibtest
-                  bathy(ji,jj)  = gdepw_1d(ibtest+1) 
-               ENDIF
-            END DO
-         END DO
-         IF( lk_mpp ) THEN 
-            zbathy(:,:) = FLOAT( misfdep(:,:) ) 
-            CALL lbc_lnk( zbathy, 'T', 1. ) 
-            misfdep(:,:) = INT( zbathy(:,:) ) 
-            CALL lbc_lnk( risfdep, 'T', 1. ) 
-            CALL lbc_lnk( bathy, 'T', 1. )
-            zbathy(:,:) = FLOAT( mbathy(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            mbathy(:,:) = INT( zbathy(:,:) )
-         ENDIF 
- ! if not compatible after all check (ie U point water column less than 2 cells), mask U
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               IF (mbathy(ji,jj) == misfdep(ji+1,jj) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji+1,jj) .GE. 1) THEN
-                  mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ;
-               END IF
-            END DO
-         END DO
-         IF( lk_mpp ) THEN 
-            zbathy(:,:) = FLOAT( misfdep(:,:) ) 
-            CALL lbc_lnk( zbathy, 'T', 1. ) 
-            misfdep(:,:) = INT( zbathy(:,:) ) 
-            CALL lbc_lnk( risfdep, 'T', 1. ) 
-            CALL lbc_lnk( bathy, 'T', 1. )
-            zbathy(:,:) = FLOAT( mbathy(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            mbathy(:,:) = INT( zbathy(:,:) )
-         ENDIF 
- ! if not compatible after all check (ie U point water column less than 2 cells), mask U
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               IF (misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji+1,jj) .GE. 1) THEN
-                  mbathy(ji+1,jj)  = mbathy(ji+1,jj) - 1;   bathy(ji+1,jj)   = gdepw_1d(mbathy(ji+1,jj)+1) ;
-               END IF
-            END DO
-         END DO
-         IF( lk_mpp ) THEN 
-            zbathy(:,:) = FLOAT( misfdep(:,:) ) 
-            CALL lbc_lnk( zbathy, 'T', 1. ) 
-            misfdep(:,:) = INT( zbathy(:,:) ) 
-            CALL lbc_lnk( risfdep, 'T', 1. ) 
-            CALL lbc_lnk( bathy, 'T', 1. )
-            zbathy(:,:) = FLOAT( mbathy(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            mbathy(:,:) = INT( zbathy(:,:) )
-         ENDIF 
- ! if not compatible after all check (ie V point water column less than 2 cells), mask V
-         DO jj = 1, jpjm1
-            DO ji = 1, jpi
-               IF (mbathy(ji,jj) == misfdep(ji,jj+1) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji,jj+1) .GE. 1) THEN
-                  mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ;
-               END IF
-            END DO
-         END DO
-         IF( lk_mpp ) THEN 
-            zbathy(:,:) = FLOAT( misfdep(:,:) ) 
-            CALL lbc_lnk( zbathy, 'T', 1. ) 
-            misfdep(:,:) = INT( zbathy(:,:) ) 
-            CALL lbc_lnk( risfdep, 'T', 1. ) 
-            CALL lbc_lnk( bathy, 'T', 1. )
-            zbathy(:,:) = FLOAT( mbathy(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            mbathy(:,:) = INT( zbathy(:,:) )
-         ENDIF 
- ! if not compatible after all check (ie V point water column less than 2 cells), mask V
-         DO jj = 1, jpjm1
-            DO ji = 1, jpi
-               IF (misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) .GE. 1 .AND. mbathy(ji,jj+1) .GE. 1) THEN
-                  mbathy(ji,jj+1)  = mbathy(ji,jj+1) - 1 ; bathy(ji,jj+1)   = gdepw_1d(mbathy(ji,jj+1)+1) ;
-               END IF
-            END DO
-         END DO
-         IF( lk_mpp ) THEN 
-            zbathy(:,:) = FLOAT( misfdep(:,:) ) 
-            CALL lbc_lnk( zbathy, 'T', 1. ) 
-            misfdep(:,:) = INT( zbathy(:,:) ) 
-            CALL lbc_lnk( risfdep, 'T', 1. ) 
-            CALL lbc_lnk( bathy, 'T', 1. )
-            zbathy(:,:) = FLOAT( mbathy(:,:) )
-            CALL lbc_lnk( zbathy, 'T', 1. )
-            mbathy(:,:) = INT( zbathy(:,:) )
-         ENDIF 
- ! if not compatible after all check, mask T
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF (mbathy(ji,jj) <= misfdep(ji,jj)) THEN
-                  misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0._wp ; mbathy(ji,jj)  = 0 ; bathy(ji,jj)   = 0._wp ;
-               END IF
-            END DO
-         END DO
- 
-         WHERE (mbathy(:,:) == 1)
-            mbathy = 0; bathy = 0.0_wp ; misfdep = 0 ; risfdep = 0.0_wp
-         END WHERE
-      END DO 
-! end check compatibility ice shelf/bathy
-      ! remove very shallow ice shelf (less than ~ 10m if 75L)
-      WHERE (misfdep(:,:) <= 5)
-         misfdep = 1; risfdep = 0.0_wp;
-      END WHERE
-
-      IF( icompt == 0 ) THEN 
-         IF(lwp) WRITE(numout,*)'     no points with ice shelf too close to bathymetry' 
-      ELSE 
-         IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points with ice shelf thickness reduced to avoid bathymetry' 
-      ENDIF 
 
       CALL wrk_dealloc( jpi, jpj, zmask, zbathy, zrisfdep )
       CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy )
-
-      IF( nn_timing == 1 )  CALL timing_stop('zgr_isf')
-      
-   END SUBROUTINE
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('zgr_isf')
+      !      
+   END SUBROUTINE zgr_isf
+
 
    SUBROUTINE zgr_sco
@@ -1790,5 +1882,4 @@
       !!
       !!----------------------------------------------------------------------
-      !
       INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument
       INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers
@@ -1799,12 +1890,12 @@
       REAL(wp), POINTER, DIMENSION(:,:  ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat
-
+      !!
       NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, &
-                           rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b
+         &                rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b
      !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('zgr_sco')
       !
-      CALL wrk_alloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 )
+      CALL wrk_alloc( jpi,jpj,   zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 )
       !
       REWIND( numnam_ref )              ! Namelist namzgr_sco in reference namelist : Sigma-stretching parameters
@@ -1851,9 +1942,11 @@
       bathy(:,:) = MIN( rn_sbot_max, bathy(:,:) )
 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-           IF( bathy(ji,jj) > 0._wp )   bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) )
-         END DO
-      END DO
+      IF( .NOT.ln_wd ) THEN                      
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              IF( bathy(ji,jj) > 0._wp )   bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) )
+            END DO
+         END DO
+      END IF
       !                                        ! =============================
       !                                        ! Define the envelop bathymetry   (hbatt)
@@ -1862,19 +1955,29 @@
       zenv(:,:) = bathy(:,:)
       !
+      IF( .NOT.ln_wd ) THEN    
       ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-           IF( bathy(ji,jj) == 0._wp ) THEN
-             iip1 = MIN( ji+1, jpi )
-             ijp1 = MIN( jj+1, jpj )
-             iim1 = MAX( ji-1, 1 )
-             ijm1 = MAX( jj-1, 1 )
-             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
-         END DO
-      END DO
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( bathy(ji,jj) == 0._wp ) THEN
+                  iip1 = MIN( ji+1, jpi )
+                  ijp1 = MIN( jj+1, jpj )
+                  iim1 = MAX( ji-1, 1 )
+                  ijm1 = MAX( jj-1, 1 )
+!!gm BUG fix see ticket #1617
+                  IF( ( + bathy(iim1,ijm1) + bathy(ji,ijp1) + bathy(iip1,ijp1)              &
+                     &  + bathy(iim1,jj  )                  + bathy(iip1,jj  )              &
+                     &  + bathy(iim1,ijm1) + bathy(ji,ijm1) + bathy(iip1,ijp1)  ) > 0._wp ) &
+                     &    zenv(ji,jj) = rn_sbot_min
+!!gm
+!!gm               IF( ( bathy(iip1,jj  ) + bathy(iim1,jj  ) + bathy(ji,ijp1  ) + bathy(ji,ijm1) +         &
+!!gm                  &  bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0._wp ) THEN
+!!gm               zenv(ji,jj) = rn_sbot_min
+!!gm             ENDIF
+!!gm end
+              ENDIF
+            END DO
+         END DO
+      END IF
+
       ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
       CALL lbc_lnk( zenv, 'T', 1._wp, 'no0' )
@@ -1964,15 +2067,4 @@
       ENDIF
       !
-      IF(lwp) THEN                             ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) ' domzgr: hbatt field; ocean depth in meters'
-         WRITE(numout,*)
-         CALL prihre( hbatt(1,1), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 0._wp, numout )
-         IF( nprint == 1 )   THEN        
-            WRITE(numout,*) ' bathy  MAX ', MAXVAL( bathy(:,:) ), ' MIN ', MINVAL( bathy(:,:) )
-            WRITE(numout,*) ' hbatt  MAX ', MAXVAL( hbatt(:,:) ), ' MIN ', MINVAL( hbatt(:,:) )
-         ENDIF
-      ENDIF
-
       !                                        ! ==============================
       !                                        !   hbatu, hbatv, hbatf fields
@@ -1980,5 +2072,10 @@
       IF(lwp) THEN
          WRITE(numout,*)
-         WRITE(numout,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min
+         IF( .NOT.ln_wd ) THEN
+           WRITE(numout,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min
+         ELSE
+           WRITE(numout,*) ' zgr_sco: minimum positive depth of the envelop topography set to : ', rn_sbot_min
+           WRITE(numout,*) ' zgr_sco: minimum negative depth of the envelop topography set to : ', -rn_wdld
+         ENDIF
       ENDIF
       hbatu(:,:) = rn_sbot_min
@@ -1993,4 +2090,19 @@
         END DO
       END DO
+
+      IF( ln_wd ) THEN               !avoid the zero depth on T- (U-,V-,F-) points
+        DO jj = 1, jpj
+          DO ji = 1, jpi
+            IF(ABS(hbatt(ji,jj)) < rn_wdmin1) &
+              & hbatt(ji,jj) = SIGN(1._wp, hbatt(ji,jj)) * rn_wdmin1
+            IF(ABS(hbatu(ji,jj)) < rn_wdmin1) &
+              & hbatu(ji,jj) = SIGN(1._wp, hbatu(ji,jj)) * rn_wdmin1
+            IF(ABS(hbatv(ji,jj)) < rn_wdmin1) &
+              & hbatv(ji,jj) = SIGN(1._wp, hbatv(ji,jj)) * rn_wdmin1
+            IF(ABS(hbatf(ji,jj)) < rn_wdmin1) &
+              & hbatf(ji,jj) = SIGN(1._wp, hbatf(ji,jj)) * rn_wdmin1
+          END DO
+        END DO
+      END IF
       ! 
       ! Apply lateral boundary condition
@@ -2000,4 +2112,5 @@
          DO ji = 1, jpi
             IF( hbatu(ji,jj) == 0._wp ) THEN
+               !No worries about the following line when ln_wd == .true.
                IF( zhbat(ji,jj) == 0._wp )   hbatu(ji,jj) = rn_sbot_min
                IF( zhbat(ji,jj) /= 0._wp )   hbatu(ji,jj) = zhbat(ji,jj)
@@ -2025,8 +2138,10 @@
 
 !!bug:  key_helsinki a verifer
-      hift(:,:) = MIN( hift(:,:), hbatt(:,:) )
-      hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) )
-      hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) )
-      hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) )
+      IF( .NOT.ln_wd ) THEN
+        hift(:,:) = MIN( hift(:,:), hbatt(:,:) )
+        hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) )
+        hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) )
+        hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) )
+      END IF
 
       IF( nprint == 1 .AND. lwp )   THEN
@@ -2069,49 +2184,39 @@
       CALL lbc_lnk( e3uw_0, 'U', 1._wp )
       CALL lbc_lnk( e3vw_0, 'V', 1._wp )
-
-      fsdepw(:,:,:) = gdepw_0 (:,:,:)
-      fsde3w(:,:,:) = gdep3w_0(:,:,:)
-      !
-      where (e3t_0   (:,:,:).eq.0.0)  e3t_0(:,:,:) = 1.0
-      where (e3u_0   (:,:,:).eq.0.0)  e3u_0(:,:,:) = 1.0
-      where (e3v_0   (:,:,:).eq.0.0)  e3v_0(:,:,:) = 1.0
-      where (e3f_0   (:,:,:).eq.0.0)  e3f_0(:,:,:) = 1.0
-      where (e3w_0   (:,:,:).eq.0.0)  e3w_0(:,:,:) = 1.0
-      where (e3uw_0  (:,:,:).eq.0.0)  e3uw_0(:,:,:) = 1.0
-      where (e3vw_0  (:,:,:).eq.0.0)  e3vw_0(:,:,:) = 1.0
+      !
+      IF( .NOT.ln_wd ) THEN
+        WHERE( e3t_0 (:,:,:) == 0._wp )   e3t_0 (:,:,:) = 1._wp
+        WHERE( e3u_0 (:,:,:) == 0._wp )   e3u_0 (:,:,:) = 1._wp
+        WHERE( e3v_0 (:,:,:) == 0._wp )   e3v_0 (:,:,:) = 1._wp
+        WHERE( e3f_0 (:,:,:) == 0._wp )   e3f_0 (:,:,:) = 1._wp
+        WHERE( e3w_0 (:,:,:) == 0._wp )   e3w_0 (:,:,:) = 1._wp
+        WHERE( e3uw_0(:,:,:) == 0._wp )   e3uw_0(:,:,:) = 1._wp
+        WHERE( e3vw_0(:,:,:) == 0._wp )   e3vw_0(:,:,:) = 1._wp
+      END IF
 
 #if defined key_agrif
-      ! Ensure meaningful vertical scale factors in ghost lines/columns
-      IF( .NOT. Agrif_Root() ) THEN
-         !  
-         IF((nbondi == -1).OR.(nbondi == 2)) THEN
-            e3u_0(1,:,:) = e3u_0(2,:,:)
-         ENDIF
-         !
-         IF((nbondi ==  1).OR.(nbondi == 2)) THEN
-            e3u_0(nlci-1,:,:) = e3u_0(nlci-2,:,:)
-         ENDIF
-         !
-         IF((nbondj == -1).OR.(nbondj == 2)) THEN
-            e3v_0(:,1,:) = e3v_0(:,2,:)
-         ENDIF
-         !
-         IF((nbondj ==  1).OR.(nbondj == 2)) THEN
-            e3v_0(:,nlcj-1,:) = e3v_0(:,nlcj-2,:)
-         ENDIF
-         !
-      ENDIF
+      IF( .NOT. Agrif_Root() ) THEN    ! Ensure meaningful vertical scale factors in ghost lines/columns
+         IF( nbondi == -1 .OR. nbondi == 2 )   e3u_0(  1   ,  :   ,:) = e3u_0(  2   ,  :   ,:)
+         IF( nbondi ==  1 .OR. nbondi == 2 )   e3u_0(nlci-1,  :   ,:) = e3u_0(nlci-2,  :   ,:)
+         IF( nbondj == -1 .OR. nbondj == 2 )   e3v_0(  :   ,  1   ,:) = e3v_0(  :   ,  2   ,:)
+         IF( nbondj ==  1 .OR. nbondj == 2 )   e3v_0(  :   ,nlcj-1,:) = e3v_0(  :   ,nlcj-2,:)
+       ENDIF
 #endif
 
-      fsdept(:,:,:) = gdept_0 (:,:,:)
-      fsdepw(:,:,:) = gdepw_0 (:,:,:)
-      fsde3w(:,:,:) = gdep3w_0(:,:,:)
-      fse3t (:,:,:) = e3t_0   (:,:,:)
-      fse3u (:,:,:) = e3u_0   (:,:,:)
-      fse3v (:,:,:) = e3v_0   (:,:,:)
-      fse3f (:,:,:) = e3f_0   (:,:,:)
-      fse3w (:,:,:) = e3w_0   (:,:,:)
-      fse3uw(:,:,:) = e3uw_0  (:,:,:)
-      fse3vw(:,:,:) = e3vw_0  (:,:,:)
+!!gm   I don't like that HERE we are supposed to set the reference coordinate (i.e. _0 arrays)
+!!gm   and only that !!!!!
+!!gm   THIS should be removed from here !
+      gdept_n(:,:,:) = gdept_0(:,:,:)
+      gdepw_n(:,:,:) = gdepw_0(:,:,:)
+      gde3w_n(:,:,:) = gde3w_0(:,:,:)
+      e3t_n  (:,:,:) = e3t_0  (:,:,:)
+      e3u_n  (:,:,:) = e3u_0  (:,:,:)
+      e3v_n  (:,:,:) = e3v_0  (:,:,:)
+      e3f_n  (:,:,:) = e3f_0  (:,:,:)
+      e3w_n  (:,:,:) = e3w_0  (:,:,:)
+      e3uw_n (:,:,:) = e3uw_0 (:,:,:)
+      e3vw_n (:,:,:) = e3vw_0 (:,:,:)
+!!gm and obviously in the following, use the _0 arrays until the end of this subroutine
+!! gm end
 !!
       ! HYBRID : 
@@ -2119,7 +2224,15 @@
          DO ji = 1, jpi
             DO jk = 1, jpkm1
-               IF( scobot(ji,jj) >= fsdept(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk )
-            END DO
-            IF( scobot(ji,jj) == 0._wp               )   mbathy(ji,jj) = 0
+               IF( scobot(ji,jj) >= gdept_n(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk )
+            END DO
+            IF( ln_wd ) THEN
+              IF( scobot(ji,jj) <= -(rn_wdld - rn_wdmin2)) THEN
+                mbathy(ji,jj) = 0
+              ELSEIF(scobot(ji,jj) <= rn_wdmin1) THEN
+                mbathy(ji,jj) = 2
+              ENDIF
+            ELSE
+              IF( scobot(ji,jj) == 0._wp )   mbathy(ji,jj) = 0
+            ENDIF
          END DO
       END DO
@@ -2130,15 +2243,15 @@
          WRITE(numout,*) ' MIN val mbathy  ', MINVAL( mbathy(:,:)    ), ' MAX ', MAXVAL( mbathy(:,:) )
          WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   &
-            &                          ' w ', MINVAL( gdepw_0(:,:,:) ), '3w '  , MINVAL( gdep3w_0(:,:,:) )
-         WRITE(numout,*) ' MIN val e3    t ', MINVAL( e3t_0  (:,:,:) ), ' f '  , MINVAL( e3f_0   (:,:,:) ),   &
-            &                          ' u ', MINVAL( e3u_0  (:,:,:) ), ' u '  , MINVAL( e3v_0   (:,:,:) ),   &
-            &                          ' uw', MINVAL( e3uw_0 (:,:,:) ), ' vw'  , MINVAL( e3vw_0  (:,:,:) ),   &
+            &                          ' w ', MINVAL( gdepw_0(:,:,:) ), '3w '  , MINVAL( gde3w_0(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL( e3t_0  (:,:,:) ), ' f '  , MINVAL( e3f_0  (:,:,:) ),   &
+            &                          ' u ', MINVAL( e3u_0  (:,:,:) ), ' u '  , MINVAL( e3v_0  (:,:,:) ),   &
+            &                          ' uw', MINVAL( e3uw_0 (:,:,:) ), ' vw'  , MINVAL( e3vw_0 (:,:,:) ),   &
             &                          ' w ', MINVAL( e3w_0  (:,:,:) )
 
          WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   &
-            &                          ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w '  , MAXVAL( gdep3w_0(:,:,:) )
-         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( e3t_0  (:,:,:) ), ' f '  , MAXVAL( e3f_0   (:,:,:) ),   &
-            &                          ' u ', MAXVAL( e3u_0  (:,:,:) ), ' u '  , MAXVAL( e3v_0   (:,:,:) ),   &
-            &                          ' uw', MAXVAL( e3uw_0 (:,:,:) ), ' vw'  , MAXVAL( e3vw_0  (:,:,:) ),   &
+            &                          ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w '  , MAXVAL( gde3w_0(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( e3t_0  (:,:,:) ), ' f '  , MAXVAL( e3f_0  (:,:,:) ),   &
+            &                          ' u ', MAXVAL( e3u_0  (:,:,:) ), ' u '  , MAXVAL( e3v_0  (:,:,:) ),   &
+            &                          ' uw', MAXVAL( e3uw_0 (:,:,:) ), ' vw'  , MAXVAL( e3vw_0 (:,:,:) ),   &
             &                          ' w ', MAXVAL( e3w_0  (:,:,:) )
       ENDIF
@@ -2172,50 +2285,48 @@
          END DO
       ENDIF
-
-!================================================================================
-! check the coordinate makes sense
-!================================================================================
+      !
+      !================================================================================
+      ! check the coordinate makes sense
+      !================================================================================
       DO ji = 1, jpi
          DO jj = 1, jpj
-
+            !
             IF( hbatt(ji,jj) > 0._wp) THEN
                DO jk = 1, mbathy(ji,jj)
                  ! check coordinate is monotonically increasing
-                 IF (fse3w(ji,jj,jk) <= 0._wp .OR. fse3t(ji,jj,jk) <= 0._wp ) THEN
+                 IF (e3w_n(ji,jj,jk) <= 0._wp .OR. e3t_n(ji,jj,jk) <= 0._wp ) THEN
                     WRITE(ctmp1,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
                     WRITE(numout,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
-                    WRITE(numout,*) 'e3w',fse3w(ji,jj,:)
-                    WRITE(numout,*) 'e3t',fse3t(ji,jj,:)
+                    WRITE(numout,*) 'e3w',e3w_n(ji,jj,:)
+                    WRITE(numout,*) 'e3t',e3t_n(ji,jj,:)
                     CALL ctl_stop( ctmp1 )
                  ENDIF
                  ! and check it has never gone negative
-                 IF( fsdepw(ji,jj,jk) < 0._wp .OR. fsdept(ji,jj,jk) < 0._wp ) THEN
+                 IF( gdepw_n(ji,jj,jk) < 0._wp .OR. gdept_n(ji,jj,jk) < 0._wp ) THEN
                     WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw or gdept =< 0  at point (i,j,k)= ', ji, jj, jk
                     WRITE(numout,*) 'ERROR zgr_sco :   gdepw   or gdept   =< 0  at point (i,j,k)= ', ji, jj, jk
-                    WRITE(numout,*) 'gdepw',fsdepw(ji,jj,:)
-                    WRITE(numout,*) 'gdept',fsdept(ji,jj,:)
+                    WRITE(numout,*) 'gdepw',gdepw_n(ji,jj,:)
+                    WRITE(numout,*) 'gdept',gdept_n(ji,jj,:)
                     CALL ctl_stop( ctmp1 )
                  ENDIF
                  ! and check it never exceeds the total depth
-                 IF( fsdepw(ji,jj,jk) > hbatt(ji,jj) ) THEN
+                 IF( gdepw_n(ji,jj,jk) > hbatt(ji,jj) ) THEN
                     WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk
                     WRITE(numout,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk
-                    WRITE(numout,*) 'gdepw',fsdepw(ji,jj,:)
+                    WRITE(numout,*) 'gdepw',gdepw_n(ji,jj,:)
                     CALL ctl_stop( ctmp1 )
                  ENDIF
                END DO
-
+               !
                DO jk = 1, mbathy(ji,jj)-1
                  ! and check it never exceeds the total depth
-                IF( fsdept(ji,jj,jk) > hbatt(ji,jj) ) THEN
+                IF( gdept_n(ji,jj,jk) > hbatt(ji,jj) ) THEN
                     WRITE(ctmp1,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk
                     WRITE(numout,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk
-                    WRITE(numout,*) 'gdept',fsdept(ji,jj,:)
+                    WRITE(numout,*) 'gdept',gdept_n(ji,jj,:)
                     CALL ctl_stop( ctmp1 )
                  ENDIF
                END DO
-
             ENDIF
-
          END DO
       END DO
@@ -2227,7 +2338,6 @@
    END SUBROUTINE zgr_sco
 
-!!======================================================================
+
    SUBROUTINE s_sh94()
-
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE s_sh94  ***
@@ -2240,13 +2350,15 @@
       !! Reference : Song and Haidvogel 1994. 
       !!----------------------------------------------------------------------
-      !
       INTEGER  ::   ji, jj, jk           ! dummy loop argument
       REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+      REAL(wp) ::   ztmpu,  ztmpv,  ztmpf
+      REAL(wp) ::   ztmpu1, ztmpv1, ztmpf1
       !
       REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3
       REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
-
-      CALL wrk_alloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3                                      )
-      CALL wrk_alloc( jpi, jpj, jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj,jpk,   z_gsigw3, z_gsigt3, z_gsi3w3                                      )
+      CALL wrk_alloc( jpi,jpj,jpk,   z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
 
       z_gsigw3  = 0._wp   ;   z_gsigt3  = 0._wp   ;   z_gsi3w3  = 0._wp
@@ -2254,8 +2366,8 @@
       z_esigtu3 = 0._wp   ;   z_esigtv3 = 0._wp   ;   z_esigtf3 = 0._wp
       z_esigwu3 = 0._wp   ;   z_esigwv3 = 0._wp
-
+      !
       DO ji = 1, jpi
          DO jj = 1, jpj
-
+            !
             IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma
                DO jk = 1, jpk
@@ -2286,7 +2398,7 @@
                zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
                zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
-               gdept_0 (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj,jk)+rn_hc*zcoeft )
-               gdepw_0 (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj,jk)+rn_hc*zcoefw )
-               gdep3w_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj,jk)+rn_hc*zcoeft )
+               gdept_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj,jk)+rn_hc*zcoeft )
+               gdepw_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj,jk)+rn_hc*zcoefw )
+               gde3w_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj,jk)+rn_hc*zcoeft )
             END DO
            !
@@ -2296,16 +2408,43 @@
       DO ji = 1, jpim1
          DO jj = 1, jpjm1
+            ! extended for Wetting/Drying case
+            ztmpu  = hbatt(ji,jj)+hbatt(ji+1,jj)
+            ztmpv  = hbatt(ji,jj)+hbatt(ji,jj+1)
+            ztmpf  = hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1)
+            ztmpu1 = hbatt(ji,jj)*hbatt(ji+1,jj)
+            ztmpv1 = hbatt(ji,jj)*hbatt(ji,jj+1)
+            ztmpf1 = MIN(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) * &
+                   & MAX(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1))
             DO jk = 1, jpk
-               z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) )   &
-                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
-               z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) )   &
-                  &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
-               z_esigtf3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk)     &
-                  &                + hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk)+hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) )   &
-                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
-               z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) )   &
-                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
-               z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) )   &
-                  &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+               IF( ln_wd .AND. (ztmpu1 < 0._wp.OR.ABS(ztmpu) < rn_wdmin1) ) THEN
+                 z_esigtu3(ji,jj,jk) = 0.5_wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) )
+                 z_esigwu3(ji,jj,jk) = 0.5_wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) )
+               ELSE
+                 z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) &
+                        &              / ztmpu
+                 z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) &
+                        &              / ztmpu
+               END IF
+
+               IF( ln_wd .AND. (ztmpv1 < 0._wp.OR.ABS(ztmpv) < rn_wdmin1) ) THEN
+                 z_esigtv3(ji,jj,jk) = 0.5_wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) )
+                 z_esigwv3(ji,jj,jk) = 0.5_wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) )
+               ELSE
+                 z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) &
+                        &              / ztmpv
+                 z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) &
+                        &              / ztmpv
+               END IF
+
+               IF( ln_wd .AND. (ztmpf1 < 0._wp.OR.ABS(ztmpf) < rn_wdmin1) ) THEN
+                 z_esigtf3(ji,jj,jk) = 0.25_wp * ( z_esigt3(ji,jj  ,jk) + z_esigt3(ji+1,jj  ,jk)               &
+                        &                        + z_esigt3(ji,jj+1,jk) + z_esigt3(ji+1,jj+1,jk) )
+               ELSE
+                 z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                               &
+                        &            +   hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                               &
+                        &            +   hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                               &
+                        &            +   hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf
+               END IF
+
                !
                e3t_0(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigt3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
@@ -2320,12 +2459,12 @@
         END DO
       END DO
-
-      CALL wrk_dealloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3                                      )
-      CALL wrk_dealloc( jpi, jpj, jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
-
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   z_gsigw3, z_gsigt3, z_gsi3w3                                      )
+      CALL wrk_dealloc( jpi,jpj,jpk,   z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+      !
    END SUBROUTINE s_sh94
 
+
    SUBROUTINE s_sf12
-
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE s_sf12 *** 
@@ -2343,12 +2482,13 @@
       !! Reference : Siddorn and Furner 2012 (submitted Ocean modelling).
       !!----------------------------------------------------------------------
-      !
       INTEGER  ::   ji, jj, jk           ! dummy loop argument
       REAL(wp) ::   zsmth               ! smoothing around critical depth
       REAL(wp) ::   zzs, zzb           ! Surface and bottom cell thickness in sigma space
+      REAL(wp) ::   ztmpu, ztmpv, ztmpf
+      REAL(wp) ::   ztmpu1, ztmpv1, ztmpf1
       !
       REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3
       REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
-
+      !!----------------------------------------------------------------------
       !
       CALL wrk_alloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3                                      )
@@ -2414,7 +2554,7 @@
 
           DO jk = 1, jpk
-             gdept_0 (ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj,jk)
-             gdepw_0 (ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj,jk)
-             gdep3w_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj,jk)
+             gdept_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj,jk)
+             gdepw_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj,jk)
+             gde3w_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj,jk)
           END DO
 
@@ -2425,16 +2565,61 @@
         DO jj=1,jpj-1
 
-          DO jk = 1, jpk
-                z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) / &
-                                    ( hbatt(ji,jj)+hbatt(ji+1,jj) )
-                z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) / &
-                                    ( hbatt(ji,jj)+hbatt(ji,jj+1) )
-                z_esigtf3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) +  &
-                                      hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk)+hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / &
-                                    ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
-                z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) / &
-                                    ( hbatt(ji,jj)+hbatt(ji+1,jj) )
-                z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) / &
-                                    ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+           ! extend to suit for Wetting/Drying case
+           ztmpu  = hbatt(ji,jj)+hbatt(ji+1,jj)
+           ztmpv  = hbatt(ji,jj)+hbatt(ji,jj+1)
+           ztmpf  = hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1)
+           ztmpu1 = hbatt(ji,jj)*hbatt(ji+1,jj)
+           ztmpv1 = hbatt(ji,jj)*hbatt(ji,jj+1)
+           ztmpf1 = MIN(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) * &
+                  & MAX(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1))
+           DO jk = 1, jpk
+              IF( ln_wd .AND. (ztmpu1 < 0._wp.OR.ABS(ztmpu) < rn_wdmin1) ) THEN
+                z_esigtu3(ji,jj,jk) = 0.5_wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) )
+                z_esigwu3(ji,jj,jk) = 0.5_wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) )
+              ELSE
+                z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) &
+                       &              / ztmpu
+                z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) &
+                       &              / ztmpu
+              END IF
+
+              IF( ln_wd .AND. (ztmpv1 < 0._wp.OR.ABS(ztmpv) < rn_wdmin1) ) THEN
+                z_esigtv3(ji,jj,jk) = 0.5_wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) )
+                z_esigwv3(ji,jj,jk) = 0.5_wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) )
+              ELSE
+                z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) &
+                       &              / ztmpv
+                z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) &
+                       &              / ztmpv
+              END IF
+
+              IF( ln_wd .AND. (ztmpf1 < 0._wp.OR.ABS(ztmpf) < rn_wdmin1) ) THEN
+                z_esigtf3(ji,jj,jk) = 0.25_wp * ( z_esigt3(ji,jj,jk)   + z_esigt3(ji+1,jj,jk)                 &
+                       &                        + z_esigt3(ji,jj+1,jk) + z_esigt3(ji+1,jj+1,jk) )
+              ELSE
+                z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                               &
+                       &              + hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                               &
+                       &              + hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                               &
+                       &              + hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf
+              END IF
+
+             ! Code prior to wetting and drying option (for reference)
+             !z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji+1,jj) )
+             !
+             !z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji+1,jj) )
+             !
+             !z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji,jj+1) )
+             !
+             !z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji,jj+1) )
+             !
+             !z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                                 &
+             !                    &  +hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                                 &
+             !                       +hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                                 &
+             !                    &  +hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) )                               &
+             !                     /( hbatt(ji  ,jj  )+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
 
              e3t_0(ji,jj,jk)=(scosrf(ji,jj)+hbatt(ji,jj))*z_esigt3(ji,jj,jk)
@@ -2443,5 +2628,5 @@
              e3f_0(ji,jj,jk)=(scosrf(ji,jj)+hbatf(ji,jj))*z_esigtf3(ji,jj,jk)
              !
-             e3w_0(ji,jj,jk)=hbatt(ji,jj)*z_esigw3(ji,jj,jk)
+             e3w_0 (ji,jj,jk)=hbatt(ji,jj)*z_esigw3(ji,jj,jk)
              e3uw_0(ji,jj,jk)=hbatu(ji,jj)*z_esigwu3(ji,jj,jk)
              e3vw_0(ji,jj,jk)=hbatv(ji,jj)*z_esigwv3(ji,jj,jk)
@@ -2456,13 +2641,11 @@
       CALL lbc_lnk(e3uw_0,'T',1.) ; CALL lbc_lnk(e3vw_0,'T',1.)
       !
-      !                                               ! =============
-
-      CALL wrk_dealloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3                                      )
-      CALL wrk_dealloc( jpi, jpj, jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
-
+      CALL wrk_dealloc( jpi,jpj,jpk,   z_gsigw3, z_gsigt3, z_gsi3w3                                      )
+      CALL wrk_dealloc( jpi,jpj,jpk,   z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+      !
    END SUBROUTINE s_sf12
 
+
    SUBROUTINE s_tanh()
-
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE s_tanh*** 
@@ -2474,13 +2657,12 @@
       !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.
       !!----------------------------------------------------------------------
-
-      INTEGER  ::   ji, jj, jk           ! dummy loop argument
+      INTEGER  ::   ji, jj, jk       ! dummy loop argument
       REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
-
       REAL(wp), POINTER, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w
       REAL(wp), POINTER, DIMENSION(:) :: z_esigt, z_esigw
-
-      CALL wrk_alloc( jpk, z_gsigw, z_gsigt, z_gsi3w                                      )
-      CALL wrk_alloc( jpk, z_esigt, z_esigw                                               )
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpk,   z_gsigw, z_gsigt, z_gsi3w )
+      CALL wrk_alloc( jpk,   z_esigt, z_esigw )
 
       z_gsigw  = 0._wp   ;   z_gsigt  = 0._wp   ;   z_gsi3w  = 0._wp
@@ -2512,7 +2694,7 @@
          zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
          zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
-         gdept_0 (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigt(jk) + hift(:,:)*zcoeft )
-         gdepw_0 (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigw(jk) + hift(:,:)*zcoefw )
-         gdep3w_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsi3w(jk) + hift(:,:)*zcoeft )
+         gdept_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigt(jk) + hift(:,:)*zcoeft )
+         gdepw_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigw(jk) + hift(:,:)*zcoefw )
+         gde3w_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsi3w(jk) + hift(:,:)*zcoeft )
       END DO
 !!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays)
@@ -2531,9 +2713,10 @@
          END DO
       END DO
-
-      CALL wrk_dealloc( jpk, z_gsigw, z_gsigt, z_gsi3w                                      )
-      CALL wrk_dealloc( jpk, z_esigt, z_esigw                                               )
-
+      !
+      CALL wrk_dealloc( jpk,   z_gsigw, z_gsigt, z_gsi3w )
+      CALL wrk_dealloc( jpk,   z_esigt, z_esigw          )
+      !
    END SUBROUTINE s_tanh
+
 
    FUNCTION fssig( pk ) RESULT( pf )
@@ -2607,33 +2790,32 @@
       REAL(wp), INTENT(in   ) ::   pk1(jpk)       ! continuous "k" coordinate
       REAL(wp)                ::   p_gamma(jpk)   ! stretched coordinate
-      REAL(wp), INTENT(in   ) ::   pzb           ! Bottom box depth
-      REAL(wp), INTENT(in   ) ::   pzs           ! surface box depth
-      REAL(wp), INTENT(in   ) ::   psmth       ! Smoothing parameter
-      REAL(wp)                ::   za1,za2,za3    ! local variables
-      REAL(wp)                ::   zn1,zn2        ! local variables
-      REAL(wp)                ::   za,zb,zx       ! local variables
-      integer                 ::   jk
-      !!----------------------------------------------------------------------
-      !
-
-      zn1  =  1./(jpk-1.)
-      zn2  =  1. -  zn1
-
+      REAL(wp), INTENT(in   ) ::   pzb            ! Bottom box depth
+      REAL(wp), INTENT(in   ) ::   pzs            ! surface box depth
+      REAL(wp), INTENT(in   ) ::   psmth          ! Smoothing parameter
+      !
+      INTEGER  ::   jk             ! dummy loop index
+      REAL(wp) ::   za1,za2,za3    ! local scalar
+      REAL(wp) ::   zn1,zn2        !   -      - 
+      REAL(wp) ::   za,zb,zx       !   -      - 
+      !!----------------------------------------------------------------------
+      !
+      zn1  =  1._wp / REAL( jpkm1, wp )
+      zn2  =  1._wp -  zn1
+      !
       za1 = (rn_alpha+2.0_wp)*zn1**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn1**(rn_alpha+2.0_wp) 
       za2 = (rn_alpha+2.0_wp)*zn2**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn2**(rn_alpha+2.0_wp)
       za3 = (zn2**3.0_wp - za2)/( zn1**3.0_wp - za1)
-     
+      !
       za = pzb - za3*(pzs-za1)-za2
       za = za/( zn2-0.5_wp*(za2+zn2**2.0_wp) - za3*(zn1-0.5_wp*(za1+zn1**2.0_wp) ) )
       zb = (pzs - za1 - za*( zn1-0.5_wp*(za1+zn1**2.0_wp ) ) ) / (zn1**3.0_wp - za1)
       zx = 1.0_wp-za/2.0_wp-zb
- 
+      !
       DO jk = 1, jpk
-        p_gamma(jk) = za*(pk1(jk)*(1.0_wp-pk1(jk)/2.0_wp))+zb*pk1(jk)**3.0_wp +  &
-                    & zx*( (rn_alpha+2.0_wp)*pk1(jk)**(rn_alpha+1.0_wp)- &
-                    &      (rn_alpha+1.0_wp)*pk1(jk)**(rn_alpha+2.0_wp) )
+         p_gamma(jk) = za*(pk1(jk)*(1.0_wp-pk1(jk)/2.0_wp))+zb*pk1(jk)**3.0_wp +  &
+            &          zx*( (rn_alpha+2.0_wp)*pk1(jk)**(rn_alpha+1.0_wp)- &
+            &               (rn_alpha+1.0_wp)*pk1(jk)**(rn_alpha+2.0_wp) )
         p_gamma(jk) = p_gamma(jk)*psmth+pk1(jk)*(1.0_wp-psmth)
-      ENDDO 
-
+      END DO
       !
    END FUNCTION fgamma
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90	(revision 6807)
+++ 	(revision )
@@ -1,122 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                    ***  domzgr_substitute.h90   ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute fsdep. and fse.., the vert. depth and scale
-   !!      factors depending on the vertical coord. used, using CPP macro.
-   !!----------------------------------------------------------------------
-   !! History :  1.0  !  2005-10  (A. Beckmann, G. Madec) generalisation to all coord.
-   !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z* coordinate
-   !!----------------------------------------------------------------------
-
-#if defined key_vvl
-! s* or z*-coordinate (3D + time dependency) + use of additional now arrays (..._n)
-
-#   define  fse3t_b(i,j,k)   e3t_b(i,j,k)
-#   define  fse3u_b(i,j,k)   e3u_b(i,j,k)
-#   define  fse3v_b(i,j,k)   e3v_b(i,j,k)
-#   define  fse3uw_b(i,j,k)  e3uw_b(i,j,k)
-#   define  fse3vw_b(i,j,k)  e3vw_b(i,j,k)
-
-#   define  fsdept_n(i,j,k)  gdept_n(i,j,k)
-#   define  fsdepw_n(i,j,k)  gdepw_n(i,j,k)
-#   define  fsde3w_n(i,j,k)  gdep3w_n(i,j,k)
-#   define  fse3t_n(i,j,k)   e3t_n(i,j,k)
-#   define  fse3u_n(i,j,k)   e3u_n(i,j,k)
-#   define  fse3v_n(i,j,k)   e3v_n(i,j,k)
-#   define  fse3f_n(i,j,k)   e3f_n(i,j,k)
-#   define  fse3w_n(i,j,k)   e3w_n(i,j,k)
-#   define  fse3uw_n(i,j,k)  e3uw_n(i,j,k)
-#   define  fse3vw_n(i,j,k)  e3vw_n(i,j,k)
-
-#   define  fsdept_b(i,j,k)  gdept_b(i,j,k)
-#   define  fsdepw_b(i,j,k)  gdepw_b(i,j,k)
-#   define  fse3w_b(i,j,k)   e3w_b(i,j,k)
-
-#   define  fse3t_a(i,j,k)   e3t_a(i,j,k)
-#   define  fse3u_a(i,j,k)   e3u_a(i,j,k)
-#   define  fse3v_a(i,j,k)   e3v_a(i,j,k)
-
-#   define  fse3t_m(i,j)     e3t_m(i,j)
-
-#   define  hu_a(i,j)        ehu_a(i,j)
-#   define  hur_a(i,j)       ehur_a(i,j)
-#   define  hv_a(i,j)        ehv_a(i,j)
-#   define  hvr_a(i,j)       ehvr_a(i,j)
-#   define  hu_b(i,j)        ehu_b(i,j)
-#   define  hur_b(i,j)       ehur_b(i,j)
-#   define  hv_b(i,j)        ehv_b(i,j)
-#   define  hvr_b(i,j)       ehvr_b(i,j)
-
-! This part should be removed one day ...
-! ... In that case all occurence of the above statement functions
-!     have to be replaced in the code by xxx_n
-#   define  fsdept(i,j,k)    gdept_n(i,j,k)
-#   define  fsdepw(i,j,k)    gdepw_n(i,j,k)
-#   define  fsde3w(i,j,k)    gdep3w_n(i,j,k)
-#   define  fse3t(i,j,k)     e3t_n(i,j,k) 
-#   define  fse3u(i,j,k)     e3u_n(i,j,k) 
-#   define  fse3v(i,j,k)     e3v_n(i,j,k) 
-#   define  fse3f(i,j,k)     e3f_n(i,j,k) 
-#   define  fse3w(i,j,k)     e3w_n(i,j,k) 
-#   define  fse3uw(i,j,k)    e3uw_n(i,j,k)
-#   define  fse3vw(i,j,k)    e3vw_n(i,j,k)
-
-#else
-! z- or s-coordinate (1D or 3D + no time dependency) use reference in all cases
-
-#   define  fse3t_b(i,j,k)   e3t_0(i,j,k)
-#   define  fse3u_b(i,j,k)   e3u_0(i,j,k)
-#   define  fse3v_b(i,j,k)   e3v_0(i,j,k)
-#   define  fse3uw_b(i,j,k)  e3uw_0(i,j,k)
-#   define  fse3vw_b(i,j,k)  e3vw_0(i,j,k)
-
-#   define  fsdept_n(i,j,k)  gdept_0(i,j,k)
-#   define  fsdepw_n(i,j,k)  gdepw_0(i,j,k)
-#   define  fsde3w_n(i,j,k)  gdep3w_0(i,j,k)
-#   define  fse3t_n(i,j,k)   e3t_0(i,j,k)
-#   define  fse3u_n(i,j,k)   e3u_0(i,j,k)
-#   define  fse3v_n(i,j,k)   e3v_0(i,j,k)
-#   define  fse3f_n(i,j,k)   e3f_0(i,j,k)
-#   define  fse3w_n(i,j,k)   e3w_0(i,j,k)
-#   define  fse3uw_n(i,j,k)  e3uw_0(i,j,k)
-#   define  fse3vw_n(i,j,k)  e3vw_0(i,j,k)
-
-#   define  fsdept_b(i,j,k)  gdept_0(i,j,k)
-#   define  fsdepw_b(i,j,k)  gdepw_0(i,j,k)
-#   define  fse3w_b(i,j,k)   e3w_0(i,j,k)
-
-#   define  fse3t_a(i,j,k)   e3t_0(i,j,k)
-#   define  fse3u_a(i,j,k)   e3u_0(i,j,k)
-#   define  fse3v_a(i,j,k)   e3v_0(i,j,k)
-
-#   define  fse3t_m(i,j)     e3t_0(i,j,1)
-
-#   define  hu_a(i,j)        hu(i,j)
-#   define  hur_a(i,j)       hur(i,j)
-#   define  hv_a(i,j)        hv(i,j)
-#   define  hvr_a(i,j)       hvr(i,j)
-#   define  hu_b(i,j)        hu(i,j)
-#   define  hur_b(i,j)       hur(i,j)
-#   define  hv_b(i,j)        hv(i,j)
-#   define  hvr_b(i,j)       hvr(i,j)
-
-! This part should be removed one day ...
-! ... In that case all occurence of the above statement functions
-!     have to be replaced in the code by xxx_n
-#   define  fsdept(i,j,k)    gdept_0(i,j,k)
-#   define  fsdepw(i,j,k)    gdepw_0(i,j,k)
-#   define  fsde3w(i,j,k)    gdep3w_0(i,j,k)
-#   define  fse3t(i,j,k)     e3t_0(i,j,k)
-#   define  fse3u(i,j,k)     e3u_0(i,j,k)
-#   define  fse3v(i,j,k)     e3v_0(i,j,k)
-#   define  fse3f(i,j,k)     e3f_0(i,j,k)
-#   define  fse3w(i,j,k)     e3w_0(i,j,k)
-#   define  fse3uw(i,j,k)    e3uw_0(i,j,k)
-#   define  fse3vw(i,j,k)    e3vw_0(i,j,k)
-
-#endif
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 6808)
@@ -35,6 +35,4 @@
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read)
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -174,34 +172,9 @@
             END DO
          END DO
-         IF( nn_cla == 1 ) THEN                          ! Cross Land advection
-            il0 = 138   ;   il1 = 138                          ! set T & S profile at Gibraltar Strait
-            ij0 = 101   ;   ij1 = 102
-            ii0 = 139   ;   ii1 = 139
-            DO jl = mi0(il0), mi1(il1)
-               DO jj = mj0(ij0), mj1(ij1)
-                  DO ji = mi0(ii0), mi1(ii1)
-                     sf_tsd(jp_tem)%fnow(ji,jj,:) = sf_tsd(jp_tem)%fnow(jl,jj,:)
-                     sf_tsd(jp_sal)%fnow(ji,jj,:) = sf_tsd(jp_sal)%fnow(jl,jj,:)
-                  END DO
-               END DO
-            END DO
-            il0 = 164   ;   il1 = 164                          ! set T & S profile at Bab el Mandeb Strait
-            ij0 =  87   ;   ij1 =  88
-            ii0 = 161   ;   ii1 = 163
-            DO jl = mi0(il0), mi1(il1)
-               DO jj = mj0(ij0), mj1(ij1)
-                  DO ji = mi0(ii0), mi1(ii1)
-                     sf_tsd(jp_tem)%fnow(ji,jj,:) = sf_tsd(jp_tem)%fnow(jl,jj,:)
-                     sf_tsd(jp_sal)%fnow(ji,jj,:) = sf_tsd(jp_sal)%fnow(jl,jj,:)
-                  END DO
-               END DO
-            END DO
-         ELSE                                            ! No Cross Land advection
-            ij0 =  87   ;   ij1 =  96                          ! Reduced temperature in Red Sea
-            ii0 = 148   ;   ii1 = 160
-            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp
-            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
-            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp
-         ENDIF
+         ij0 =  87   ;   ij1 =  96                          ! Reduced temperature in Red Sea
+         ii0 = 148   ;   ii1 = 160
+         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp
+         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
+         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp
       ENDIF
       !
@@ -275,25 +248,4 @@
       ENDIF
       !
-      IF( lwp .AND. kt == nit000 ) THEN
-         WRITE(numout,*) ' temperature Levitus '
-         WRITE(numout,*)
-         WRITE(numout,*)'  level = 1'
-         CALL prihre( ptsd(:,:,1    ,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         WRITE(numout,*)'  level = ', jpk/2
-         CALL prihre( ptsd(:,:,jpk/2,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         WRITE(numout,*)'  level = ', jpkm1
-         CALL prihre( ptsd(:,:,jpkm1,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         WRITE(numout,*)
-         WRITE(numout,*) ' salinity Levitus '
-         WRITE(numout,*)
-         WRITE(numout,*)'  level = 1'
-         CALL prihre( ptsd(:,:,1    ,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         WRITE(numout,*)'  level = ', jpk/2
-         CALL prihre( ptsd(:,:,jpk/2,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         WRITE(numout,*)'  level = ', jpkm1
-         CALL prihre( ptsd(:,:,jpkm1,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         WRITE(numout,*)
-      ENDIF
-      !
       IF( .NOT.ln_tsd_tradmp ) THEN                   !==   deallocate T & S structure   ==! 
          !                                              (data used only for initialisation)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90	(revision 6808)
@@ -0,0 +1,321 @@
+MODULE iscplhsb
+   !!======================================================================
+   !!                       ***  MODULE  iscplhsb***
+   !! Ocean forcing: ice sheet/ocean coupling (conservation)
+   !!=====================================================================
+   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   iscpl_alloc    : variable allocation
+   !!   iscpl_hsb      : compute and store the input of heat/salt/volume 
+   !!                    into the system due to the coupling process
+   !!   iscpl_div      : correction of divergence to keep volume conservation
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE domwri          ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE sbc_oce         ! surface boundary condition variables
+   USE oce             ! global tra/dyn variable
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE lbclnk          !
+   USE domngb          !
+   USE iscplini
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   iscpl_div   
+   PUBLIC   iscpl_cons       
+   !! * Substitutions  
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: sbcrnf.F90 4666 2014-06-11 12:52:23Z mathiot $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE iscpl_cons(ptmask_b, psmask_b, pe3t_b, pts_flx, pvol_flx, prdt_iscpl)
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE iscpl_cons  ***
+      !! 
+      !! ** Purpose :   compute input into the system during the coupling step
+      !!                compute the correction term
+      !!                compute where the correction have to be applied
+      !! 
+      !! ** Method  :   compute tsn*e3t-tsb*e3tb and e3t-e3t_b
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: ptmask_b    !! mask before
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pe3t_b      !! scale factor before
+      REAL(wp), DIMENSION(:,:    ), INTENT(in ) :: psmask_b    !! mask before
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(out) :: pts_flx     !! corrective flux to have tracer conservation
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(out) :: pvol_flx    !! corrective flux to have volume conservation
+      REAL(wp),                     INTENT(in ) :: prdt_iscpl  !! coupling period 
+      !!
+      INTEGER :: ji, jj, jk                                    !! loop index
+      INTEGER :: jip1, jim1, jjp1, jjm1
+      !!
+      REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb
+      REAL(wp):: r1_rdtiscpl
+      REAL(wp):: zjip1_ratio  , zjim1_ratio  , zjjp1_ratio  , zjjm1_ratio
+      !!
+      REAL(wp):: zde3t, zdtem, zdsal
+      REAL(wp), DIMENSION(:,:), POINTER :: zdssh
+      !!
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal
+      INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, inpts
+      INTEGER :: jpts, npts
+
+      CALL wrk_alloc(jpi,jpj, zdssh )
+
+      ! get imbalance (volume heat and salt)
+      ! initialisation difference
+      zde3t = 0.0_wp; zdsal = 0.0_wp ; zdtem = 0.0_wp
+
+      ! initialisation correction term
+      pvol_flx(:,:,:  ) = 0.0_wp
+      pts_flx (:,:,:,:) = 0.0_wp
+      
+      r1_rdtiscpl = 1._wp / prdt_iscpl 
+
+      ! mask tsn and tsb 
+      tsb(:,:,:,jp_tem)=tsb(:,:,:,jp_tem)*ptmask_b(:,:,:); tsn(:,:,:,jp_tem)=tsn(:,:,:,jp_tem)*tmask(:,:,:);
+      tsb(:,:,:,jp_sal)=tsb(:,:,:,jp_sal)*ptmask_b(:,:,:); tsn(:,:,:,jp_sal)=tsn(:,:,:,jp_sal)*tmask(:,:,:);
+
+      !==============================================================================
+      ! diagnose the heat, salt and volume input and compute the correction variable
+      !==============================================================================
+
+      ! 
+      zdssh(:,:) = sshn(:,:) * ssmask(:,:) - sshb(:,:) * psmask_b(:,:)
+      IF (.NOT. ln_linssh ) zdssh = 0.0_wp ! already included in the levels by definition
+      
+      DO jk = 1,jpk-1
+         DO jj = 2,jpj-1
+            DO ji = fs_2,fs_jpim1
+               IF (tmask_h(ji,jj) == 1._wp) THEN
+
+                  ! volume differences
+                  zde3t = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) - pe3t_b(ji,jj,jk) * ptmask_b(ji,jj,jk)
+
+                  ! heat diff
+                  zdtem = tsn(ji,jj,jk,jp_tem) * e3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   &
+                        - tsb(ji,jj,jk,jp_tem) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk)
+                  ! salt diff
+                  zdsal = tsn(ji,jj,jk,jp_sal) * e3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   &
+                        - tsb(ji,jj,jk,jp_sal) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk)
+               
+                  ! shh changes
+                  IF ( ptmask_b(ji,jj,jk) == 1._wp .OR. tmask(ji,jj,jk) == 1._wp ) THEN 
+                     zde3t = zde3t + zdssh(ji,jj) ! zdssh = 0 if vvl
+                     zdssh(ji,jj) = 0._wp
+                  END IF
+
+                  ! volume, heat and salt differences in each cell 
+                  pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * r1_rdtiscpl
+                  pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * r1_rdtiscpl 
+                  pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * r1_rdtiscpl
+
+                  ! case where we close a cell: check if the neighbour cells are wet 
+                  IF ( tmask(ji,jj,jk) == 0._wp .AND. ptmask_b(ji,jj,jk) == 1._wp ) THEN
+
+                     jip1=ji+1 ; jim1=ji-1 ; jjp1=jj+1 ; jjm1=jj-1 ;
+
+                     zsum =   e1e2t(ji  ,jjp1) * tmask(ji  ,jjp1,jk) + e1e2t(ji  ,jjm1) * tmask(ji  ,jjm1,jk) &
+                       &    + e1e2t(jim1,jj  ) * tmask(jim1,jj  ,jk) + e1e2t(jip1,jj  ) * tmask(jip1,jj  ,jk)
+
+                     IF ( zsum /= 0._wp ) THEN
+                        zjip1_ratio   = e1e2t(jip1,jj  ) * tmask(jip1,jj  ,jk) / zsum
+                        zjim1_ratio   = e1e2t(jim1,jj  ) * tmask(jim1,jj  ,jk) / zsum
+                        zjjp1_ratio   = e1e2t(ji  ,jjp1) * tmask(ji  ,jjp1,jk) / zsum
+                        zjjm1_ratio   = e1e2t(ji  ,jjm1) * tmask(ji  ,jjm1,jk) / zsum
+
+                        pvol_flx(ji  ,jjp1,jk       ) = pvol_flx(ji  ,jjp1,jk       ) + pvol_flx(ji,jj,jk       ) * zjjp1_ratio
+                        pvol_flx(ji  ,jjm1,jk       ) = pvol_flx(ji  ,jjm1,jk       ) + pvol_flx(ji,jj,jk       ) * zjjm1_ratio
+                        pvol_flx(jip1,jj  ,jk       ) = pvol_flx(jip1,jj  ,jk       ) + pvol_flx(ji,jj,jk       ) * zjip1_ratio
+                        pvol_flx(jim1,jj  ,jk       ) = pvol_flx(jim1,jj  ,jk       ) + pvol_flx(ji,jj,jk       ) * zjim1_ratio
+                        pts_flx (ji  ,jjp1,jk,jp_sal) = pts_flx (ji  ,jjp1,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjjp1_ratio
+                        pts_flx (ji  ,jjm1,jk,jp_sal) = pts_flx (ji  ,jjm1,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjjm1_ratio
+                        pts_flx (jip1,jj  ,jk,jp_sal) = pts_flx (jip1,jj  ,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjip1_ratio
+                        pts_flx (jim1,jj  ,jk,jp_sal) = pts_flx (jim1,jj  ,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjim1_ratio
+                        pts_flx (ji  ,jjp1,jk,jp_tem) = pts_flx (ji  ,jjp1,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjjp1_ratio
+                        pts_flx (ji  ,jjm1,jk,jp_tem) = pts_flx (ji  ,jjm1,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjjm1_ratio
+                        pts_flx (jip1,jj  ,jk,jp_tem) = pts_flx (jip1,jj  ,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjip1_ratio
+                        pts_flx (jim1,jj  ,jk,jp_tem) = pts_flx (jim1,jj  ,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjim1_ratio
+
+                        ! set to 0 the cell we distributed over neigbourg cells
+                        pvol_flx(ji,jj,jk       ) = 0._wp
+                        pts_flx (ji,jj,jk,jp_sal) = 0._wp
+                        pts_flx (ji,jj,jk,jp_tem) = 0._wp
+
+                     ELSE IF (zsum == 0._wp ) THEN
+                        ! case where we close a cell and no adjacent cell open
+                        ! check if the cell beneath is wet
+                        IF ( tmask(ji,jj,jk+1) == 1._wp ) THEN
+                           pvol_flx(ji,jj,jk+1)       =  pvol_flx(ji,jj,jk+1)        + pvol_flx(ji,jj,jk)
+                           pts_flx (ji,jj,jk+1,jp_sal)=  pts_flx (ji,jj,jk+1,jp_sal) + pts_flx (ji,jj,jk,jp_sal)
+                           pts_flx (ji,jj,jk+1,jp_tem)=  pts_flx (ji,jj,jk+1,jp_tem) + pts_flx (ji,jj,jk,jp_tem)
+
+                           ! set to 0 the cell we distributed over neigbourg cells
+                           pvol_flx(ji,jj,jk       ) = 0._wp
+                           pts_flx (ji,jj,jk,jp_sal) = 0._wp
+                           pts_flx (ji,jj,jk,jp_tem) = 0._wp
+                        ELSE
+                        ! case no adjacent cell on the horizontal and on the vertical
+                           IF ( lwp ) THEN   ! JMM : cAution this warning may occur on any mpp subdomain but numout is only
+                                             ! open for narea== 1 (lwp=T)
+                           WRITE(numout,*) 'W A R N I N G iscpl: no adjacent cell on the vertical and horizontal'
+                           WRITE(numout,*) '                     ',mig(ji),' ',mjg(jj),' ',jk
+                           WRITE(numout,*) '                     ',ji,' ',jj,' ',jk,' ',narea
+                           WRITE(numout,*) ' we are now looking for the closest wet cell on the horizontal '
+                           ENDIF
+                        ! We deal with these points later.
+                        END IF
+                     END IF
+                  END IF
+               END IF
+            END DO
+         END DO
+      END DO
+
+      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1.)
+      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.)
+      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.)
+
+      ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point 
+      ! allocation and initialisation of the list of problematic point
+      ALLOCATE(inpts(jpnij))
+      inpts(:)=0
+
+      ! fill narea location with the number of problematic point
+      DO jk = 1,jpk-1
+         DO jj = 2,jpj-1
+            DO ji = fs_2,fs_jpim1
+               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  &
+                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
+                  inpts(narea) = inpts(narea) + 1 
+               END IF
+            END DO
+         END DO
+      END DO
+
+      ! build array of total problematic point on each cpu (share to each cpu)
+      CALL mpp_max(inpts,jpnij) 
+
+      ! size of the new variable
+      npts  = SUM(inpts)    
+      
+      ! allocation of the coordinates, correction, index vector for the problematic points 
+      ALLOCATE(ixpts(npts), iypts(npts), izpts(npts), zcorr_vol(npts), zcorr_sal(npts), zcorr_tem(npts), zlon(npts), zlat(npts))
+      ixpts(:) = -9999 ; iypts(:) = -9999 ; izpts(:) = -9999 ; zlon(:) = -1.0e20_wp ; zlat(:) = -1.0e20_wp
+      zcorr_vol(:) = -1.0e20_wp
+      zcorr_sal(:) = -1.0e20_wp
+      zcorr_tem(:) = -1.0e20_wp
+
+      ! fill new variable
+      jpts = SUM(inpts(1:narea-1))
+      DO jk = 1,jpk-1
+         DO jj = 2,jpj-1
+            DO ji = fs_2,fs_jpim1
+               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  &
+                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
+                  jpts = jpts + 1  ! positioning in the inpts vector for the area narea
+                  ixpts(jpts) = ji           ; iypts(jpts) = jj ; izpts(jpts) = jk
+                  zlon (jpts) = glamt(ji,jj) ; zlat (jpts) = gphit(ji,jj)
+                  zcorr_vol(jpts) = pvol_flx(ji,jj,jk)
+                  zcorr_sal(jpts) = pts_flx (ji,jj,jk,jp_sal)
+                  zcorr_tem(jpts) = pts_flx (ji,jj,jk,jp_tem)
+
+                  ! set flx to 0 (safer)
+                  pvol_flx(ji,jj,jk       ) = 0.0_wp
+                  pts_flx (ji,jj,jk,jp_sal) = 0.0_wp
+                  pts_flx (ji,jj,jk,jp_tem) = 0.0_wp
+               END IF
+            END DO
+         END DO
+      END DO
+
+      ! build array of total problematic point on each cpu (share to each cpu)
+      ! point coordinates
+      CALL mpp_max(zlat ,npts)
+      CALL mpp_max(zlon ,npts)
+      CALL mpp_max(izpts,npts)
+
+      ! correction values 
+      CALL mpp_max(zcorr_vol,npts)
+      CALL mpp_max(zcorr_sal,npts)
+      CALL mpp_max(zcorr_tem,npts)
+
+      ! put correction term in the closest cell          
+      DO jpts = 1,npts
+         CALL dom_ngb(zlon(jpts), zlat(jpts), ixpts(jpts), iypts(jpts),'T', izpts(jpts))
+         DO jj = mj0(iypts(jpts)),mj1(iypts(jpts))
+            DO ji = mi0(ixpts(jpts)),mi1(ixpts(jpts))
+               jk = izpts(jpts)
+
+               IF (tmask_h(ji,jj) == 1._wp) THEN
+                  ! correct the vol_flx in the closest cell
+                  pvol_flx(ji,jj,jk)        =  pvol_flx(ji,jj,jk       ) + zcorr_vol(jpts)
+                  pts_flx (ji,jj,jk,jp_sal) =  pts_flx (ji,jj,jk,jp_sal) + zcorr_sal(jpts)
+                  pts_flx (ji,jj,jk,jp_tem) =  pts_flx (ji,jj,jk,jp_tem) + zcorr_tem(jpts)
+
+                  ! set correction to 0
+                  zcorr_vol(jpts) = 0.0_wp
+                  zcorr_sal(jpts) = 0.0_wp
+                  zcorr_tem(jpts) = 0.0_wp
+               END IF
+            END DO
+         END DO
+      END DO
+
+      ! deallocate variables 
+      DEALLOCATE(inpts)
+      DEALLOCATE(ixpts, iypts, izpts, zcorr_vol, zcorr_sal, zcorr_tem, zlon, zlat)
+    
+      ! add contribution store on the hallo (lbclnk remove one of the contribution)
+      pvol_flx(:,:,:       ) = pvol_flx(:,:,:       ) * tmask(:,:,:)
+      pts_flx (:,:,:,jp_sal) = pts_flx (:,:,:,jp_sal) * tmask(:,:,:)
+      pts_flx (:,:,:,jp_tem) = pts_flx (:,:,:,jp_tem) * tmask(:,:,:)
+
+      ! compute sum over the halo and set it to 0.
+      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1._wp)
+      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp)
+      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp)
+
+      ! deallocate variables
+      CALL wrk_dealloc(jpi,jpj, zdssh ) 
+
+   END SUBROUTINE iscpl_cons
+
+   SUBROUTINE iscpl_div( phdivn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE iscpl_div  ***
+      !!
+      !! ** Purpose :   update the horizontal divergenc
+      !!
+      !! ** Method  :
+      !!                CAUTION : iscpl is positive (inflow) and expressed in m/s
+      !!
+      !! ** Action  :   phdivn   increase by the iscpl correction term
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + hdiv_iscpl(ji,jj,jk) / e3t_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+   END SUBROUTINE iscpl_div
+
+END MODULE iscplhsb
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90	(revision 6808)
@@ -0,0 +1,85 @@
+MODULE iscplini
+   !!======================================================================
+   !!                       ***  MODULE  sbciscpl***
+   !! Ocean forcing:  river runoff
+   !!=====================================================================
+   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   iscpl_init     : initialisation routine (namelist)
+   !!   iscpl_alloc    : allocation of correction variables
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE oce             ! global tra/dyn variable
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! MPP library
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   iscpl_init      
+   PUBLIC   iscpl_alloc 
+   !!                                                      !!* namsbc_iscpl namelist *
+   LOGICAL , PUBLIC                                        ::   ln_hsb
+   INTEGER , PUBLIC                                        ::   nn_fiscpl, nstp_iscpl
+   INTEGER , PUBLIC                                        ::   nn_drown
+   REAL(wp), PUBLIC                                        ::   rdt_iscpl
+   !!                                                      !!* namsbc_iscpl namelist *
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::   hdiv_iscpl
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   htsc_iscpl
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: sbcrnf.F90 4666 2014-06-11 12:52:23Z mathiot $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION iscpl_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE sbc_iscpl_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( htsc_iscpl(jpi,jpj,jpk,jpts) , hdiv_iscpl(jpi,jpj,jpk) , STAT=iscpl_alloc )
+         !
+      IF( lk_mpp          )   CALL mpp_sum ( iscpl_alloc )
+      IF( iscpl_alloc > 0 )   CALL ctl_warn('iscpl_alloc: allocation of arrays failed')
+   END FUNCTION iscpl_alloc
+
+   SUBROUTINE iscpl_init()
+      INTEGER ::   ios           ! Local integer output status for namelist read
+      NAMELIST/namsbc_iscpl/nn_fiscpl,ln_hsb,nn_drown
+      !!----------------------------------------------------------------------
+      !                                   ! ============
+      !                                   !   Namelist
+      !                                   ! ============
+      !
+      nn_fiscpl = 0
+      ln_hsb    = .FALSE.
+      REWIND( numnam_ref )              ! Namelist namsbc_iscpl in reference namelist : Ice sheet coupling
+      READ  ( numnam_ref, namsbc_iscpl, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iscpl in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namsbc_iscpl in configuration namelist : Ice Sheet coupling
+      READ  ( numnam_cfg, namsbc_iscpl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iscpl in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsbc_iscpl )
+      !
+      nstp_iscpl=MIN(nn_fiscpl, nitend-nit000+1) ! the coupling period have to be less or egal than the total number of time step
+      rdt_iscpl = nstp_iscpl * rn_rdt
+      !
+      IF (lwp) THEN
+         WRITE(numout,*) 'iscpl_rst:'
+         WRITE(numout,*) '~~~~~~~~~'
+         WRITE(numout,*) ' coupling     flag (ln_iscpl )            = ', ln_iscpl
+         WRITE(numout,*) ' conservation flag (ln_hsb   )            = ', ln_hsb
+         WRITE(numout,*) ' nb of stp for cons (rn_fiscpl)           = ', nstp_iscpl
+         IF (nstp_iscpl .NE. nn_fiscpl) WRITE(numout,*) 'W A R N I N G: nb of stp for cons has been modified &
+            &                                           (larger than run length)'
+         WRITE(numout,*) ' coupling time step                       = ', rdt_iscpl
+         WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown
+      END IF
+
+   END SUBROUTINE iscpl_init
+
+END MODULE iscplini
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90	(revision 6808)
@@ -0,0 +1,441 @@
+MODULE iscplrst
+   !!======================================================================
+   !!                       ***  MODULE  iscplrst***
+   !! Ocean forcing: update the restart file in case of ice sheet/ocean coupling
+   !!=====================================================================
+   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   iscpl_stp          : step management
+   !!   iscpl_rst_interpol : restart interpolation in case of coupling with ice sheet
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE domwri          ! ocean space and time domain
+   USE domvvl, ONLY : dom_vvl_interpol
+   USE phycst          ! physical constants
+   USE sbc_oce         ! surface boundary condition variables
+   USE oce             ! global tra/dyn variable
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE lbclnk          ! communication
+   USE iscplini        ! ice sheet coupling: initialisation
+   USE iscplhsb        ! ice sheet coupling: conservation
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   iscpl_stp          ! step management 
+   !!
+   !! * Substitutions  
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: sbcrnf.F90 4666 2014-06-11 12:52:23Z mathiot $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE iscpl_stp
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE iscpl_stp  ***
+      !! 
+      !! ** Purpose : compute initialisation
+      !!              compute extrapolation of restart variable un, vn, tsn, sshn (wetting/drying)   
+      !!              compute correction term if needed
+      !! 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   inum0
+      REAL(wp), DIMENSION(:,:  ), POINTER :: zsmask_b
+      REAL(wp), DIMENSION(:,:,:), POINTER :: ztmask_b, zumask_b, zvmask_b
+      REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t_b  , ze3u_b  , ze3v_b  
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zdepw_b
+      CHARACTER(20) :: cfile
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc(jpi,jpj,jpk, ztmask_b, zumask_b, zvmask_b) ! mask before
+      CALL wrk_alloc(jpi,jpj,jpk, ze3t_b  , ze3u_b  , ze3v_b  ) ! e3   before
+      CALL wrk_alloc(jpi,jpj,jpk, zdepw_b )
+      CALL wrk_alloc(jpi,jpj,     zsmask_b                    )
+
+
+      !! get restart variable
+      CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b   ) ! need to extrapolate T/S
+      CALL iom_get( numror, jpdom_autoglo, 'umask'  , zumask_b   ) ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'vmask'  , zvmask_b   ) ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'smask'  , zsmask_b   ) ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'e3t_n'  , ze3t_b(:,:,:) )  ! need to compute temperature correction
+      CALL iom_get( numror, jpdom_autoglo, 'e3u_n'  , ze3u_b(:,:,:) )  ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'e3v_n'  , ze3v_b(:,:,:) )  ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl)
+
+      !! read namelist
+      CALL iscpl_init()
+
+      !!  ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl)
+      CALL iscpl_rst_interpol( ztmask_b, zumask_b, zvmask_b, zsmask_b, ze3t_b, ze3u_b, ze3v_b, zdepw_b )
+
+      !! compute correction if conservation needed
+      IF ( ln_hsb ) THEN
+         IF( iscpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'rst_iscpl : unable to allocate rst_iscpl arrays' )
+         CALL iscpl_cons(ztmask_b, zsmask_b, ze3t_b, htsc_iscpl, hdiv_iscpl, rdt_iscpl)
+      END IF
+         
+      !! print mesh/mask
+      IF( nmsh /= 0 .AND. ln_iscpl )   CALL dom_wri      ! Create a domain file
+
+      IF ( ln_hsb ) THEN
+         cfile='correction'
+         cfile = TRIM( cfile )
+         CALL iom_open  ( cfile, inum0, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_rstput( 0, 0, inum0, 'vol_cor', hdiv_iscpl(:,:,:) )
+         CALL iom_rstput( 0, 0, inum0, 'tem_cor', htsc_iscpl(:,:,:,jp_tem) )
+         CALL iom_rstput( 0, 0, inum0, 'sal_cor', htsc_iscpl(:,:,:,jp_sal) )
+         CALL iom_close ( inum0 )
+      END IF
+
+      CALL wrk_dealloc(jpi,jpj,jpk, ztmask_b,zumask_b,zvmask_b )  
+      CALL wrk_dealloc(jpi,jpj,jpk, ze3t_b  ,ze3u_b  ,ze3v_b   )  
+      CALL wrk_dealloc(jpi,jpj,jpk, zdepw_b                    )
+      CALL wrk_dealloc(jpi,jpj,     zsmask_b                   )
+
+      !! next step is an euler time step
+      neuler = 0
+
+      !! set _b and _n variables equal
+      tsb (:,:,:,:) = tsn (:,:,:,:)
+      ub  (:,:,:  ) = un  (:,:,:  )
+      vb  (:,:,:  ) = vn  (:,:,:  )
+      sshb(:,:    ) = sshn(:,:)
+
+      !! set _b and _n vertical scale factor equal
+      e3t_b (:,:,:) = e3t_n (:,:,:)
+      e3u_b (:,:,:) = e3u_n (:,:,:)
+      e3v_b (:,:,:) = e3v_n (:,:,:)
+
+      e3uw_b(:,:,:)  = e3uw_n(:,:,:)
+      e3vw_b(:,:,:)  = e3vw_n(:,:,:)
+      gdept_b(:,:,:)  = gdept_n(:,:,:)
+      gdepw_b(:,:,:) = gdepw_n(:,:,:)
+      hu_b (:,:) = hu_n(:,:)
+      hv_b (:,:) = hv_n(:,:)
+      r1_hu_b(:,:) = r1_hu_n(:,:)
+      r1_hv_b(:,:) = r1_hv_n(:,:)
+      !
+   END SUBROUTINE iscpl_stp
+   
+   SUBROUTINE iscpl_rst_interpol (ptmask_b, pumask_b, pvmask_b, psmask_b, pe3t_b, pe3u_b, pe3v_b, pdepw_b)
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE iscpl_rst_interpol  ***
+      !! 
+      !! ** Purpose :   compute new tn, sn, un, vn and sshn in case of evolving geometry of ice shelves 
+      !!                compute 2d fields of heat, salt and volume correction
+      !! 
+      !! ** Method  :   tn, sn : extrapolation from neigbourg cells
+      !!                un, vn : fill with 0 velocity and keep barotropic transport by modifing surface velocity or adjacent velocity
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: ptmask_b, pumask_b, pvmask_b    !! mask before
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pe3t_b  , pe3u_b  , pe3v_b      !! scale factor before
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pdepw_b                         !! depth w before
+      REAL(wp), DIMENSION(:,:    ), INTENT(in ) :: psmask_b                        !! mask before
+      !!
+      INTEGER :: ji, jj, jk, iz          !! loop index
+      INTEGER :: jip1, jim1, jjp1, jjm1, jkp1, jkm1
+      !!
+      REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb
+      REAL(wp):: zdz, zdzm1, zdzp1
+      !!
+      REAL(wp), DIMENSION(:,:    ), POINTER :: zdmask , zdsmask, zvcorr, zucorr, zde3t
+      REAL(wp), DIMENSION(:,:    ), POINTER :: zbub   , zbvb   , zbun  , zbvn
+      REAL(wp), DIMENSION(:,:    ), POINTER :: zssh0  , zssh1, zhu1, zhv1
+      REAL(wp), DIMENSION(:,:    ), POINTER :: zsmask0, zsmask1
+      REAL(wp), DIMENSION(:,:,:  ), POINTER :: ztmask0, ztmask1, ztrp
+      REAL(wp), DIMENSION(:,:,:  ), POINTER :: zwmaskn, zwmaskb, ztmp3d
+      REAL(wp), DIMENSION(:,:,:,:), POINTER :: zts0
+      !!----------------------------------------------------------------------
+
+      !! allocate variables
+      CALL wrk_alloc(jpi,jpj,jpk,2, zts0                                   )
+      CALL wrk_alloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp, ztmp3d        ) 
+      CALL wrk_alloc(jpi,jpj,jpk,   zwmaskn, zwmaskb                       ) 
+      CALL wrk_alloc(jpi,jpj,       zsmask0, zsmask1                       ) 
+      CALL wrk_alloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t) 
+      CALL wrk_alloc(jpi,jpj,       zbub   , zbvb    , zbun , zbvn         ) 
+      CALL wrk_alloc(jpi,jpj,       zssh0  , zssh1, zhu1, zhv1             ) 
+
+      !! mask value to be sure
+      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * ptmask_b(:,:,:)
+      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * ptmask_b(:,:,:)
+      
+      ! compute wmask
+      zwmaskn(:,:,1) = tmask   (:,:,1)
+      zwmaskb(:,:,1) = ptmask_b(:,:,1)
+      DO jk = 2,jpk
+         zwmaskn(:,:,jk) =  tmask  (:,:,jk) *  tmask  (:,:,jk-1)
+         zwmaskb(:,:,jk) = ptmask_b(:,:,jk) * ptmask_b(:,:,jk-1)
+      END DO
+           
+      ! compute new ssh if we open a full water column (average of the closest neigbourgs)  
+      sshb (:,:)=sshn(:,:)
+      zssh0(:,:)=sshn(:,:)
+      zsmask0(:,:) = psmask_b(:,:)
+      zsmask1(:,:) = psmask_b(:,:)
+      DO iz = 1,10    ! need to be tuned (configuration dependent) (OK for ISOMIP+)
+         zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:)
+         DO jj = 2,jpj-1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               jip1=ji+1; jim1=ji-1;
+               jjp1=jj+1; jjm1=jj-1;
+               summsk=(zsmask0(jip1,jj)+zsmask0(jim1,jj)+zsmask0(ji,jjp1)+zsmask0(ji,jjm1))
+               IF (zdsmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN
+                  sshn(ji,jj)=( zssh0(jip1,jj)*zsmask0(jip1,jj)     &
+                  &           + zssh0(jim1,jj)*zsmask0(jim1,jj)     &
+                  &           + zssh0(ji,jjp1)*zsmask0(ji,jjp1)     &
+                  &           + zssh0(ji,jjm1)*zsmask0(ji,jjm1))/summsk
+                  zsmask1(ji,jj)=1._wp
+               END IF
+            END DO
+         END DO
+         CALL lbc_lnk(sshn,'T',1._wp)
+         CALL lbc_lnk(zsmask1,'T',1._wp)
+         zssh0   = sshn
+         zsmask0 = zsmask1
+      END DO
+      sshn(:,:) = sshn(:,:) * ssmask(:,:)
+
+!=============================================================================
+!PM: Is this needed since introduction of VVL by default?
+      IF (.NOT.ln_linssh) THEN
+      ! Reconstruction of all vertical scale factors at now time steps
+      ! =============================================================================
+      ! Horizontal scale factor interpolations
+      ! --------------------------------------
+         DO jk = 1,jpk
+            DO jj=1,jpj
+               DO ji=1,jpi
+                  IF (tmask(ji,jj,1) == 0._wp .OR. ptmask_b(ji,jj,1) == 0._wp) THEN
+                     e3t_n(ji,jj,jk) = e3t_0(ji,jj,jk) * ( 1._wp + sshn(ji,jj) / ( ht_0(ji,jj) + 1._wp - ssmask(ji,jj) ) * tmask(ji,jj,jk) )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+         CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+         CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+         CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
+
+      ! Vertical scale factor interpolations
+      ! ------------------------------------
+         CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
+         CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
+         CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
+
+      ! t- and w- points depth
+      ! ----------------------
+         gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+         gdepw_n(:,:,1) = 0.0_wp
+         gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               DO jk = 2,mikt(ji,jj)-1
+                  gdept_n(ji,jj,jk) = gdept_0(ji,jj,jk)
+                  gdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
+                  gde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj)
+               END DO
+               IF (mikt(ji,jj) > 1) THEN
+                  jk = mikt(ji,jj)
+                  gdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * e3w_n(ji,jj,jk)
+                  gdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
+                  gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk  ) - sshn   (ji,jj)
+               END IF
+               DO jk = mikt(ji,jj)+1, jpk
+                  gdept_n(ji,jj,jk) = gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)
+                  gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
+                  gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk  ) - sshn (ji,jj)
+               END DO
+            END DO
+         END DO
+
+      ! t-, u- and v- water column thickness
+      ! ------------------------------------
+         ht_n(:,:) = 0._wp ; hu_n(:,:) = 0._wp ; hv_n(:,:) = 0._wp
+         DO jk = 1, jpkm1
+            hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
+            hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
+            ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
+         END DO
+         !                                        ! Inverse of the local depth
+         r1_hu_n(:,:) = 1._wp / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) * ssumask(:,:)
+         r1_hv_n(:,:) = 1._wp / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:)
+
+      END IF
+
+!=============================================================================
+! compute velocity
+! compute velocity in order to conserve barotropic velocity (modification by poderation of the scale factor).
+      ub(:,:,:)=un(:,:,:)
+      vb(:,:,:)=vn(:,:,:)
+      DO jk = 1,jpk
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               un(ji,jj,jk) = ub(ji,jj,jk)*pe3u_b(ji,jj,jk)*pumask_b(ji,jj,jk)/e3u_n(ji,jj,jk)*umask(ji,jj,jk);
+               vn(ji,jj,jk) = vb(ji,jj,jk)*pe3v_b(ji,jj,jk)*pvmask_b(ji,jj,jk)/e3v_n(ji,jj,jk)*vmask(ji,jj,jk);
+            END DO
+         END DO
+      END DO
+
+! compute new velocity if we close a cell (check barotropic velocity and change velocity over the water column)
+! compute barotropic velocity now and after 
+      ztrp(:,:,:) = ub(:,:,:)*pe3u_b(:,:,:); 
+      zbub(:,:)   = SUM(ztrp,DIM=3)
+      ztrp(:,:,:) = vb(:,:,:)*pe3v_b(:,:,:); 
+      zbvb(:,:)   = SUM(ztrp,DIM=3)
+      ztrp(:,:,:) = un(:,:,:)*e3u_n(:,:,:); 
+      zbun(:,:)   = SUM(ztrp,DIM=3)
+      ztrp(:,:,:) = vn(:,:,:)*e3v_n(:,:,:); 
+      zbvn(:,:)   = SUM(ztrp,DIM=3)
+
+      ! new water column
+      zhu1=0.0_wp ;
+      zhv1=0.0_wp ;
+      DO jk  = 1,jpk
+        zhu1(:,:) = zhu1(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
+        zhv1(:,:) = zhv1(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
+      END DO
+      
+      ! compute correction      
+      zucorr = 0._wp
+      zvcorr = 0._wp
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+            IF (zbun(ji,jj) /= zbub(ji,jj) .AND. zhu1(ji,jj) /= 0._wp ) THEN
+               zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/zhu1(ji,jj)
+            END IF
+            IF (zbvn(ji,jj) /= zbvb(ji,jj) .AND. zhv1(ji,jj) /= 0._wp ) THEN
+               zvcorr(ji,jj) = (zbvn(ji,jj) - zbvb(ji,jj))/zhv1(ji,jj)
+            END IF
+         END DO
+      END DO 
+      
+      ! update velocity
+      DO jk  = 1,jpk
+         un(:,:,jk)=(un(:,:,jk) - zucorr(:,:))*umask(:,:,jk)
+         vn(:,:,jk)=(vn(:,:,jk) - zvcorr(:,:))*vmask(:,:,jk)
+      END DO
+
+!=============================================================================
+      ! compute temp and salt
+      ! compute new tn and sn if we open a new cell
+      tsb (:,:,:,:) = tsn(:,:,:,:)
+      zts0(:,:,:,:) = tsn(:,:,:,:)
+      ztmask1(:,:,:) = ptmask_b(:,:,:)
+      ztmask0(:,:,:) = ptmask_b(:,:,:)
+      DO iz = 1,nn_drown ! resolution dependent (OK for ISOMIP+ case)
+          DO jk = 1,jpk-1
+              zdmask=tmask(:,:,jk)-ztmask0(:,:,jk);
+              DO jj = 2,jpj-1
+                 DO ji = fs_2,fs_jpim1
+                      jip1=ji+1; jim1=ji-1;
+                      jjp1=jj+1; jjm1=jj-1;
+                      summsk= (ztmask0(jip1,jj  ,jk)+ztmask0(jim1,jj  ,jk)+ztmask0(ji  ,jjp1,jk)+ztmask0(ji  ,jjm1,jk))
+                      IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN
+                      !! horizontal basic extrapolation
+                         tsn(ji,jj,jk,1)=( zts0(jip1,jj  ,jk,1)*ztmask0(jip1,jj  ,jk) &
+                         &                +zts0(jim1,jj  ,jk,1)*ztmask0(jim1,jj  ,jk) &
+                         &                +zts0(ji  ,jjp1,jk,1)*ztmask0(ji  ,jjp1,jk) &
+                         &                +zts0(ji  ,jjm1,jk,1)*ztmask0(ji  ,jjm1,jk) ) / summsk
+                         tsn(ji,jj,jk,2)=( zts0(jip1,jj  ,jk,2)*ztmask0(jip1,jj  ,jk) &
+                         &                +zts0(jim1,jj  ,jk,2)*ztmask0(jim1,jj  ,jk) &
+                         &                +zts0(ji  ,jjp1,jk,2)*ztmask0(ji  ,jjp1,jk) &
+                         &                +zts0(ji  ,jjm1,jk,2)*ztmask0(ji  ,jjm1,jk) ) / summsk
+                         ztmask1(ji,jj,jk)=1
+                      ELSEIF (zdmask(ji,jj) == 1._wp .AND. summsk == 0._wp) THEN
+                      !! vertical extrapolation if horizontal extrapolation failed
+                         jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1)
+                         summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1))
+                         IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp ) THEN
+                            tsn(ji,jj,jk,1)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1)     &
+                            &                +zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1))/summsk
+                            tsn(ji,jj,jk,2)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1)     &
+                            &                +zts0(ji,jj,jkm1,2)*ztmask0(ji,jj,jkm1))/summsk
+                            ztmask1(ji,jj,jk)=1._wp
+                         END IF
+                      END IF
+                  END DO
+              END DO
+          END DO
+          
+          CALL lbc_lnk(tsn(:,:,:,1),'T',1._wp)
+          CALL lbc_lnk(tsn(:,:,:,2),'T',1._wp)
+          CALL lbc_lnk(ztmask1,     'T',1._wp)
+
+          ! update
+          zts0(:,:,:,:) = tsn(:,:,:,:)
+          ztmask0 = ztmask1
+
+      END DO
+
+      ! mask new tsn field
+      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:)
+      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:)
+
+      ! compute new T/S (interpolation) if vvl only for common wet cell in before and after wmask
+      !PM: Is this IF needed since change to VVL by default
+      IF (.NOT.ln_linssh) THEN
+         DO jk = 2,jpk-1
+            DO jj = 1,jpj
+               DO ji = 1,jpi
+                  IF (zwmaskn(ji,jj,jk) * zwmaskb(ji,jj,jk) == 1._wp .AND. (tmask(ji,jj,1)==0._wp .OR. ptmask_b(ji,jj,1)==0._wp) ) THEN
+                     !compute weight
+                     zdzp1 = MAX(0._wp,gdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk+1))
+                     zdz   =           gdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk  ) 
+                     zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk  ) - gdepw_n(ji,jj,jk  ))
+                     IF (zdz .LT. 0._wp) THEN 
+                        CALL ctl_stop( 'STOP', 'rst_iscpl : unable to compute the interpolation' )
+                     END IF
+                     tsn(ji,jj,jk,jp_tem) = ( zdzp1*tsb(ji,jj,jk+1,jp_tem)      &
+                        &                   + zdz  *tsb(ji,jj,jk  ,jp_tem)      &
+                        &                   + zdzm1*tsb(ji,jj,jk-1,jp_tem)      )/e3t_n(ji,jj,jk)
+                     tsn(ji,jj,jk,jp_sal) = ( zdzp1*tsb(ji,jj,jk+1,jp_sal)      &
+                        &                   + zdz  *tsb(ji,jj,jk  ,jp_sal)      &
+                        &                   + zdzm1*tsb(ji,jj,jk-1,jp_sal)      )/e3t_n(ji,jj,jk)
+                  END IF
+               END DO
+            END DO
+         END DO               
+      END IF
+
+      ! closed pool
+      ! -----------------------------------------------------------------------------------------
+      ! case we open a cell but no neigbour cells available to get an estimate of T and S
+      WHERE (tmask(:,:,:) == 1._wp .AND. tsn(:,:,:,2) == 0._wp) 
+         tsn(:,:,:,2) = -99._wp  ! Special value for closed pool (checking purpose in output.init)
+         tmask(:,:,:) = 0._wp    ! set mask to 0 to run
+         umask(:,:,:) = 0._wp
+         vmask(:,:,:) = 0._wp
+      END WHERE
+      
+      ! set mbkt and mikt to 1 in thiese location
+      WHERE (SUM(tmask,dim=3) == 0)
+         mbkt(:,:)=1 ; mbku(:,:)=1 ; mbkv(:,:)=1
+         mikt(:,:)=1 ; miku(:,:)=1 ; mikv(:,:)=1
+      END WHERE
+      ! -------------------------------------------------------------------------------------------
+      ! compute new tn and sn if we close cell 
+      ! nothing to do
+      ! 
+      ! deallocation tmp arrays
+      CALL wrk_dealloc(jpi,jpj,jpk,2, zts0                                   )
+      CALL wrk_dealloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp                ) 
+      CALL wrk_dealloc(jpi,jpj,jpk,   zwmaskn, zwmaskb , ztmp3d              ) 
+      CALL wrk_dealloc(jpi,jpj,       zsmask0, zsmask1                       ) 
+      CALL wrk_dealloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t) 
+      CALL wrk_dealloc(jpi,jpj,       zbub   , zbvb    , zbun  , zbvn        ) 
+      CALL wrk_dealloc(jpi,jpj,       zssh0  , zssh1  , zhu1 , zhv1          ) 
+
+   END SUBROUTINE iscpl_rst_interpol
+
+END MODULE iscplrst
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 6808)
@@ -29,15 +29,11 @@
    USE daymod          ! calendar
    USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine)
-   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldftra          ! lateral physics: ocean active tracers
    USE zdf_oce         ! ocean vertical physics
    USE phycst          ! physical constants
    USE dtatsd          ! data temperature and salinity   (dta_tsd routine)
    USE dtauvd          ! data: U & V current             (dta_uvd routine)
-   USE zpshde          ! partial step: hor. derivative (zps_hde routine)
-   USE eosbn2          ! equation of state            (eos bn2 routine)
    USE domvvl          ! varying vertical mesh
-   USE dynspg_oce      ! pressure gradient schemes
-   USE dynspg_flt      ! filtered free surface
-   USE sol_oce         ! ocean solver variables
+   USE iscplrst        ! ice sheet coupling
    !
    USE in_out_manager  ! I/O manager
@@ -54,5 +50,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -76,10 +71,10 @@
       !
 
-      IF(lwp) WRITE(numout,*) ' '
+      IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
 
-      CALL dta_tsd_init                       ! Initialisation of T & S input data
-      IF( lk_c1d ) CALL dta_uvd_init          ! Initialization of U & V input data
+                     CALL dta_tsd_init        ! Initialisation of T & S input data
+      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data
 
       rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk
@@ -90,6 +85,7 @@
       IF( ln_rstart ) THEN                    ! Restart from a file
          !                                    ! -------------------
-         CALL rst_read                           ! Read the restart file
-         CALL day_init                           ! model calendar (using both namelist and restart infos)
+         CALL rst_read                        ! Read the restart file
+         IF (ln_iscpl)       CALL iscpl_stp   ! extraloate restart to wet and dry
+         CALL day_init                        ! model calendar (using both namelist and restart infos)
       ELSE
          !                                    ! Start from rest
@@ -103,6 +99,5 @@
          ub   (:,:,:) = 0._wp   ;   un   (:,:,:) = 0._wp
          vb   (:,:,:) = 0._wp   ;   vn   (:,:,:) = 0._wp  
-         rotb (:,:,:) = 0._wp   ;   rotn (:,:,:) = 0._wp
-         hdivb(:,:,:) = 0._wp   ;   hdivn(:,:,:) = 0._wp
+                                    hdivn(:,:,:) = 0._wp
          !
          IF( cp_cfg == 'eel' ) THEN
@@ -119,69 +114,47 @@
             ENDIF
             IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000
-               CALL wrk_alloc( jpi, jpj, jpk, 2, zuvd )
+               CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd )
                CALL dta_uvd( nit000, zuvd )
                ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:)
                vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:)
-               CALL wrk_dealloc( jpi, jpj, jpk, 2, zuvd )
+               CALL wrk_dealloc( jpi,jpj,jpk,2,   zuvd )
             ENDIF
          ENDIF
          !
-         CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) )        ! before potential and in situ densities
-#if ! defined key_c1d
-         IF( ln_zps .AND. .NOT. ln_isfcav)                                 &
-            &            CALL zps_hde    ( nit000, jpts, tsb, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
-            &                                            rhd, gru , grv    )  ! of t, s, rd at the last ocean level
-         IF( ln_zps .AND.       ln_isfcav)                                 &
-            &            CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
-            &                                            rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
-            &                                     gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
-#endif
-         !   
-         ! - ML - sshn could be modified by istate_eel, so that initialization of fse3t_b is done here
-         IF( lk_vvl ) THEN
+!!gm This is to be changed !!!!
+         ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here
+         IF( .NOT.ln_linssh ) THEN
             DO jk = 1, jpk
-               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
-            ENDDO
+               e3t_b(:,:,jk) = e3t_n(:,:,jk)
+            END DO
          ENDIF
+!!gm 
          ! 
       ENDIF
-      !
-      IF( lk_agrif ) THEN                  ! read free surface arrays in restart file
-         IF( ln_rstart ) THEN
-            IF( lk_dynspg_flt )  THEN      ! read or initialize the following fields
-               !                           ! gcx, gcxb for agrif_opa_init
-               IF( sol_oce_alloc()  > 0 )   CALL ctl_stop('agrif sol_oce_alloc: allocation of arrays failed')
-               CALL flt_rst( nit000, 'READ' )
-            ENDIF
-         ENDIF                             ! explicit case not coded yet with AGRIF
-      ENDIF
-      !
       ! 
       ! Initialize "now" and "before" barotropic velocities:
-      ! Do it whatever the free surface method, these arrays
-      ! being eventually used
-      !
-      !
-      un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp
-      ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp
-      !
+      ! Do it whatever the free surface method, these arrays being eventually used
+      !
+      un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp
+      ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp
+      !
+!!gm  the use of umsak & vmask is not necessary belox as un, vn, ub, vb are always masked
       DO jk = 1, jpkm1
          DO jj = 1, jpj
             DO ji = 1, jpi
-               un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)
-               vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)
+               un_b(ji,jj) = un_b(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)
+               vn_b(ji,jj) = vn_b(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)
                !
-               ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk)
-               vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk)
+               ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk)
+               vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk)
             END DO
          END DO
       END DO
       !
-      un_b(:,:) = un_b(:,:) * hur  (:,:)
-      vn_b(:,:) = vn_b(:,:) * hvr  (:,:)
-      !
-      ub_b(:,:) = ub_b(:,:) * hur_b(:,:)
-      vb_b(:,:) = vb_b(:,:) * hvr_b(:,:)
-      !
+      un_b(:,:) = un_b(:,:) * r1_hu_n(:,:)
+      vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:)
+      !
+      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)
+      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)
       !
       IF( nn_timing == 1 )   CALL timing_stop('istate_init')
@@ -202,6 +175,6 @@
       !! References :  Philander ???
       !!----------------------------------------------------------------------
-      INTEGER  :: ji, jj, jk
-      REAL(wp) ::   zsal = 35.50
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zsal = 35.50_wp
       !!----------------------------------------------------------------------
       !
@@ -211,6 +184,6 @@
       !
       DO jk = 1, jpk
-         tsn(:,:,jk,jp_tem) = (  ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH((fsdept(:,:,jk)-80.)/30.) )   &
-            &                + 10. * ( 5000. - fsdept(:,:,jk) ) /5000.)  ) * tmask(:,:,jk)
+         tsn(:,:,jk,jp_tem) = (  ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH((gdept_n(:,:,jk)-80.)/30.) )   &
+            &                + 10. * ( 5000. - gdept_n(:,:,jk) ) /5000.)  ) * tmask(:,:,jk)
          tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem)
       END DO
@@ -233,5 +206,5 @@
       !!                and relative vorticity fields
       !!----------------------------------------------------------------------
-      USE divcur     ! hor. divergence & rel. vorticity      (div_cur routine)
+      USE divhor     ! hor. divergence      (div_hor routine)
       USE iom
       !
@@ -265,11 +238,7 @@
             !
             DO jk = 1, jpk
-               tsn(:,:,jk,jp_tem) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk)
+               tsn(:,:,jk,jp_tem) = ( zt2 + zt1 * exp( - gdept_n(:,:,jk) / 1000 ) ) * tmask(:,:,jk)
                tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem)
             END DO
-            !
-            IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi   , jpj   , jpk   , jpj/2 ,   &
-               &                             1     , jpi   , 5     , 1     , jpk   ,   &
-               &                             1     , 1.    , numout                  )
             !
             ! set salinity field to a constant value
@@ -282,5 +251,5 @@
             tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)
             !
-            ! set the dynamics: U,V, hdiv, rot (and ssh if necessary)
+            ! set the dynamics: U,V, hdiv (and ssh if necessary)
             ! ----------------
             ! Start EEL5 configuration with barotropic geostrophic velocities 
@@ -318,5 +287,7 @@
             ENDIF
             !
-            CALL div_cur( nit000 )                  ! horizontal divergence and relative vorticity (curl)
+!!gm  Check  here call to div_hor should not be necessary
+!!gm         div_hor call runoffs  not sure they are defined at that level
+            CALL div_hor( nit000 )                  ! horizontal divergence and relative vorticity (curl)
             ! N.B. the vertical velocity will be computed from the horizontal divergence field
             ! in istate by a call to wzv routine
@@ -338,8 +309,4 @@
             !
             tsn(:,:,:,jp_tem) = tsb(:,:,:,jp_tem)                            ! set nox temperature to tb
-            !
-            IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi   , jpj   , jpk   , jpj/2 ,   &
-               &                            1     , jpi   , 5     , 1     , jpk   ,   &
-               &                            1     , 1.    , numout                  )
             !
             ! set salinity field to a constant value
@@ -371,5 +338,5 @@
       !!
       !! ** Method  : - set temprature field
-      !!              - set salinity field
+      !!              - set salinity   field
       !!----------------------------------------------------------------------
       INTEGER :: ji, jj, jk  ! dummy loop indices
@@ -388,20 +355,20 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  tsn(ji,jj,jk,jp_tem) = (  16. - 12. * TANH( (fsdept(ji,jj,jk) - 400) / 700 )         )   &
-                       &           * (-TANH( (500-fsdept(ji,jj,jk)) / 150 ) + 1) / 2               &
-                       &       + (      15. * ( 1. - TANH( (fsdept(ji,jj,jk)-50.) / 1500.) )       &
-                       &                - 1.4 * TANH((fsdept(ji,jj,jk)-100.) / 100.)               &    
-                       &                + 7.  * (1500. - fsdept(ji,jj,jk)) / 1500.             )   & 
-                       &           * (-TANH( (fsdept(ji,jj,jk) - 500) / 150) + 1) / 2
+                  tsn(ji,jj,jk,jp_tem) = (  16. - 12. * TANH( (gdept_n(ji,jj,jk) - 400) / 700 )         )   &
+                       &           * (-TANH( (500-gdept_n(ji,jj,jk)) / 150 ) + 1) / 2               &
+                       &       + (      15. * ( 1. - TANH( (gdept_n(ji,jj,jk)-50.) / 1500.) )       &
+                       &                - 1.4 * TANH((gdept_n(ji,jj,jk)-100.) / 100.)               &    
+                       &                + 7.  * (1500. - gdept_n(ji,jj,jk)) / 1500.             )   & 
+                       &           * (-TANH( (gdept_n(ji,jj,jk) - 500) / 150) + 1) / 2
                   tsn(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
                   tsb(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem)
 
-                  tsn(ji,jj,jk,jp_sal) =  (  36.25 - 1.13 * TANH( (fsdept(ji,jj,jk) - 305) / 460 )  )  &
-                     &              * (-TANH((500 - fsdept(ji,jj,jk)) / 150) + 1) / 2          &
-                     &          + (  35.55 + 1.25 * (5000. - fsdept(ji,jj,jk)) / 5000.         &
-                     &                - 1.62 * TANH( (fsdept(ji,jj,jk) - 60.  ) / 650. )       &
-                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 35.  ) / 100. )       &
-                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 1000.) / 5000.)    )  &
-                     &              * (-TANH((fsdept(ji,jj,jk) - 500) / 150) + 1) / 2 
+                  tsn(ji,jj,jk,jp_sal) =  (  36.25 - 1.13 * TANH( (gdept_n(ji,jj,jk) - 305) / 460 )  )  &
+                     &              * (-TANH((500 - gdept_n(ji,jj,jk)) / 150) + 1) / 2          &
+                     &          + (  35.55 + 1.25 * (5000. - gdept_n(ji,jj,jk)) / 5000.         &
+                     &                - 1.62 * TANH( (gdept_n(ji,jj,jk) - 60.  ) / 650. )       &
+                     &                + 0.2  * TANH( (gdept_n(ji,jj,jk) - 35.  ) / 100. )       &
+                     &                + 0.2  * TANH( (gdept_n(ji,jj,jk) - 1000.) / 5000.)    )  &
+                     &              * (-TANH((gdept_n(ji,jj,jk) - 500) / 150) + 1) / 2 
                   tsn(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
                   tsb(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal)
@@ -457,15 +424,13 @@
       !!                 p=integral [ rau*g dz ]
       !!----------------------------------------------------------------------
-      USE dynspg          ! surface pressure gradient             (dyn_spg routine)
-      USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine)
+      USE divhor          ! hor. divergence                       (div_hor routine)
       USE lbclnk          ! ocean lateral boundary condition (or mpp link)
       !
       INTEGER ::   ji, jj, jk        ! dummy loop indices
-      INTEGER ::   indic             ! ???
       REAL(wp) ::   zmsv, zphv, zmsu, zphu, zalfg     ! temporary scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zprn
       !!----------------------------------------------------------------------
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zprn)
+      CALL wrk_alloc( jpi,jpj,jpk,   zprn)
       !
       IF(lwp) WRITE(numout,*) 
@@ -478,9 +443,9 @@
       zalfg = 0.5 * grav * rau0
       
-      zprn(:,:,1) = zalfg * fse3w(:,:,1) * ( 1 + rhd(:,:,1) )       ! Surface value
+      zprn(:,:,1) = zalfg * e3w_n(:,:,1) * ( 1 + rhd(:,:,1) )       ! Surface value
 
       DO jk = 2, jpkm1                                              ! Vertical integration from the surface
          zprn(:,:,jk) = zprn(:,:,jk-1)   &
-            &         + zalfg * fse3w(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) )
+            &         + zalfg * e3w_n(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) )
       END DO  
 
@@ -529,40 +494,10 @@
       vb(:,:,:) = vn(:,:,:)
       
-      ! WARNING !!!!!
-      ! after initializing u and v, we need to calculate the initial streamfunction bsf.
-      ! Otherwise, only the trend will be computed and the model will blow up (inconsistency).
-      ! to do that, we call dyn_spg with a special trick:
-      ! we fill ua and va with the velocities divided by dt, and the streamfunction will be brought to the
-      ! right value assuming the velocities have been set up in one time step.
-      ! we then set bsfd to zero (first guess for next step is d(psi)/dt = 0.)
-      !  sets up s false trend to calculate the barotropic streamfunction.
-
-      ua(:,:,:) = ub(:,:,:) / rdt
-      va(:,:,:) = vb(:,:,:) / rdt
-
-      ! calls dyn_spg. we assume euler time step, starting from rest.
-      indic = 0
-      CALL dyn_spg( nit000, indic )       ! surface pressure gradient
-
-      ! the new velocity is ua*rdt
-
-      CALL lbc_lnk( ua, 'U', -1. )
-      CALL lbc_lnk( va, 'V', -1. )
-
-      ub(:,:,:) = ua(:,:,:) * rdt
-      vb(:,:,:) = va(:,:,:) * rdt
-      ua(:,:,:) = 0.e0
-      va(:,:,:) = 0.e0
-      un(:,:,:) = ub(:,:,:)
-      vn(:,:,:) = vb(:,:,:)
-       
-      ! Compute the divergence and curl
-
-      CALL div_cur( nit000 )            ! now horizontal divergence and curl
-
-      hdivb(:,:,:) = hdivn(:,:,:)       ! set the before to the now value
-      rotb (:,:,:) = rotn (:,:,:)       ! set the before to the now value
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zprn)
+      !
+!!gm  Check  here call to div_hor should not be necessary
+!!gm         div_hor call runoffs  not sure they are defined at that level
+      CALL div_hor( nit000 )            ! now horizontal divergence
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zprn)
       !
    END SUBROUTINE istate_uvg
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 6807)
+++ 	(revision )
@@ -1,341 +1,0 @@
-MODULE divcur
-   !!==============================================================================
-   !!                       ***  MODULE  divcur  ***
-   !! Ocean diagnostic variable : horizontal divergence and relative vorticity
-   !!==============================================================================
-   !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code
-   !!            4.0  ! 1991-11  (G. Madec)
-   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions
-   !!            7.0  ! 1996-01  (G. Madec)  s-coordinates
-   !!            8.0  ! 1997-06  (G. Madec)  lateral boundary cond., lbc
-   !!            8.1  ! 1997-08  (J.M. Molines)  Open boundaries
-   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
-   !!  NEMO      1.0  ! 2002-09  (G. Madec, E. Durand)  Free form, F90
-   !!             -   ! 2005-01  (J. Chanut) Unstructured open boundaries
-   !!             -   ! 2003-08  (G. Madec)  merged of cur and div, free form, F90
-   !!             -   ! 2005-01  (J. Chanut, A. Sellar) unstructured open boundaries
-   !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
-   !!             -   ! 2010-10  (R. Furner, G. Madec) runoff and cla added directly here
-   !!            3.6  ! 2014-11  (P. Mathiot)          isf            added directly here
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   div_cur    : Compute the horizontal divergence and relative
-   !!                vorticity fields
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce, ONLY : ln_rnf, nn_isf ! surface boundary condition: ocean
-   USE sbcrnf          ! river runoff 
-   USE sbcisf          ! ice shelf 
-   USE cla             ! cross land advection             (cla_div routine)
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   div_cur    ! routine called by step.F90 and istate.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-#if defined key_noslip_accurate
-   !!----------------------------------------------------------------------
-   !!   'key_noslip_accurate'   2nd order interior + 4th order at the coast
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE div_cur( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE div_cur  ***
-      !!
-      !! ** Purpose :   compute the horizontal divergence and the relative
-      !!              vorticity at before and now time-step
-      !!
-      !! ** Method  : I.  divergence :
-      !!         - save the divergence computed at the previous time-step
-      !!      (note that the Asselin filter has not been applied on hdivb)
-      !!         - compute the now divergence given by :
-      !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
-      !!      correct hdiv with runoff inflow (div_rnf), ice shelf melting (div_isf)
-      !!      and cross land flow (div_cla) 
-      !!              II. vorticity :
-      !!         - save the curl computed at the previous time-step
-      !!            rotb = rotn
-      !!      (note that the Asselin time filter has not been applied to rotb)
-      !!         - compute the now curl in tensorial formalism:
-      !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] )
-      !!         - Coastal boundary condition: 'key_noslip_accurate' defined,
-      !!      the no-slip boundary condition is computed using Schchepetkin
-      !!      and O'Brien (1996) scheme (i.e. 4th order at the coast).
-      !!      For example, along east coast, the one-sided finite difference
-      !!      approximation used for di[v] is:
-      !!         di[e2v vn] =  1/(e1f*e2f) * ( (e2v vn)(i) + (e2v vn)(i-1) + (e2v vn)(i-2) )
-      !!
-      !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence
-      !!              - update rotb , rotn , the before & now rel. vorticity
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !
-      INTEGER ::   ji, jj, jk, jl           ! dummy loop indices
-      INTEGER ::   ii, ij, ijt, iju, ierr   ! local integer
-      REAL(wp) ::  zraur, zdep              ! local scalar
-      REAL(wp), POINTER,  DIMENSION(:,:) ::   zwu   ! specific 2D workspace
-      REAL(wp), POINTER,  DIMENSION(:,:) ::   zwv   ! specific 2D workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('div_cur')
-      !
-      CALL wrk_alloc( jpi  , jpj+2, zwu               )
-      CALL wrk_alloc( jpi+4, jpj  , zwv, kistart = -1 )
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'div_cur : horizontal velocity divergence and relative vorticity'
-         IF(lwp) WRITE(numout,*) '~~~~~~~   NOT optimal for auto-tasking case'
-      ENDIF
-
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !
-         hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays
-         rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays
-         !
-         !                                             ! --------
-         ! Horizontal divergence                       !   div
-         !                                             ! --------
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               hdivn(ji,jj,jk) =   &
-                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)       &
-                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)  )    &
-                  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO
-         END DO
-
-         IF( .NOT. AGRIF_Root() ) THEN
-            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east
-            IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west
-            IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north
-            IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south
-         ENDIF
-
-         !                                             ! --------
-         ! relative vorticity                          !   rot 
-         !                                             ! --------
-         ! contravariant velocity (extended for lateral b.c.)
-         ! inside the model domain
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zwu(ji,jj) = e1u(ji,jj) * un(ji,jj,jk)
-               zwv(ji,jj) = e2v(ji,jj) * vn(ji,jj,jk)
-            END DO  
-         END DO  
- 
-         ! East-West boundary conditions
-         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
-            zwv(  0  ,:) = zwv(jpi-2,:)
-            zwv( -1  ,:) = zwv(jpi-3,:)
-            zwv(jpi+1,:) = zwv(  3  ,:)
-            zwv(jpi+2,:) = zwv(  4  ,:)
-         ELSE
-            zwv(  0  ,:) = 0.e0
-            zwv( -1  ,:) = 0.e0
-            zwv(jpi+1,:) = 0.e0
-            zwv(jpi+2,:) = 0.e0
-         ENDIF
-
-         ! North-South boundary conditions
-         IF( nperio == 3 .OR. nperio == 4 ) THEN
-            ! north fold ( Grid defined with a T-point pivot) ORCA 2 degre
-            zwu(jpi,jpj+1) = 0.e0
-            zwu(jpi,jpj+2) = 0.e0
-            DO ji = 1, jpi-1
-               iju = jpi - ji + 1
-               zwu(ji,jpj+1) = - zwu(iju,jpj-3)
-               zwu(ji,jpj+2) = - zwu(iju,jpj-4)
-            END DO
-         ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN
-            ! north fold ( Grid defined with a F-point pivot) ORCA 0.5 degre\
-            zwu(jpi,jpj+1) = 0.e0
-            zwu(jpi,jpj+2) = 0.e0
-            DO ji = 1, jpi-1
-               iju = jpi - ji
-               zwu(ji,jpj  ) = - zwu(iju,jpj-1)
-               zwu(ji,jpj+1) = - zwu(iju,jpj-2)
-               zwu(ji,jpj+2) = - zwu(iju,jpj-3)
-            END DO
-            DO ji = -1, jpi+2
-               ijt = jpi - ji + 1
-               zwv(ji,jpj) = - zwv(ijt,jpj-2)
-            END DO
-            DO ji = jpi/2+1, jpi+2
-               ijt = jpi - ji + 1
-               zwv(ji,jpjm1) = - zwv(ijt,jpjm1)
-            END DO
-         ELSE
-            ! closed
-            zwu(:,jpj+1) = 0.e0
-            zwu(:,jpj+2) = 0.e0
-         ENDIF
-
-         ! relative vorticity (vertical component of the velocity curl) 
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               rotn(ji,jj,jk) = (  zwv(ji+1,jj  ) - zwv(ji,jj)      &
-                  &              - zwu(ji  ,jj+1) + zwu(ji,jj)  ) * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) )
-            END DO
-         END DO
-
-         ! second order accurate scheme along straight coast
-         DO jl = 1, npcoa(1,jk)
-            ii = nicoa(jl,1,jk)
-            ij = njcoa(jl,1,jk)
-            rotn(ii,ij,jk) = 1. / ( e1f(ii,ij) * e2f(ii,ij) )   &
-                           * ( + 4. * zwv(ii+1,ij) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) )
-         END DO
-         DO jl = 1, npcoa(2,jk)
-            ii = nicoa(jl,2,jk)
-            ij = njcoa(jl,2,jk)
-            rotn(ii,ij,jk) = 1./(e1f(ii,ij)*e2f(ii,ij))   &
-               *(-4.*zwv(ii,ij)+zwv(ii-1,ij)-0.2*zwv(ii-2,ij))
-         END DO
-         DO jl = 1, npcoa(3,jk)
-            ii = nicoa(jl,3,jk)
-            ij = njcoa(jl,3,jk)
-            rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   &
-               * ( +4. * zwu(ii,ij+1) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) )
-         END DO
-         DO jl = 1, npcoa(4,jk)
-            ii = nicoa(jl,4,jk)
-            ij = njcoa(jl,4,jk)
-            rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   &
-               * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) )
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs   (update hdivn field)
-      IF( ln_divisf .AND. (nn_isf /= 0) )   CALL sbc_isf_div( hdivn )          ! ice shelf (update hdivn field)
-      IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (Update Hor. divergence)
-      
-      ! 4. Lateral boundary conditions on hdivn and rotn
-      ! ---------------------------------=======---======
-      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+4, jpj  , zwv, kistart = -1 )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('div_cur')
-      !
-   END SUBROUTINE div_cur
-   
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                           2nd order centered schemes
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE div_cur( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE div_cur  ***
-      !!                    
-      !! ** Purpose :   compute the horizontal divergence and the relative
-      !!      vorticity at before and now time-step
-      !!
-      !! ** Method  : - Divergence:
-      !!      - save the divergence computed at the previous time-step
-      !!      (note that the Asselin filter has not been applied on hdivb)
-      !!      - compute the now divergence given by :
-      !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
-      !!      correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla) 
-      !!              - Relavtive Vorticity :
-      !!      - save the curl computed at the previous time-step (rotb = rotn)
-      !!      (note that the Asselin time filter has not been applied to rotb)
-      !!      - compute the now curl in tensorial formalism:
-      !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] )
-      !!      Note: Coastal boundary condition: lateral friction set through
-      !!      the value of fmask along the coast (see dommsk.F90) and shlat
-      !!      (namelist parameter)
-      !!
-      !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence
-      !!              - update rotb , rotn , the before & now rel. vorticity
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj, jk    ! dummy loop indices
-      REAL(wp) ::   zraur, zdep   ! local scalars
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('div_cur')
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'div_cur : horizontal velocity divergence and'
-         IF(lwp) WRITE(numout,*) '~~~~~~~   relative vorticity'
-      ENDIF
-
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !
-         hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays
-         rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays
-         !
-         !                                             ! --------
-         ! Horizontal divergence                       !   div 
-         !                                             ! --------
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               hdivn(ji,jj,jk) =   &
-                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)       &
-                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)  )    &
-                  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO  
-         END DO  
-
-         IF( .NOT. AGRIF_Root() ) THEN
-            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east
-            IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west
-            IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north
-            IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south
-         ENDIF
-
-         !                                             ! --------
-         ! relative vorticity                          !   rot 
-         !                                             ! --------
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               rotn(ji,jj,jk) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
-                  &              - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) &
-                  &           * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj) )
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )                            ! runoffs (update hdivn field)
-      IF( ln_divisf .AND. (nn_isf .GT. 0) )   CALL sbc_isf_div( hdivn )          ! ice shelf (update hdivn field)
-      IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field)
-      !
-      CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )     ! lateral boundary cond. (no sign change)
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('div_cur')
-      !
-   END SUBROUTINE div_cur
-   
-#endif
-   !!======================================================================
-END MODULE divcur
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90	(revision 6808)
@@ -0,0 +1,105 @@
+MODULE divhor
+   !!==============================================================================
+   !!                       ***  MODULE  divhor  ***
+   !! Ocean diagnostic variable : now horizontal divergence
+   !!==============================================================================
+   !! History :  1.0  ! 2002-09  (G. Madec, E. Durand)  Free form, F90
+   !!             -   ! 2005-01  (J. Chanut) Unstructured open boundaries
+   !!             -   ! 2003-08  (G. Madec)  merged of cur and div, free form, F90
+   !!             -   ! 2005-01  (J. Chanut, A. Sellar) unstructured open boundaries
+   !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
+   !!             -   ! 2010-10  (R. Furner, G. Madec) runoff and cla added directly here
+   !!            3.7  ! 2014-01  (G. Madec) suppression of velocity curl from in-core memory
+   !!             -   ! 2014-12  (G. Madec) suppression of cross land advection option
+   !!             -   ! 2015-10  (G. Madec) add velocity and rnf flag in argument of div_hor
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   div_hor    : Compute the horizontal divergence field
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce, ONLY : ln_rnf, ln_isf ! surface boundary condition: ocean
+   USE sbcrnf          ! river runoff 
+   USE sbcisf          ! ice shelf
+   USE iscplhsb        ! ice sheet / ocean coupling
+   USE iscplini        ! ice sheet / ocean coupling
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   div_hor    ! routine called by step.F90 and istate.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE div_hor( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE div_hor  ***
+      !!                    
+      !! ** Purpose :   compute the horizontal divergence at now time-step
+      !!
+      !! ** Method  :   the now divergence is computed as :
+      !!         hdivn = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
+      !!      and correct with runoff inflow (div_rnf) and cross land flow (div_cla) 
+      !!
+      !! ** Action  : - update hdivn, the now horizontal divergence
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp) ::   zraur, zdep   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('div_hor')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence '
+         IF(lwp) WRITE(numout,*) '~~~~~~~   '
+      ENDIF
+      !
+      DO jk = 1, jpkm1                                      !==  Horizontal divergence  ==!
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               hdivn(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * un(ji  ,jj,jk)        &
+                  &               - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * un(ji-1,jj,jk)        &
+                  &               + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vn(ji,jj  ,jk)        &
+                  &               - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk)   )    &
+                  &            / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
+            END DO  
+         END DO  
+         IF( .NOT. AGRIF_Root() ) THEN
+            IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn(nlci-1,   :  ,jk) = 0._wp      ! east
+            IF( nbondi == -1 .OR. nbondi == 2 )   hdivn(  2   ,   :  ,jk) = 0._wp      ! west
+            IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn(  :   ,nlcj-1,jk) = 0._wp      ! north
+            IF( nbondj == -1 .OR. nbondj == 2 )   hdivn(  :   ,  2   ,jk) = 0._wp      ! south
+         ENDIF
+      END DO
+      !
+      IF( ln_rnf )   CALL sbc_rnf_div( hdivn )      !==  runoffs    ==!   (update hdivn field)
+      !
+      IF( ln_isf )   CALL sbc_isf_div( hdivn )      !==  ice shelf  ==!   (update hdivn field)
+      !
+      IF( ln_iscpl .AND. ln_hsb ) CALL iscpl_div( hdivn )  !==  ice sheet  ==!   (update hdivn field)
+      !
+      CALL lbc_lnk( hdivn, 'T', 1. )                !==  lateral boundary cond.  ==!   (no sign change)
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('div_hor')
+      !
+   END SUBROUTINE div_hor
+   
+   !!======================================================================
+END MODULE divhor
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 6808)
@@ -39,5 +39,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -76,10 +75,4 @@
       CASE ( 3 )   
                       CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme
-      !
-      CASE (-1 )                                            ! esopa: test all possibility with control print
-                      CALL dyn_keg     ( kt, nn_dynkeg )
-                      CALL dyn_zad     ( kt )
-                      CALL dyn_adv_cen2( kt )
-                      CALL dyn_adv_ubs ( kt )
       END SELECT
       !
@@ -104,5 +97,5 @@
       READ  ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp )
-
+      !
       REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme
       READ  ( numnam_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 )
@@ -126,5 +119,4 @@
       IF( ln_dynadv_cen2 )   ioptio = ioptio + 1
       IF( ln_dynadv_ubs  )   ioptio = ioptio + 1
-      IF( lk_esopa       )   ioptio =          1
 
       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' )
@@ -139,5 +131,4 @@
       IF( ln_dynadv_cen2 )   nadv =  2
       IF( ln_dynadv_ubs  )   nadv =  3
-      IF( lk_esopa       )   nadv = -1
 
       IF(lwp) THEN                    ! Print the choice
@@ -151,5 +142,4 @@
          IF( nadv ==  2 )   WRITE(numout,*) '         flux form   : 2nd order scheme is used'
          IF( nadv ==  3 )   WRITE(numout,*) '         flux form   : UBS       scheme is used'
-         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection formulation'
       ENDIF
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 6808)
@@ -10,6 +10,5 @@
 
    !!----------------------------------------------------------------------
-   !!   dyn_adv_cen2       : flux form momentum advection (ln_dynadv_cen2=T)
-   !!                        trends using a 2nd order centred scheme  
+   !!   dyn_adv_cen2  : flux form momentum advection (ln_dynadv_cen2=T) using a 2nd order centred scheme  
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers
@@ -30,5 +29,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -53,5 +51,4 @@
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zbu, zbv     ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu, zfv
@@ -60,5 +57,5 @@
       IF( nn_timing == 1 )  CALL timing_start('dyn_adv_cen2')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )
+      CALL wrk_alloc( jpi,jpj,jpk,   zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )
       !
       IF( kt == nit000 .AND. lwp ) THEN
@@ -68,38 +65,33 @@
       ENDIF
       !
-      IF( l_trddyn ) THEN           ! Save ua and va trends
+      IF( l_trddyn ) THEN           ! trends: store the input trends
          zfu_uw(:,:,:) = ua(:,:,:)
          zfv_vw(:,:,:) = va(:,:,:)
       ENDIF
-
-      !                                      ! ====================== !
-      !                                      !  Horizontal advection  !
-      DO jk = 1, jpkm1                       ! ====================== !
-         !                                         ! horizontal volume fluxes
-         zfu(:,:,jk) = 0.25 * e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
-         zfv(:,:,jk) = 0.25 * e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
-         !
-         DO jj = 1, jpjm1                          ! horizontal momentum fluxes at T- and F-point
+      !
+      !                             !==  Horizontal advection  ==!
+      !
+      DO jk = 1, jpkm1                    ! horizontal transport
+         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
+         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
+         DO jj = 1, jpjm1                 ! horizontal momentum fluxes (at T- and F-point)
             DO ji = 1, fs_jpim1   ! vector opt.
-               zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj  ,jk) ) * ( un(ji,jj,jk) + un(ji+1,jj  ,jk) )
-               zfv_f(ji  ,jj  ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj  ,jk) ) * ( un(ji,jj,jk) + un(ji  ,jj+1,jk) )
-               zfu_f(ji  ,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji  ,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji+1,jj  ,jk) )
-               zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji  ,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) )
+               zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji+1,jj  ,jk) )
+               zfv_f(ji  ,jj  ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji  ,jj+1,jk) )
+               zfu_f(ji  ,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji+1,jj  ,jk) )
+               zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) )
             END DO
          END DO
-         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes
+         DO jj = 2, jpjm1                 ! divergence of horizontal momentum fluxes
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
-               !
-               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj  ,jk) - zfu_t(ji  ,jj  ,jk)    &
-                  &                           + zfv_f(ji  ,jj  ,jk) - zfv_f(ji  ,jj-1,jk)  ) / zbu
-               va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji  ,jj  ,jk) - zfu_f(ji-1,jj  ,jk)    &
-                  &                           + zfv_t(ji  ,jj+1,jk) - zfv_t(ji  ,jj  ,jk)  ) / zbv
+               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    &
+                  &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    &
+                  &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
             END DO
          END DO
       END DO
       !
-      IF( l_trddyn ) THEN                          ! save the horizontal advection trend for diagnostic
+      IF( l_trddyn ) THEN           ! trends: send trend to trddyn for diagnostic
          zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:)
          zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:)
@@ -109,52 +101,48 @@
       ENDIF
       !
-
-      !                                      ! ==================== !
-      !                                      !  Vertical advection  !
-      DO jk = 1, jpkm1                       ! ==================== !
-         !                                         ! Vertical volume fluxesÊ
-         zfw(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk)
-         !
-         IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes                   
-            zfu_uw(:,:,jpk) = 0.e0                      ! Bottom  value : flux set to zero
-            zfv_vw(:,:,jpk) = 0.e0
-            !                                           ! Surface value :
-            IF( lk_vvl ) THEN                                ! variable volume : flux set to zero
-               zfu_uw(:,:, 1 ) = 0.e0    
-               zfv_vw(:,:, 1 ) = 0.e0
-            ELSE                                             ! constant volume : advection through the surface
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zfu_uw(ji,jj, 1 ) = 2.e0 * ( zfw(ji,jj,1) + zfw(ji+1,jj  ,1) ) * un(ji,jj,1)
-                     zfv_vw(ji,jj, 1 ) = 2.e0 * ( zfw(ji,jj,1) + zfw(ji  ,jj+1,1) ) * vn(ji,jj,1)
-                  END DO
-               END DO
-            ENDIF
-         ELSE                                      ! interior fluxes
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj  ,jk) ) * ( un(ji,jj,jk) + un(ji,jj,jk-1) )
-                  zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji  ,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji,jj,jk-1) )
-               END DO
+      !                             !==  Vertical advection  ==!
+      !
+      DO jj = 2, jpjm1                    ! surface/bottom advective fluxes set to zero
+         DO ji = fs_2, fs_jpim1
+            zfu_uw(ji,jj,jpk) = 0._wp   ;   zfv_vw(jj,jj,jpk) = 0._wp
+            zfu_uw(ji,jj, 1 ) = 0._wp   ;   zfv_vw(jj,jj, 1 ) = 0._wp
+         END DO
+      END DO
+      IF( ln_linssh ) THEN                ! linear free surface: advection through the surface
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji+1,jj) * wn(ji+1,jj,1) ) * un(ji,jj,1)
+               zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji,jj+1) * wn(ji,jj+1,1) ) * vn(ji,jj,1)
             END DO
-         ENDIF
+         END DO
+      ENDIF
+      DO jk = 2, jpkm1                    ! interior advective fluxes
+         DO jj = 2, jpjm1                       ! 1/4 * Vertical transport
+            DO ji = fs_2, fs_jpim1
+               zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
+            END DO
+         END DO
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj  ,jk) ) * ( un(ji,jj,jk) + un(ji,jj,jk-1) )
+               zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji  ,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji,jj,jk-1) )
+            END DO
+         END DO
       END DO
-      DO jk = 1, jpkm1                             ! divergence of vertical momentum flux divergence
+      DO jk = 1, jpkm1                    ! divergence of vertical momentum flux divergence
          DO jj = 2, jpjm1 
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) )    &
-                  &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
-               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    &
-                  &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
             END DO
          END DO
       END DO
       !
-      IF( l_trddyn ) THEN                          ! save the vertical advection trend for diagnostic
+      IF( l_trddyn ) THEN                 ! trends: send trend to trddyn for diagnostic
          zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:)
          zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:)
          CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt )
       ENDIF
-      !                                            ! Control print
+      !                                   ! Control print
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' cen2 adv - Ua: ', mask1=umask,   &
          &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 6808)
@@ -35,5 +35,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -71,9 +70,8 @@
       !! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling. 
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt     ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj, jk            ! dummy loop indices
-      REAL(wp) ::   zbu, zbv    ! temporary scalars
-      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! temporary scalars
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:  ) ::  zfu, zfv
       REAL(wp), POINTER, DIMENSION(:,:,:  ) ::  zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw
@@ -83,6 +81,6 @@
       IF( nn_timing == 1 )  CALL timing_start('dyn_adv_ubs')
       !
-      CALL wrk_alloc( jpi, jpj, jpk,       zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )
-      CALL wrk_alloc( jpi, jpj, jpk, jpts, zlu_uu, zlv_vv, zlu_uv, zlv_vu                               )
+      CALL wrk_alloc( jpi,jpj,jpk,        zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )
+      CALL wrk_alloc( jpi,jpj,jpk,jpts,   zlu_uu, zlv_vv, zlu_uv, zlv_vu                               )
       !
       IF( kt == nit000 ) THEN
@@ -101,20 +99,18 @@
       zlu_uv(:,:,:,:) = 0._wp 
       zlv_vu(:,:,:,:) = 0._wp 
-
-      IF( l_trddyn ) THEN           ! Save ua and va trends
+      !
+      IF( l_trddyn ) THEN           ! trends: store the input trends
          zfu_uw(:,:,:) = ua(:,:,:)
          zfv_vw(:,:,:) = va(:,:,:)
       ENDIF
-
       !                                      ! =========================== !
       DO jk = 1, jpkm1                       !  Laplacian of the velocity  !
          !                                   ! =========================== !
          !                                         ! horizontal volume fluxes
-         zfu(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
-         zfv(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         zfu(:,:,jk) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
+         zfv(:,:,jk) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
          !            
          DO jj = 2, jpjm1                          ! laplacian
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               !
                zlu_uu(ji,jj,jk,1) = ( ub (ji+1,jj  ,jk) - 2.*ub (ji,jj,jk) + ub (ji-1,jj  ,jk) ) * umask(ji,jj,jk)
                zlv_vv(ji,jj,jk,1) = ( vb (ji  ,jj+1,jk) - 2.*vb (ji,jj,jk) + vb (ji  ,jj-1,jk) ) * vmask(ji,jj,jk)
@@ -137,11 +133,11 @@
       CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', 1. )   ;   CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', 1. )
       CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', 1. )   ;   CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', 1. ) 
-      
+      !
       !                                      ! ====================== !
       !                                      !  Horizontal advection  !
       DO jk = 1, jpkm1                       ! ====================== !
          !                                         ! horizontal volume fluxes
-         zfu(:,:,jk) = 0.25 * e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
-         zfv(:,:,jk) = 0.25 * e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
+         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
          !
          DO jj = 1, jpjm1                          ! horizontal momentum fluxes at T- and F-point
@@ -150,9 +146,9 @@
                zvj = ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) )
                !
-               IF (zui > 0) THEN   ;   zl_u = zlu_uu(ji  ,jj,jk,1)
-               ELSE                ;   zl_u = zlu_uu(ji+1,jj,jk,1)
-               ENDIF
-               IF (zvj > 0) THEN   ;   zl_v = zlv_vv(ji,jj  ,jk,1)
-               ELSE                ;   zl_v = zlv_vv(ji,jj+1,jk,1)
+               IF( zui > 0 ) THEN   ;   zl_u = zlu_uu(ji  ,jj,jk,1)
+               ELSE                 ;   zl_u = zlu_uu(ji+1,jj,jk,1)
+               ENDIF
+               IF( zvj > 0 ) THEN   ;   zl_v = zlv_vv(ji,jj  ,jk,1)
+               ELSE                 ;   zl_v = zlv_vv(ji,jj+1,jk,1)
                ENDIF
                !
@@ -166,9 +162,9 @@
                zfuj = ( zfu(ji,jj,jk) + zfu(ji  ,jj+1,jk) )
                zfvi = ( zfv(ji,jj,jk) + zfv(ji+1,jj  ,jk) )
-               IF (zfuj > 0) THEN   ;    zl_v = zlv_vu( ji  ,jj  ,jk,1)
-               ELSE                 ;    zl_v = zlv_vu( ji+1,jj,jk,1)
-               ENDIF
-               IF (zfvi > 0) THEN   ;    zl_u = zlu_uv( ji,jj  ,jk,1)
-               ELSE                 ;    zl_u = zlu_uv( ji,jj+1,jk,1)
+               IF( zfuj > 0 ) THEN   ;    zl_v = zlv_vu( ji  ,jj  ,jk,1)
+               ELSE                  ;    zl_v = zlv_vu( ji+1,jj,jk,1)
+               ENDIF
+               IF( zfvi > 0 ) THEN   ;    zl_u = zlu_uv( ji,jj  ,jk,1)
+               ELSE                  ;    zl_u = zlu_uv( ji,jj+1,jk,1)
                ENDIF
                !
@@ -181,15 +177,12 @@
          DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
-               !
-               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj  ,jk) - zfu_t(ji  ,jj  ,jk)    &
-                  &                           + zfv_f(ji  ,jj  ,jk) - zfv_f(ji  ,jj-1,jk)  ) / zbu
-               va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji  ,jj  ,jk) - zfu_f(ji-1,jj  ,jk)    &
-                  &                           + zfv_t(ji  ,jj+1,jk) - zfv_t(ji  ,jj  ,jk)  ) / zbv
-            END DO
-         END DO
-      END DO
-      IF( l_trddyn ) THEN                          ! save the horizontal advection trend for diagnostic
+               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    &
+                  &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    &
+                  &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      IF( l_trddyn ) THEN                          ! trends: send trends to trddyn for diagnostic
          zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:)
          zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:)
@@ -198,57 +191,56 @@
          zfv_t(:,:,:) = va(:,:,:)
       ENDIF
-
       !                                      ! ==================== !
       !                                      !  Vertical advection  !
-      DO jk = 1, jpkm1                       ! ==================== !
-         !                                         ! Vertical volume fluxesÊ
-         zfw(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk)
-         !
-         IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes                   
-            zfu_uw(:,:,jpk) = 0.e0                      ! Bottom  value : flux set to zero
-            zfv_vw(:,:,jpk) = 0.e0
-            !                                           ! Surface value :
-            IF( lk_vvl ) THEN                                ! variable volume : flux set to zero
-               zfu_uw(:,:, 1 ) = 0.e0    
-               zfv_vw(:,:, 1 ) = 0.e0
-            ELSE                                             ! constant volume : advection through the surface
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zfu_uw(ji,jj, 1 ) = 2.e0 * ( zfw(ji,jj,1) + zfw(ji+1,jj  ,1) ) * un(ji,jj,1)
-                     zfv_vw(ji,jj, 1 ) = 2.e0 * ( zfw(ji,jj,1) + zfw(ji  ,jj+1,1) ) * vn(ji,jj,1)
-                  END DO
-               END DO
-            ENDIF
-         ELSE                                      ! interior fluxes
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj  ,jk) ) * ( un(ji,jj,jk) + un(ji,jj,jk-1) )
-                  zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji  ,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji,jj,jk-1) )
-               END DO
-            END DO
-         ENDIF
-      END DO
-      DO jk = 1, jpkm1                             ! divergence of vertical momentum flux divergence
-         DO jj = 2, jpjm1 
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) )    &
-                  &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
-               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    &
-                  &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
-            END DO
-         END DO
-      END DO
-      !
-      IF( l_trddyn ) THEN                          ! save the vertical advection trend for diagnostic
+      !                                      ! ==================== !
+      DO jj = 2, jpjm1                             ! surface/bottom advective fluxes set to zero                  
+         DO ji = fs_2, fs_jpim1
+            zfu_uw(ji,jj,jpk) = 0._wp
+            zfv_vw(ji,jj,jpk) = 0._wp
+            zfu_uw(ji,jj, 1 ) = 0._wp
+            zfv_vw(ji,jj, 1 ) = 0._wp
+         END DO
+      END DO
+      IF( ln_linssh ) THEN                         ! constant volume : advection through the surface
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji+1,jj) * wn(ji+1,jj,1) ) * un(ji,jj,1)
+               zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji,jj+1) * wn(ji,jj+1,1) ) * vn(ji,jj,1)
+            END DO
+         END DO
+      ENDIF
+      DO jk = 2, jpkm1                          ! interior fluxes
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
+            END DO
+         END DO
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji,jj,jk-1) )
+               zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji,jj,jk-1) )
+            END DO
+         END DO
+      END DO
+      DO jk = 1, jpkm1                          ! divergence of vertical momentum flux divergence
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      IF( l_trddyn ) THEN                       ! save the vertical advection trend for diagnostic
          zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:)
          zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:)
          CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt )
       ENDIF
-      !                                            ! Control print
+      !                                         ! Control print
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ubs2 adv - Ua: ', mask1=umask,   &
          &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
-      CALL wrk_dealloc( jpi, jpj, jpk,       zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )
-      CALL wrk_dealloc( jpi, jpj, jpk, jpts, zlu_uu, zlv_vv, zlu_uv, zlv_vu                               )
+      CALL wrk_dealloc( jpi,jpj,jpk,        zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )
+      CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zlu_uu, zlv_vv, zlu_uv, zlv_vu                               )
       !
       IF( nn_timing == 1 )  CALL timing_stop('dyn_adv_ubs')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 6808)
@@ -29,6 +29,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -65,6 +63,6 @@
         zm1_2dt = - 1._wp / ( 2._wp * rdt )
 
-        IF( l_trddyn )   THEN                      ! temporary save of ua and va trends
-           CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )
+        IF( l_trddyn ) THEN      ! trends: store the input trends
+           CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )
            ztrdu(:,:,:) = ua(:,:,:)
            ztrdv(:,:,:) = va(:,:,:)
@@ -78,10 +76,10 @@
               !
               ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
-              ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  bfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu)
-              va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  bfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv)
+              ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  bfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu)
+              va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  bfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv)
            END DO
         END DO
-        
-        IF ( ln_isfcav ) THEN
+        !
+        IF( ln_isfcav ) THEN        ! ocean cavities
            DO jj = 2, jpjm1
               DO ji = 2, jpim1
@@ -91,7 +89,7 @@
                  !
                  ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
-                 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  tfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu) &
+                 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  tfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu) &
                     &             * (1.-umask(ji,jj,1))
-                 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  tfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv) &
+                 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  tfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv) &
                     &             * (1.-vmask(ji,jj,1))
                  ! (ISF)
@@ -99,11 +97,10 @@
            END DO
         END IF
-
         !
-        IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics
+        IF( l_trddyn ) THEN      ! trends: send trends to trddyn for further diagnostics
            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
            CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt )
-           CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )
+           CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )
         ENDIF
         !                                          ! print mean trends (used for debugging)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 6808)
@@ -33,7 +33,9 @@
    USE sbc_oce         ! surface variable (only for the flag with ice shelf)
    USE dom_oce         ! ocean space and time domain
+   USE wet_dry         ! wetting and drying
    USE phycst          ! physical constants
    USE trd_oce         ! trends: ocean variables
    USE trddyn          ! trend manager: dynamics
+!jc   USE zpshde          ! partial step: hor. derivative     (zps_hde routine)
    !
    USE in_out_manager  ! I/O manager
@@ -44,4 +46,5 @@
    USE wrk_nemo        ! Memory Allocation
    USE timing          ! Timing
+   USE iom
 
    IMPLICIT NONE
@@ -51,17 +54,15 @@
    PUBLIC   dyn_hpg_init   ! routine called by opa module
 
-   !                                    !!* Namelist namdyn_hpg : hydrostatic pressure gradient
-   LOGICAL , PUBLIC ::   ln_hpg_zco      !: z-coordinate - full steps
-   LOGICAL , PUBLIC ::   ln_hpg_zps      !: z-coordinate - partial steps (interpolation)
-   LOGICAL , PUBLIC ::   ln_hpg_sco      !: s-coordinate (standard jacobian formulation)
-   LOGICAL , PUBLIC ::   ln_hpg_djc      !: s-coordinate (Density Jacobian with Cubic polynomial)
-   LOGICAL , PUBLIC ::   ln_hpg_prj      !: s-coordinate (Pressure Jacobian scheme)
-   LOGICAL , PUBLIC ::   ln_hpg_isf      !: s-coordinate similar to sco modify for isf
-   LOGICAL , PUBLIC ::   ln_dynhpg_imp   !: semi-implicite hpg flag
+   !                                 !!* Namelist namdyn_hpg : hydrostatic pressure gradient
+   LOGICAL , PUBLIC ::   ln_hpg_zco   !: z-coordinate - full steps
+   LOGICAL , PUBLIC ::   ln_hpg_zps   !: z-coordinate - partial steps (interpolation)
+   LOGICAL , PUBLIC ::   ln_hpg_sco   !: s-coordinate (standard jacobian formulation)
+   LOGICAL , PUBLIC ::   ln_hpg_djc   !: s-coordinate (Density Jacobian with Cubic polynomial)
+   LOGICAL , PUBLIC ::   ln_hpg_prj   !: s-coordinate (Pressure Jacobian scheme)
+   LOGICAL , PUBLIC ::   ln_hpg_isf   !: s-coordinate similar to sco modify for isf
 
    INTEGER , PUBLIC ::   nhpg  =  0   ! = 0 to 7, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) (PUBLIC for TAM)
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -131,15 +132,21 @@
       INTEGER ::   ios             ! Local integer output status for namelist read
       !!
+      INTEGER  ::   ji, jj, jk, ikt    ! dummy loop indices      ISF
+      REAL(wp) ::   znad
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztstop, zrhd ! hypothesys on isf density
+      REAL(wp), POINTER, DIMENSION(:,:)     ::  zrhdtop_isf  ! density at bottom of ISF
+      REAL(wp), POINTER, DIMENSION(:,:)     ::  ziceload     ! density at bottom of ISF
+      !!
       NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco,     &
-         &                 ln_hpg_djc, ln_hpg_prj, ln_hpg_isf, ln_dynhpg_imp
+         &                 ln_hpg_djc, ln_hpg_prj, ln_hpg_isf
       !!----------------------------------------------------------------------
       !
       REWIND( numnam_ref )              ! Namelist namdyn_hpg in reference namelist : Hydrostatic pressure gradient
       READ  ( numnam_ref, namdyn_hpg, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist', lwp )
-
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist', lwp )
+      !
       REWIND( numnam_cfg )              ! Namelist namdyn_hpg in configuration namelist : Hydrostatic pressure gradient
       READ  ( numnam_cfg, namdyn_hpg, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namdyn_hpg )
       !
@@ -155,5 +162,4 @@
          WRITE(numout,*) '      s-coord. (Density Jacobian: Cubic polynomial)     ln_hpg_djc    = ', ln_hpg_djc
          WRITE(numout,*) '      s-coord. (Pressure Jacobian: Cubic polynomial)    ln_hpg_prj    = ', ln_hpg_prj
-         WRITE(numout,*) '      time stepping: centered (F) or semi-implicit (T)  ln_dynhpg_imp = ', ln_dynhpg_imp
       ENDIF
       !
@@ -163,8 +169,8 @@
                            & either  ln_hpg_sco or  ln_hpg_prj instead')
       !
-      IF( lk_vvl .AND. .NOT. (ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) )   &
-         &   CALL ctl_stop('dyn_hpg_init : variable volume key_vvl requires:&
-                           & the standard jacobian formulation hpg_sco or &
-                           & the pressure jacobian formulation hpg_prj')
+      IF( .NOT.ln_linssh .AND. .NOT.(ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) )        &
+         &   CALL ctl_stop('dyn_hpg_init : non-linear free surface requires either ', &
+         &                 '   the standard jacobian formulation hpg_sco    or '    , &
+         &                 '   the pressure jacobian formulation hpg_prj'            )
 
       IF(       ln_hpg_isf .AND. .NOT. ln_isfcav )   &
@@ -191,6 +197,51 @@
       IF( ioptio /= 1 )   CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' )
       ! 
-      ! initialisation of ice load
-      riceload(:,:)=0.0
+      ! initialisation of ice shelf load
+      IF ( .NOT. ln_isfcav ) riceload(:,:)=0.0
+      IF (       ln_isfcav ) THEN
+         CALL wrk_alloc( jpi,jpj, 2,  ztstop) 
+         CALL wrk_alloc( jpi,jpj,jpk, zrhd  )
+         CALL wrk_alloc( jpi,jpj,     zrhdtop_isf, ziceload) 
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_isf : hydrostatic pressure gradient trend for ice shelf'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'  
+
+         ! To use density and not density anomaly
+         znad=1._wp
+         
+         ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude)
+         ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp
+
+         ! compute density of the water displaced by the ice shelf 
+         DO jk = 1, jpk
+            CALL eos(ztstop(:,:,:),gdept_n(:,:,jk),zrhd(:,:,jk))
+         END DO
+      
+         ! compute rhd at the ice/oce interface (ice shelf side)
+         CALL eos(ztstop,risfdep,zrhdtop_isf)
+
+         ! Surface value + ice shelf gradient
+         ! compute pressure due to ice shelf load (used to compute hpgi/j for all the level from 1 to miku/v)
+         ! divided by 2 later
+         ziceload = 0._wp
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ikt=mikt(ji,jj)
+               ziceload(ji,jj) = ziceload(ji,jj) + (znad + zrhd(ji,jj,1) ) * e3w_n(ji,jj,1) * (1._wp - tmask(ji,jj,1))
+               DO jk=2,ikt-1
+                  ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * e3w_n(ji,jj,jk) &
+                     &                              * (1._wp - tmask(ji,jj,jk))
+               END DO
+               IF (ikt  >=  2) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) &
+                                  &                              * ( risfdep(ji,jj) - gdept_1d(ikt-1) )
+            END DO
+         END DO
+         riceload(:,:)=ziceload(:,:)  ! need to be saved for diaar5
+
+         CALL wrk_dealloc( jpi,jpj, 2,  ztstop) 
+         CALL wrk_dealloc( jpi,jpj,jpk, zrhd  )
+         CALL wrk_dealloc( jpi,jpj,     zrhdtop_isf, ziceload) 
+      END IF
       !
    END SUBROUTINE dyn_hpg_init
@@ -214,5 +265,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
-      !!
+      !
       INTEGER  ::   ji, jj, jk       ! dummy loop indices
       REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars
@@ -220,5 +271,5 @@
       !!----------------------------------------------------------------------
       !
-      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj )
+      CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj )
       !
       IF( kt == nit000 ) THEN
@@ -233,8 +284,8 @@
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            zcoef1 = zcoef0 * fse3w(ji,jj,1)
+            zcoef1 = zcoef0 * e3w_n(ji,jj,1)
             ! hydrostatic pressure gradient
-            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) / e1u(ji,jj)
-            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) / e2v(ji,jj)
+            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
+            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj)
             ! add to the general momentum trend
             ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
@@ -248,13 +299,13 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcoef1 = zcoef0 * fse3w(ji,jj,jk)
+               zcoef1 = zcoef0 * e3w_n(ji,jj,jk)
                ! hydrostatic pressure gradient
                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
-                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )   &
-                  &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) / e1u(ji,jj)
+                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )    &
+                  &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj)
 
                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
-                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )   &
-                  &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) / e2v(ji,jj)
+                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )    &
+                  &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj)
                ! add to the general momentum trend
                ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
@@ -264,5 +315,5 @@
       END DO
       !
-      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj )
       !
    END SUBROUTINE hpg_zco
@@ -285,5 +336,5 @@
       !!----------------------------------------------------------------------
       !
-      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj )
+      CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj )
       !
       IF( kt == nit000 ) THEN
@@ -293,4 +344,6 @@
       ENDIF
 
+      ! Partial steps: bottom before horizontal gradient of t, s, rd at the last ocean level
+!jc      CALL zps_hde    ( kt, jpts, tsn, gtsu, gtsv, rhd, gru , grv )
 
       ! Local constant initialization
@@ -300,8 +353,8 @@
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            zcoef1 = zcoef0 * fse3w(ji,jj,1)
+            zcoef1 = zcoef0 * e3w_n(ji,jj,1)
             ! hydrostatic pressure gradient
-            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) / e1u(ji,jj)
-            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) / e2v(ji,jj)
+            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
+            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj)
             ! add to the general momentum trend
             ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
@@ -309,5 +362,4 @@
          END DO
       END DO
-
 
       ! interior value (2=<jk=<jpkm1)
@@ -315,13 +367,13 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcoef1 = zcoef0 * fse3w(ji,jj,jk)
+               zcoef1 = zcoef0 * e3w_n(ji,jj,jk)
                ! hydrostatic pressure gradient
                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
                   &           + zcoef1 * (  ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) )   &
-                  &                       - ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  ) / e1u(ji,jj)
+                  &                       - ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj)
 
                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
                   &           + zcoef1 * (  ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) )   &
-                  &                       - ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  ) / e2v(ji,jj)
+                  &                       - ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj)
                ! add to the general momentum trend
                ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
@@ -330,5 +382,4 @@
          END DO
       END DO
-
 
       ! partial steps correction at the last level  (use gru & grv computed in zpshde.F90)
@@ -337,10 +388,10 @@
             iku = mbku(ji,jj)
             ikv = mbkv(ji,jj)
-            zcoef2 = zcoef0 * MIN( fse3w(ji,jj,iku), fse3w(ji+1,jj  ,iku) )
-            zcoef3 = zcoef0 * MIN( fse3w(ji,jj,ikv), fse3w(ji  ,jj+1,ikv) )
+            zcoef2 = zcoef0 * MIN( e3w_n(ji,jj,iku), e3w_n(ji+1,jj  ,iku) )
+            zcoef3 = zcoef0 * MIN( e3w_n(ji,jj,ikv), e3w_n(ji  ,jj+1,ikv) )
             IF( iku > 1 ) THEN            ! on i-direction (level 2 or more)
                ua  (ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku)         ! subtract old value
                zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1)                   &   ! compute the new one
-                  &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) / e1u(ji,jj)
+                  &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) * r1_e1u(ji,jj)
                ua  (ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku)         ! add the new one to the general momentum trend
             ENDIF
@@ -348,5 +399,5 @@
                va  (ji,jj,ikv) = va(ji,jj,ikv) - zhpj(ji,jj,ikv)         ! subtract old value
                zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1)                   &   ! compute the new one
-                  &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) / e2v(ji,jj)
+                  &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) * r1_e2v(ji,jj)
                va  (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend
             ENDIF
@@ -354,7 +405,8 @@
       END DO
       !
-      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj )
       !
    END SUBROUTINE hpg_zps
+
 
    SUBROUTINE hpg_sco( kt )
@@ -378,10 +430,13 @@
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
       !!
-      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
-      REAL(wp) ::   zcoef0, zuap, zvap, znad   ! temporary scalars
+      INTEGER  ::   ji, jj, jk, jii, jjj                 ! dummy loop indices
+      REAL(wp) ::   zcoef0, zuap, zvap, znad, ztmp       ! temporary scalars
+      LOGICAL  ::   ll_tmp1, ll_tmp2, ll_tmp3            ! local logical variables
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj
+      REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy !W/D pressure filter
       !!----------------------------------------------------------------------
       !
       CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj )
+      IF(ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy )
       !
       IF( kt == nit000 ) THEN
@@ -390,11 +445,53 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OPA original scheme used'
       ENDIF
-
-      ! Local constant initialization
+      !
       zcoef0 = - grav * 0.5_wp
-      ! To use density and not density anomaly
-      IF ( lk_vvl ) THEN   ;     znad = 1._wp          ! Variable volume
-      ELSE                 ;     znad = 0._wp         ! Fixed volume
+      IF ( ln_linssh ) THEN   ;   znad = 0._wp         ! Fixed    volume: density anomaly
+      ELSE                    ;   znad = 1._wp         ! Variable volume: density
       ENDIF
+      !
+      IF(ln_wd) THEN
+        DO jj = 2, jpjm1
+           DO ji = 2, jpim1 
+             ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) 
+             ll_tmp2 = MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) > rn_wdmin1 + rn_wdmin2
+             ll_tmp3 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) + &
+                                                       & rn_wdmin1 + rn_wdmin2
+
+             IF(ll_tmp1.AND.ll_tmp2) THEN
+               zcpx(ji,jj) = 1.0_wp
+               wduflt(ji,jj) = 1.0_wp
+             ELSE IF(ll_tmp3) THEN
+               ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here
+               zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) / &
+                           &     (sshn(ji+1,jj) - sshn(ji,jj)))
+               wduflt(ji,jj) = 1.0_wp
+             ELSE
+               zcpx(ji,jj) = 0._wp
+               wduflt(ji,jj) = 0.0_wp
+             END IF
+      
+             ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) 
+             ll_tmp2 = MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) > rn_wdmin1 + rn_wdmin2
+             ll_tmp3 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) + &
+                                                       & rn_wdmin1 + rn_wdmin2
+
+             IF(ll_tmp1.AND.ll_tmp2) THEN
+               zcpy(ji,jj) = 1.0_wp
+               wdvflt(ji,jj) = 1.0_wp
+             ELSE IF(ll_tmp3) THEN
+               ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here
+               zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) / &
+                           &     (sshn(ji,jj+1) - sshn(ji,jj)))
+               wdvflt(ji,jj) = 1.0_wp
+             ELSE
+               zcpy(ji,jj) = 0._wp
+               wdvflt(ji,jj) = 0.0_wp
+             END IF
+           END DO
+        END DO
+        CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp )
+      ENDIF
+
 
       ! Surface value
@@ -402,13 +499,23 @@
          DO ji = fs_2, fs_jpim1   ! vector opt.
             ! hydrostatic pressure gradient along s-surfaces
-            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( fse3w(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )   &
-               &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) )
-            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( fse3w(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )   &
-               &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) )
+            zhpi(ji,jj,1) = zcoef0 * (  e3w_n(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )    &
+               &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e1u(ji,jj)
+            zhpj(ji,jj,1) = zcoef0 * (  e3w_n(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )    &
+               &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e2v(ji,jj)
             ! s-coordinate pressure gradient correction
-            zuap = -zcoef0 * ( rhd   (ji+1,jj,1) + rhd   (ji,jj,1) + 2._wp * znad )   &
-               &           * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj)
-            zvap = -zcoef0 * ( rhd   (ji,jj+1,1) + rhd   (ji,jj,1) + 2._wp * znad )   &
-               &           * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj)
+            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj)
+            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj)
+
+
+            IF(ln_wd) THEN
+
+              zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
+              zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
+              zuap = zuap * zcpx(ji,jj)
+              zvap = zvap * zcpy(ji,jj)
+            ENDIF
+
             ! add to the general momentum trend
             ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap
@@ -422,15 +529,23 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ! hydrostatic pressure gradient along s-surfaces
-               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   &
-                  &           * (  fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   &
-                  &              - fse3w(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  )
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   &
-                  &           * (  fse3w(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   &
-                  &              - fse3w(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  )
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)   &
+                  &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   &
+                  &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  )
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj)   &
+                  &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   &
+                  &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  )
                ! s-coordinate pressure gradient correction
-               zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( fsde3w(ji+1,jj  ,jk) - fsde3w(ji,jj,jk) ) / e1u(ji,jj)
-               zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
-                  &           * ( fsde3w(ji  ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj)
+               zuap = -zcoef0 * ( rhd    (ji+1,jj  ,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
+                  &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) * r1_e1u(ji,jj)
+               zvap = -zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
+                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj)
+
+               IF(ln_wd) THEN
+                 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
+                 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
+                 zuap = zuap * zcpx(ji,jj)
+                 zvap = zvap * zcpy(ji,jj)
+               ENDIF
+
                ! add to the general momentum trend
                ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap
@@ -441,10 +556,12 @@
       !
       CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj )
+      IF(ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )
       !
    END SUBROUTINE hpg_sco
+
 
    SUBROUTINE hpg_isf( kt )
       !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE hpg_sco  ***
+      !!                  ***  ROUTINE hpg_isf  ***
       !!
       !! ** Method  :   s-coordinate case. Jacobian scheme.
@@ -465,52 +582,26 @@
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
       !!
-      INTEGER  ::   ji, jj, jk, iku, ikv, ikt, iktp1i, iktp1j                 ! dummy loop indices
-      REAL(wp) ::   zcoef0, zuap, zvap, znad, ze3wu, ze3wv, zuapint, zvapint, zhpjint, zhpiint, zdzwt, zdzwtjp1, zdzwtip1             ! temporary scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  zhpi, zhpj, zrhd
+      INTEGER  ::   ji, jj, jk, ikt, iktp1i, iktp1j   ! dummy loop indices
+      REAL(wp) ::   zcoef0, zuap, zvap, znad          ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  zhpi, zhpj
       REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztstop
-      REAL(wp), POINTER, DIMENSION(:,:)     ::  ze3w, zp, zrhdtop_isf, zrhdtop_oce, ziceload, zdept, zpshpi, zpshpj
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi,jpj, 2, ztstop) 
-      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj, zrhd)
-      CALL wrk_alloc( jpi,jpj, ze3w, zp, zrhdtop_isf, zrhdtop_oce, ziceload, zdept, zpshpi, zpshpj) 
-      !
-     IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn:hpg_isf : hydrostatic pressure gradient trend for ice shelf'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OPA original scheme used'
-      ENDIF
-
+      REAL(wp), POINTER, DIMENSION(:,:)     ::  zrhdtop_oce
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,  2, ztstop) 
+      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj)
+      CALL wrk_alloc( jpi,jpj,     zrhdtop_oce )
+      !
       ! Local constant initialization
       zcoef0 = - grav * 0.5_wp
+  
       ! To use density and not density anomaly
-!      IF ( lk_vvl ) THEN   ;     znad = 1._wp          ! Variable volume
-!      ELSE                 ;     znad = 0._wp         ! Fixed volume
-!      ENDIF
       znad=1._wp
+
       ! iniitialised to 0. zhpi zhpi 
       zhpi(:,:,:)=0._wp ; zhpj(:,:,:)=0._wp
 
-!==================================================================================     
-!=====Compute iceload and contribution of the half first wet layer ================= 
-!===================================================================================
-
-      ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude)
-      ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp
-
-      ! compute density of the water displaced by the ice shelf 
-      zrhd = rhd ! save rhd
-      DO jk = 1, jpk
-           zdept(:,:)=gdept_1d(jk)
-           CALL eos(ztstop(:,:,:),zdept(:,:),rhd(:,:,jk))
-      END DO
-      WHERE ( tmask(:,:,:) == 1._wp)
-        rhd(:,:,:) = zrhd(:,:,:) ! replace wet cell by the saved rhd
-      END WHERE
-      
-      ! compute rhd at the ice/oce interface (ice shelf side)
-      CALL eos(ztstop,risfdep,zrhdtop_isf)
-
       ! compute rhd at the ice/oce interface (ocean side)
+      ! usefull to reduce residual current in the test case ISOMIP with no melting
       DO ji=1,jpi
         DO jj=1,jpj
@@ -520,43 +611,31 @@
         END DO
       END DO
-      CALL eos(ztstop,risfdep,zrhdtop_oce)
-      !
-      ! Surface value + ice shelf gradient
-      ! compute pressure due to ice shelf load (used to compute hpgi/j for all the level from 1 to miku/v)
-      ziceload = 0._wp
-      DO jj = 1, jpj
-         DO ji = 1, jpi   ! vector opt.
-            ikt=mikt(ji,jj)
-            ziceload(ji,jj) = ziceload(ji,jj) + (znad + rhd(ji,jj,1) ) * fse3w(ji,jj,1) * (1._wp - tmask(ji,jj,1))
-            DO jk=2,ikt-1
-               ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + rhd(ji,jj,jk-1) + rhd(ji,jj,jk)) * fse3w(ji,jj,jk) &
-                  &                              * (1._wp - tmask(ji,jj,jk))
-            END DO
-            IF (ikt .GE. 2) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + rhd(ji,jj,ikt-1)) &
-                               &                              * ( risfdep(ji,jj) - gdept_1d(ikt-1) )
-         END DO
-      END DO
-      riceload(:,:) = 0.0_wp ; riceload(:,:)=ziceload(:,:)  ! need to be saved for diaar5
-      ! compute zp from z=0 to first T wet point (correction due to zps not yet applied)
+      CALL eos( ztstop, risfdep, zrhdtop_oce )
+
+!==================================================================================     
+!===== Compute surface value ===================================================== 
+!==================================================================================
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            ikt=mikt(ji,jj) ; iktp1i=mikt(ji+1,jj); iktp1j=mikt(ji,jj+1)
+            ikt    = mikt(ji,jj)
+            iktp1i = mikt(ji+1,jj)
+            iktp1j = mikt(ji,jj+1)
             ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure
             ! we assume ISF is in isostatic equilibrium
-            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * fse3w(ji+1,jj  ,iktp1i)                                    &
-               &                                  * ( 2._wp * znad + rhd(ji+1,jj  ,iktp1i) + zrhdtop_oce(ji+1,jj  ) )   &
-               &                                  - 0.5_wp * fse3w(ji  ,jj  ,ikt   )                                    &
-               &                                  * ( 2._wp * znad + rhd(ji  ,jj  ,ikt   ) + zrhdtop_oce(ji  ,jj  ) )   &
-               &                                  + ( ziceload(ji+1,jj) - ziceload(ji,jj))                              ) 
-            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * fse3w(ji  ,jj+1,iktp1j)                                    &
-               &                                  * ( 2._wp * znad + rhd(ji  ,jj+1,iktp1j) + zrhdtop_oce(ji  ,jj+1) )   &
-               &                                  - 0.5_wp * fse3w(ji  ,jj  ,ikt   )                                    & 
-               &                                  * ( 2._wp * znad + rhd(ji  ,jj  ,ikt   ) + zrhdtop_oce(ji  ,jj  ) )   &
-               &                                  + ( ziceload(ji,jj+1) - ziceload(ji,jj) )                             ) 
+            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w_n(ji+1,jj,iktp1i)                                    &
+               &                                    * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) )   &
+               &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         &
+               &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
+               &                                  + ( riceload(ji+1,jj) - riceload(ji,jj))                            ) 
+            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w_n(ji,jj+1,iktp1j)                                    &
+               &                                    * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) )   &
+               &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         & 
+               &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
+               &                                  + ( riceload(ji,jj+1) - riceload(ji,jj))                            ) 
             ! s-coordinate pressure gradient correction (=0 if z coordinate)
-            zuap = -zcoef0 * ( rhd   (ji+1,jj,1) + rhd   (ji,jj,1) + 2._wp * znad )   &
-               &           * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj)
-            zvap = -zcoef0 * ( rhd   (ji,jj+1,1) + rhd   (ji,jj,1) + 2._wp * znad )   &
-               &           * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj)
+            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj)
+            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj)
             ! add to the general momentum trend
             ua(ji,jj,1) = ua(ji,jj,1) + (zhpi(ji,jj,1) + zuap) * umask(ji,jj,1)
@@ -565,140 +644,32 @@
       END DO
 !==================================================================================     
-!===== Compute partial cell contribution for the top cell ========================= 
-!==================================================================================
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            iku = miku(ji,jj) ; 
-            zpshpi(ji,jj)=0.0_wp ; zpshpj(ji,jj)=0.0_wp
-            ze3wu  = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku))
-            ! u direction
-            IF ( iku .GT. 1 ) THEN
-               ! case iku
-               zhpi(ji,jj,iku)   =  zcoef0 / e1u(ji,jj) * ze3wu                                            &
-                      &                                 * ( rhd    (ji+1,jj,iku) + rhd   (ji,jj,iku)       &
-                      &                                   + SIGN(1._wp,ze3wu) * grui(ji,jj) + 2._wp * znad )
-               ! corrective term ( = 0 if z coordinate )
-               zuap              = -zcoef0 * ( arui(ji,jj) + 2._wp * znad ) * gzui(ji,jj) / e1u(ji,jj)
-               ! zhpi will be added in interior loop
-               ua(ji,jj,iku)     = ua(ji,jj,iku) + zuap
-               ! in case of 2 cell water column, need to save the pressure gradient to compute the bottom pressure  
-               IF (mbku(ji,jj) == iku + 1) zpshpi(ji,jj)  = zhpi(ji,jj,iku)
-
-               ! case iku + 1 (remove the zphi term added in the interior loop and compute the one corrected for zps)
-               zhpiint        =  zcoef0 / e1u(ji,jj)                                                               &    
-                  &           * (  fse3w(ji+1,jj  ,iku+1) * ( (rhd(ji+1,jj,iku+1) + znad)                          &
-                  &                                         + (rhd(ji+1,jj,iku  ) + znad) ) * tmask(ji+1,jj,iku)   &
-                  &              - fse3w(ji  ,jj  ,iku+1) * ( (rhd(ji  ,jj,iku+1) + znad)                          &
-                  &                                         + (rhd(ji  ,jj,iku  ) + znad) ) * tmask(ji  ,jj,iku)   )
-               zhpi(ji,jj,iku+1) =  zcoef0 / e1u(ji,jj) * ge3rui(ji,jj) - zhpiint 
-            END IF
-               
-            ! v direction
-            ikv = mikv(ji,jj)
-            ze3wv  = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv))
-            IF ( ikv .GT. 1 ) THEN
-               ! case ikv
-               zhpj(ji,jj,ikv)   =  zcoef0 / e2v(ji,jj) * ze3wv                                            &
-                     &                                  * ( rhd(ji,jj+1,ikv) + rhd   (ji,jj,ikv)           &
-                     &                                    + SIGN(1._wp,ze3wv) * grvi(ji,jj) + 2._wp * znad )
-               ! corrective term ( = 0 if z coordinate )
-               zvap              = -zcoef0 * ( arvi(ji,jj) + 2._wp * znad ) * gzvi(ji,jj) / e2v(ji,jj)
-               ! zhpi will be added in interior loop
-               va(ji,jj,ikv)      = va(ji,jj,ikv) + zvap
-               ! in case of 2 cell water column, need to save the pressure gradient to compute the bottom pressure  
-               IF (mbkv(ji,jj) == ikv + 1)  zpshpj(ji,jj)  =  zhpj(ji,jj,ikv) 
-               
-               ! case ikv + 1 (remove the zphj term added in the interior loop and compute the one corrected for zps)
-               zhpjint        =  zcoef0 / e2v(ji,jj)                                                              &
-                  &           * (  fse3w(ji  ,jj+1,ikv+1) * ( (rhd(ji,jj+1,ikv+1) + znad)                         &
-                  &                                       + (rhd(ji,jj+1,ikv  ) + znad) ) * tmask(ji,jj+1,ikv)    &
-                  &              - fse3w(ji  ,jj  ,ikv+1) * ( (rhd(ji,jj  ,ikv+1) + znad)                         &
-                  &                                       + (rhd(ji,jj  ,ikv  ) + znad) ) * tmask(ji,jj  ,ikv)  )
-               zhpj(ji,jj,ikv+1) =  zcoef0 / e2v(ji,jj) * ge3rvi(ji,jj) - zhpjint
-            END IF
-         END DO
-      END DO
-
-!==================================================================================     
 !===== Compute interior value ===================================================== 
 !==================================================================================
-
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            iku=miku(ji,jj); ikv=mikv(ji,jj)
-            DO jk = 2, jpkm1
+      ! interior value (2=<jk=<jpkm1)
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
                ! hydrostatic pressure gradient along s-surfaces
-               ! zhpi is masked for the first wet cell  (contribution already done in the upper bloc)
-               zhpi(ji,jj,jk) = zhpi(ji,jj,jk) + zhpi(ji,jj,jk-1)                                                              &
-                  &                            + zcoef0 / e1u(ji,jj)                                                           &
-                  &                                     * ( fse3w(ji+1,jj  ,jk) * ( (rhd(ji+1,jj,jk  ) + znad)                 &
-                  &                                                     + (rhd(ji+1,jj,jk-1) + znad) ) * tmask(ji+1,jj,jk-1)   &
-                  &                                       - fse3w(ji  ,jj  ,jk) * ( (rhd(ji  ,jj,jk  ) + znad)                 &
-                  &                                                     + (rhd(ji  ,jj,jk-1) + znad) ) * tmask(ji  ,jj,jk-1)   ) 
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   &
+                  &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk)   &
+                  &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad ) * wmask(ji  ,jj,jk)   )
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   &
+                  &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk)   &
+                  &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad ) * wmask(ji,jj  ,jk)   )
                ! s-coordinate pressure gradient correction
-               ! corrective term, we mask this term for the first wet level beneath the ice shelf (contribution done in the upper bloc) 
-               zuap = - zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )                    &
-                  &            * ( fsde3w(ji+1,jj  ,jk) - fsde3w(ji,jj,jk) ) / e1u(ji,jj) * umask(ji,jj,jk-1)
-               ua(ji,jj,jk) = ua(ji,jj,jk) + ( zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk)
-
-               ! hydrostatic pressure gradient along s-surfaces
-               ! zhpi is masked for the first wet cell  (contribution already done in the upper bloc)
-               zhpj(ji,jj,jk) = zhpj(ji,jj,jk) + zhpj(ji,jj,jk-1)                                                              &
-                  &                            + zcoef0 / e2v(ji,jj)                                                           &
-                  &                                     * ( fse3w(ji  ,jj+1,jk) * ( (rhd(ji,jj+1,jk  ) + znad)                 &
-                  &                                                     + (rhd(ji,jj+1,jk-1) + znad) ) * tmask(ji,jj+1,jk-1)   &
-                  &                                       - fse3w(ji  ,jj  ,jk) * ( (rhd(ji,jj  ,jk  ) + znad)                 &
-                  &                                                     + (rhd(ji,jj  ,jk-1) + znad) ) * tmask(ji,jj  ,jk-1)   )
-               ! s-coordinate pressure gradient correction
-               ! corrective term, we mask this term for the first wet level beneath the ice shelf (contribution done in the upper bloc)
-               zvap = - zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )                     &
-                  &            * ( fsde3w(ji  ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj) * vmask(ji,jj,jk-1)
+               zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
+                  &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) / e1u(ji,jj)
+               zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
+                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) / e2v(ji,jj)
                ! add to the general momentum trend
-               va(ji,jj,jk) = va(ji,jj,jk) + ( zhpj(ji,jj,jk) + zvap ) * vmask(ji,jj,jk)
+               ua(ji,jj,jk) = ua(ji,jj,jk) + (zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + (zhpj(ji,jj,jk) + zvap) * vmask(ji,jj,jk)
             END DO
          END DO
       END DO
-
-!==================================================================================     
-!===== Compute bottom cell contribution (partial cell) ============================ 
-!==================================================================================
-
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-            iku = mbku(ji,jj)
-            ikv = mbkv(ji,jj)
-
-            IF (iku .GT. 1) THEN
-               ! remove old value (interior case)
-               zuap            = -zcoef0 * ( rhd   (ji+1,jj  ,iku) + rhd   (ji,jj,iku) + 2._wp * znad )   &
-                     &                   * ( fsde3w(ji+1,jj  ,iku) - fsde3w(ji,jj,iku) ) / e1u(ji,jj)
-               ua(ji,jj,iku)   = ua(ji,jj,iku) - zhpi(ji,jj,iku) - zuap
-               ! put new value
-               ! -zpshpi to avoid double contribution of the partial step in the top layer 
-               zuap            = -zcoef0 * ( aru(ji,jj) + 2._wp * znad ) * gzu(ji,jj)  / e1u(ji,jj)
-               zhpi(ji,jj,iku) =  zhpi(ji,jj,iku-1) + zcoef0 / e1u(ji,jj) * ge3ru(ji,jj) - zpshpi(ji,jj) 
-               ua(ji,jj,iku)   =  ua(ji,jj,iku) + zhpi(ji,jj,iku) + zuap
-            END IF
-            ! v direction
-            IF (ikv .GT. 1) THEN
-               ! remove old value (interior case)
-               zvap            = -zcoef0 * ( rhd   (ji  ,jj+1,ikv) + rhd   (ji,jj,ikv) + 2._wp * znad )   &
-                     &                   * ( fsde3w(ji  ,jj+1,ikv) - fsde3w(ji,jj,ikv) )   / e2v(ji,jj)
-               va(ji,jj,ikv)   = va(ji,jj,ikv) - zhpj(ji,jj,ikv) - zvap
-               ! put new value
-               ! -zpshpj to avoid double contribution of the partial step in the top layer 
-               zvap            = -zcoef0 * ( arv(ji,jj) + 2._wp * znad ) * gzv(ji,jj)     / e2v(ji,jj)
-               zhpj(ji,jj,ikv) =  zhpj(ji,jj,ikv-1) + zcoef0 / e2v(ji,jj) * ge3rv(ji,jj) - zpshpj(ji,jj)   
-               va(ji,jj,ikv)   =  va(ji,jj,ikv) + zhpj(ji,jj,ikv) + zvap
-            END IF
-         END DO
-      END DO
-     
-      ! set back to original density value into the ice shelf cell (maybe useless because it is masked)
-      rhd = zrhd
-      !
-      CALL wrk_dealloc( jpi,jpj,2, ztstop)
-      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj, zrhd)
-      CALL wrk_dealloc( jpi,jpj, ze3w, zp, zrhdtop_isf, zrhdtop_oce, ziceload, zdept, zpshpi, zpshpj)
+     !
+      CALL wrk_dealloc( jpi,jpj,2  , ztstop)
+      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj)
+      CALL wrk_dealloc( jpi,jpj    , zrhdtop_oce )
       !
    END SUBROUTINE hpg_isf
@@ -719,8 +690,10 @@
       REAL(wp) ::   z1_10, cffu, cffx   !    "         "
       REAL(wp) ::   z1_12, cffv, cffy   !    "         "
+      LOGICAL  ::   ll_tmp1, ll_tmp2    ! local logical variables
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  dzx, dzy, dzz, dzu, dzv, dzw
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  drhox, drhoy, drhoz, drhou, drhov, drhow
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  rho_i, rho_j, rho_k
+      REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy    !W/D pressure filter
       !!----------------------------------------------------------------------
       !
@@ -728,5 +701,46 @@
       CALL wrk_alloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow )
       CALL wrk_alloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        )
-      !
+      IF(ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy )
+      !
+      !
+      IF(ln_wd) THEN
+        DO jj = 2, jpjm1
+           DO ji = 2, jpim1 
+             ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) &
+                     & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) &
+                     &  > rn_wdmin1 + rn_wdmin2
+             ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) +&
+                                                       & rn_wdmin1 + rn_wdmin2
+
+             IF(ll_tmp1) THEN
+               zcpx(ji,jj) = 1.0_wp
+             ELSE IF(ll_tmp2) THEN
+               ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here
+               zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /&
+                           &     (sshn(ji+1,jj) - sshn(ji,jj)))
+             ELSE
+               zcpx(ji,jj) = 0._wp
+             END IF
+      
+             ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) &
+                     & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) &
+                     &  > rn_wdmin1 + rn_wdmin2
+             ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) +&
+                                                       & rn_wdmin1 + rn_wdmin2
+
+             IF(ll_tmp1) THEN
+               zcpy(ji,jj) = 1.0_wp
+             ELSE IF(ll_tmp2) THEN
+               ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here
+               zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /&
+                           &     (sshn(ji,jj+1) - sshn(ji,jj)))
+             ELSE
+               zcpy(ji,jj) = 0._wp
+             END IF
+           END DO
+        END DO
+        CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp )
+      ENDIF
+
 
       IF( kt == nit000 ) THEN
@@ -750,10 +764,10 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               drhoz(ji,jj,jk) = rhd   (ji  ,jj  ,jk) - rhd   (ji,jj,jk-1)
-               dzz  (ji,jj,jk) = fsde3w(ji  ,jj  ,jk) - fsde3w(ji,jj,jk-1)
-               drhox(ji,jj,jk) = rhd   (ji+1,jj  ,jk) - rhd   (ji,jj,jk  )
-               dzx  (ji,jj,jk) = fsde3w(ji+1,jj  ,jk) - fsde3w(ji,jj,jk  )
-               drhoy(ji,jj,jk) = rhd   (ji  ,jj+1,jk) - rhd   (ji,jj,jk  )
-               dzy  (ji,jj,jk) = fsde3w(ji  ,jj+1,jk) - fsde3w(ji,jj,jk  )
+               drhoz(ji,jj,jk) = rhd    (ji  ,jj  ,jk) - rhd    (ji,jj,jk-1)
+               dzz  (ji,jj,jk) = gde3w_n(ji  ,jj  ,jk) - gde3w_n(ji,jj,jk-1)
+               drhox(ji,jj,jk) = rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  )
+               dzx  (ji,jj,jk) = gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk  )
+               drhoy(ji,jj,jk) = rhd    (ji  ,jj+1,jk) - rhd    (ji,jj,jk  )
+               dzy  (ji,jj,jk) = gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk  )
             END DO
          END DO
@@ -837,14 +851,14 @@
       !-------------------------------------------------------------
 
-!!bug gm   :  e3w-de3w = 0.5*e3w  ....  and de3w(2)-de3w(1)=e3w(2) ....   to be verified
-!          true if de3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be
+!!bug gm   :  e3w-gde3w = 0.5*e3w  ....  and gde3w(2)-gde3w(1)=e3w(2) ....   to be verified
+!          true if gde3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be
 
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            rho_k(ji,jj,1) = -grav * ( fse3w(ji,jj,1) - fsde3w(ji,jj,1) )               &
-               &                   * (  rhd(ji,jj,1)                                    &
-               &                     + 0.5_wp * ( rhd(ji,jj,2) - rhd(ji,jj,1) )         &
-               &                              * ( fse3w (ji,jj,1) - fsde3w(ji,jj,1) )   &
-               &                              / ( fsde3w(ji,jj,2) - fsde3w(ji,jj,1) )  )
+            rho_k(ji,jj,1) = -grav * ( e3w_n(ji,jj,1) - gde3w_n(ji,jj,1) )               &
+               &                   * (  rhd(ji,jj,1)                                     &
+               &                     + 0.5_wp * ( rhd    (ji,jj,2) - rhd    (ji,jj,1) )  &
+               &                              * ( e3w_n  (ji,jj,1) - gde3w_n(ji,jj,1) )  &
+               &                              / ( gde3w_n(ji,jj,2) - gde3w_n(ji,jj,1) )  )
          END DO
       END DO
@@ -857,29 +871,29 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
 
-               rho_k(ji,jj,jk) = zcoef0 * ( rhd   (ji,jj,jk) + rhd   (ji,jj,jk-1) )                                   &
-                  &                     * ( fsde3w(ji,jj,jk) - fsde3w(ji,jj,jk-1) )                                   &
-                  &            - grav * z1_10 * (                                                                     &
-                  &     ( drhow (ji,jj,jk) - drhow (ji,jj,jk-1) )                                                     &
-                  &   * ( fsde3w(ji,jj,jk) - fsde3w(ji,jj,jk-1) - z1_12 * ( dzw  (ji,jj,jk) + dzw  (ji,jj,jk-1) ) )   &
-                  &   - ( dzw   (ji,jj,jk) - dzw   (ji,jj,jk-1) )                                                     &
-                  &   * ( rhd   (ji,jj,jk) - rhd   (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) )   &
+               rho_k(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj,jk) + rhd    (ji,jj,jk-1) )                                   &
+                  &                     * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) )                                   &
+                  &            - grav * z1_10 * (                                                                   &
+                  &     ( drhow  (ji,jj,jk) - drhow  (ji,jj,jk-1) )                                                     &
+                  &   * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) - z1_12 * ( dzw  (ji,jj,jk) + dzw  (ji,jj,jk-1) ) )   &
+                  &   - ( dzw    (ji,jj,jk) - dzw    (ji,jj,jk-1) )                                                     &
+                  &   * ( rhd    (ji,jj,jk) - rhd    (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) )   &
                   &                             )
 
-               rho_i(ji,jj,jk) = zcoef0 * ( rhd   (ji+1,jj,jk) + rhd   (ji,jj,jk) )                                   &
-                  &                     * ( fsde3w(ji+1,jj,jk) - fsde3w(ji,jj,jk) )                                   &
-                  &            - grav* z1_10 * (                                                                      &
-                  &     ( drhou (ji+1,jj,jk) - drhou (ji,jj,jk) )                                                     &
-                  &   * ( fsde3w(ji+1,jj,jk) - fsde3w(ji,jj,jk) - z1_12 * ( dzu  (ji+1,jj,jk) + dzu  (ji,jj,jk) ) )   &
-                  &   - ( dzu   (ji+1,jj,jk) - dzu   (ji,jj,jk) )                                                     &
-                  &   * ( rhd   (ji+1,jj,jk) - rhd   (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) )   &
+               rho_i(ji,jj,jk) = zcoef0 * ( rhd    (ji+1,jj,jk) + rhd    (ji,jj,jk) )                                   &
+                  &                     * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) )                                   &
+                  &            - grav* z1_10 * (                                                                    &
+                  &     ( drhou  (ji+1,jj,jk) - drhou  (ji,jj,jk) )                                                     &
+                  &   * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzu  (ji+1,jj,jk) + dzu  (ji,jj,jk) ) )   &
+                  &   - ( dzu    (ji+1,jj,jk) - dzu    (ji,jj,jk) )                                                     &
+                  &   * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) )   &
                   &                            )
 
-               rho_j(ji,jj,jk) = zcoef0 * ( rhd   (ji,jj+1,jk) + rhd   (ji,jj,jk) )                                   &
-                  &                     * ( fsde3w(ji,jj+1,jk) - fsde3w(ji,jj,jk) )                                   &
-                  &            - grav* z1_10 * (                                                                      &
-                  &     ( drhov (ji,jj+1,jk) - drhov (ji,jj,jk) )                                                     &
-                  &   * ( fsde3w(ji,jj+1,jk) - fsde3w(ji,jj,jk) - z1_12 * ( dzv  (ji,jj+1,jk) + dzv  (ji,jj,jk) ) )   &
-                  &   - ( dzv   (ji,jj+1,jk) - dzv   (ji,jj,jk) )                                                     &
-                  &   * ( rhd   (ji,jj+1,jk) - rhd   (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) )   &
+               rho_j(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj+1,jk) + rhd    (ji,jj,jk) )                                 &
+                  &                     * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) )                                   &
+                  &            - grav* z1_10 * (                                                                    &
+                  &     ( drhov  (ji,jj+1,jk) - drhov  (ji,jj,jk) )                                                     &
+                  &   * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzv  (ji,jj+1,jk) + dzv  (ji,jj,jk) ) )   &
+                  &   - ( dzv    (ji,jj+1,jk) - dzv    (ji,jj,jk) )                                                     &
+                  &   * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) )   &
                   &                            )
 
@@ -897,6 +911,10 @@
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) / e1u(ji,jj)
-            zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) / e2v(ji,jj)
+            zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj)
+            zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj)
+            IF(ln_wd) THEN
+              zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
+              zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
+            ENDIF
             ! add to the general momentum trend
             ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
@@ -914,8 +932,12 @@
                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)                                &
                   &           + (  ( rho_k(ji+1,jj,jk) - rho_k(ji,jj,jk  ) )    &
-                  &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) / e1u(ji,jj)
+                  &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) * r1_e1u(ji,jj)
                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)                                &
                   &           + (  ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk  ) )    &
-                  &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) / e2v(ji,jj)
+                  &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) * r1_e2v(ji,jj)
+               IF(ln_wd) THEN
+                 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
+                 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
+               ENDIF
                ! add to the general momentum trend
                ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
@@ -928,4 +950,5 @@
       CALL wrk_dealloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow )
       CALL wrk_dealloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        )
+      IF(ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )
       !
    END SUBROUTINE hpg_djc
@@ -947,8 +970,9 @@
       !!
       INTEGER  ::   ji, jj, jk, jkk                 ! dummy loop indices
-      REAL(wp) ::   zcoef0, znad                    ! temporary scalars
-      !!
+      REAL(wp) ::   zcoef0, znad                    ! local scalars
+      !
       !! The local variables for the correction term
       INTEGER  :: jk1, jis, jid, jjs, jjd
+      LOGICAL  :: ll_tmp1, ll_tmp2                  ! local logical variables
       REAL(wp) :: zuijk, zvijk, zpwes, zpwed, zpnss, zpnsd, zdeps
       REAL(wp) :: zrhdt1
@@ -957,9 +981,11 @@
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp
       REAL(wp), POINTER, DIMENSION(:,:)   ::   zsshu_n, zsshv_n
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
-      CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh )
-      CALL wrk_alloc( jpi,jpj, zsshu_n, zsshv_n )
+      REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy    !W/D pressure filter
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
+      CALL wrk_alloc( jpi,jpj,jpk,   zdept, zrhh )
+      CALL wrk_alloc( jpi,jpj,       zsshu_n, zsshv_n )
+      IF(ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy )
       !
       IF( kt == nit000 ) THEN
@@ -969,9 +995,47 @@
       ENDIF
 
-      !!----------------------------------------------------------------------
       ! Local constant initialization
       zcoef0 = - grav
-      znad = 0.0_wp
-      IF( lk_vvl ) znad = 1._wp
+      znad = 1._wp
+      IF( ln_linssh )   znad = 0._wp
+
+      IF(ln_wd) THEN
+        DO jj = 2, jpjm1
+           DO ji = 2, jpim1 
+             ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) &
+                     & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) &
+                     &  > rn_wdmin1 + rn_wdmin2
+             ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) +&
+                                                       & rn_wdmin1 + rn_wdmin2
+
+             IF(ll_tmp1) THEN
+               zcpx(ji,jj) = 1.0_wp
+             ELSE IF(ll_tmp2) THEN
+               ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here
+               zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /&
+                           &     (sshn(ji+1,jj) - sshn(ji,jj)))
+             ELSE
+               zcpx(ji,jj) = 0._wp
+             END IF
+      
+             ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) &
+                     & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) &
+                     &  > rn_wdmin1 + rn_wdmin2
+             ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) +&
+                                                       & rn_wdmin1 + rn_wdmin2
+
+             IF(ll_tmp1.OR.ll_tmp2) THEN
+               zcpy(ji,jj) = 1.0_wp
+             ELSE IF(ll_tmp2) THEN
+               ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here
+               zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /&
+                           &     (sshn(ji,jj+1) - sshn(ji,jj)))
+             ELSE
+               zcpy(ji,jj) = 0._wp
+             END IF
+           END DO
+        END DO
+        CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp )
+      ENDIF
 
       ! Clean 3-D work arrays
@@ -983,10 +1047,10 @@
         DO ji = 1, jpi
           jk = mbathy(ji,jj)
-          IF( jk <= 0 ) THEN; zrhh(ji,jj,:) = 0._wp
-          ELSE IF(jk == 1) THEN; zrhh(ji,jj, jk+1:jpk) = rhd(ji,jj,jk)
-          ELSE IF(jk < jpkm1) THEN
+          IF(     jk <=  0   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp
+          ELSEIF( jk ==  1   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk)
+          ELSEIF( jk < jpkm1 ) THEN
              DO jkk = jk+1, jpk
-                zrhh(ji,jj,jkk) = interp1(fsde3w(ji,jj,jkk),   fsde3w(ji,jj,jkk-1), &
-                                         fsde3w(ji,jj,jkk-2), rhd(ji,jj,jkk-1), rhd(ji,jj,jkk-2))
+                zrhh(ji,jj,jkk) = interp1(gde3w_n(ji,jj,jkk  ), gde3w_n(ji,jj,jkk-1),   &
+                   &                      gde3w_n(ji,jj,jkk-2), rhd    (ji,jj,jkk-1), rhd(ji,jj,jkk-2))
              END DO
           ENDIF
@@ -997,5 +1061,5 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            zdept(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) - sshn(ji,jj) * znad
+            zdept(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) - sshn(ji,jj) * znad
          END DO
       END DO
@@ -1004,5 +1068,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + fse3w(ji,jj,jk)
+               zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w_n(ji,jj,jk)
             END DO
          END DO
@@ -1015,15 +1079,14 @@
       ! constrained cubic spline interpolation
       ! rho(z) = asp + bsp*z + csp*z^2 + dsp*z^3
-      CALL cspline(fsp,xsp,asp,bsp,csp,dsp,polynomial_type)
+      CALL cspline( fsp, xsp, asp, bsp, csp, dsp, polynomial_type )
 
       ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)"
       DO jj = 2, jpj
         DO ji = 2, jpi
-          zrhdt1 = zrhh(ji,jj,1) - interp3(zdept(ji,jj,1),asp(ji,jj,1), &
-                                         bsp(ji,jj,1),   csp(ji,jj,1), &
-                                         dsp(ji,jj,1) ) * 0.25_wp * fse3w(ji,jj,1)
+          zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  &
+             &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w_n(ji,jj,1)
 
           ! assuming linear profile across the top half surface layer
-          zhpi(ji,jj,1) =  0.5_wp * fse3w(ji,jj,1) * zrhdt1
+          zhpi(ji,jj,1) =  0.5_wp * e3w_n(ji,jj,1) * zrhdt1
         END DO
       END DO
@@ -1033,8 +1096,8 @@
         DO jj = 2, jpj
           DO ji = 2, jpi
-            zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                          &
-                             integ_spline(zdept(ji,jj,jk-1), zdept(ji,jj,jk),&
-                                    asp(ji,jj,jk-1),    bsp(ji,jj,jk-1), &
-                                    csp(ji,jj,jk-1),    dsp(ji,jj,jk-1))
+            zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  &
+               &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   &
+               &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), &
+               &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  )
           END DO
         END DO
@@ -1046,15 +1109,24 @@
       DO jj = 2, jpjm1
         DO ji = 2, jpim1
-          zsshu_n(ji,jj) = (e12u(ji,jj) * sshn(ji,jj) + e12u(ji+1, jj) * sshn(ji+1,jj)) * &
-                         & r1_e12u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
-          zsshv_n(ji,jj) = (e12v(ji,jj) * sshn(ji,jj) + e12v(ji+1, jj) * sshn(ji,jj+1)) * &
-                         & r1_e12v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
+!!gm BUG ?    if it is ssh at u- & v-point then it should be:
+!          zsshu_n(ji,jj) = (e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji+1,jj) * sshn(ji+1,jj)) * &
+!                         & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
+!          zsshv_n(ji,jj) = (e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji,jj+1) * sshn(ji,jj+1)) * &
+!                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
+!!gm not this:
+          zsshu_n(ji,jj) = (e1e2u(ji,jj) * sshn(ji,jj) + e1e2u(ji+1, jj) * sshn(ji+1,jj)) * &
+                         & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
+          zsshv_n(ji,jj) = (e1e2v(ji,jj) * sshn(ji,jj) + e1e2v(ji+1, jj) * sshn(ji,jj+1)) * &
+                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
         END DO
       END DO
+
+      CALL lbc_lnk (zsshu_n, 'U', 1.)
+      CALL lbc_lnk (zsshv_n, 'V', 1.)
 
       DO jj = 2, jpjm1
         DO ji = 2, jpim1
-          zu(ji,jj,1) = - ( fse3u(ji,jj,1) - zsshu_n(ji,jj) * znad) 
-          zv(ji,jj,1) = - ( fse3v(ji,jj,1) - zsshv_n(ji,jj) * znad)
+          zu(ji,jj,1) = - ( e3u_n(ji,jj,1) - zsshu_n(ji,jj) * znad) 
+          zv(ji,jj,1) = - ( e3v_n(ji,jj,1) - zsshv_n(ji,jj) * znad)
         END DO
       END DO
@@ -1063,6 +1135,6 @@
         DO jj = 2, jpjm1
           DO ji = 2, jpim1
-            zu(ji,jj,jk) = zu(ji,jj,jk-1)- fse3u(ji,jj,jk)
-            zv(ji,jj,jk) = zv(ji,jj,jk-1)- fse3v(ji,jj,jk)
+            zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u_n(ji,jj,jk)
+            zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v_n(ji,jj,jk)
           END DO
         END DO
@@ -1072,6 +1144,6 @@
         DO jj = 2, jpjm1
           DO ji = 2, jpim1
-            zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * fse3u(ji,jj,jk)
-            zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * fse3v(ji,jj,jk)
+            zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u_n(ji,jj,jk)
+            zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v_n(ji,jj,jk)
           END DO
         END DO
@@ -1081,8 +1153,8 @@
         DO jj = 2, jpjm1
           DO ji = 2, jpim1
-            zu(ji,jj,jk) = min(zu(ji,jj,jk), max(-zdept(ji,jj,jk), -zdept(ji+1,jj,jk)))
-            zu(ji,jj,jk) = max(zu(ji,jj,jk), min(-zdept(ji,jj,jk), -zdept(ji+1,jj,jk)))
-            zv(ji,jj,jk) = min(zv(ji,jj,jk), max(-zdept(ji,jj,jk), -zdept(ji,jj+1,jk)))
-            zv(ji,jj,jk) = max(zv(ji,jj,jk), min(-zdept(ji,jj,jk), -zdept(ji,jj+1,jk)))
+            zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
+            zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
+            zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
+            zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
           END DO
         END DO
@@ -1142,14 +1214,16 @@
                ! update the momentum trends in u direction
 
-               zdpdx1 = zcoef0 / e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk))
-               IF( lk_vvl ) THEN
-                 zdpdx2 = zcoef0 / e1u(ji,jj) * &
-                         ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) )
+               zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) )
+               IF( .NOT.ln_linssh ) THEN
+                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * &
+                    &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) )
                 ELSE
-                 zdpdx2 = zcoef0 / e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed)
+                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed)
                ENDIF
-
-               ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * &
-               &           umask(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji+1,jj,jk)
+               IF(ln_wd) THEN
+                  zdpdx1 = zdpdx1 * zcpx(ji,jj)
+                  zdpdx2 = zdpdx2 * zcpx(ji,jj)
+               ENDIF
+               ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk) 
             ENDIF
 
@@ -1199,29 +1273,32 @@
                ! update the momentum trends in v direction
 
-               zdpdy1 = zcoef0 / e2v(ji,jj) * (zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk))
-               IF( lk_vvl ) THEN
-                   zdpdy2 = zcoef0 / e2v(ji,jj) * &
-                           ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) )
+               zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) )
+               IF( .NOT.ln_linssh ) THEN
+                  zdpdy2 = zcoef0 * r1_e2v(ji,jj) * &
+                          ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) )
                ELSE
-                   zdpdy2 = zcoef0 / e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd )
+                  zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd )
                ENDIF
-
-               va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2)*&
-               &              vmask(ji,jj,jk)*tmask(ji,jj,jk)*tmask(ji,jj+1,jk)
+               IF(ln_wd) THEN
+                  zdpdy1 = zdpdy1 * zcpy(ji,jj)
+                  zdpdy2 = zdpdy2 * zcpy(ji,jj)
+               ENDIF
+
+               va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2) * vmask(ji,jj,jk)
             ENDIF
-
-
-           END DO
-        END DO
-      END DO
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
-      CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh )
-      CALL wrk_dealloc( jpi,jpj, zsshu_n, zsshv_n )
+               !
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zdept, zrhh )
+      CALL wrk_dealloc( jpi,jpj,       zsshu_n, zsshv_n )
+      IF(ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )
       !
    END SUBROUTINE hpg_prj
 
 
-   SUBROUTINE cspline(fsp, xsp, asp, bsp, csp, dsp, polynomial_type)
+   SUBROUTINE cspline( fsp, xsp, asp, bsp, csp, dsp, polynomial_type )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE cspline  ***
@@ -1233,10 +1310,7 @@
       !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation
       !!----------------------------------------------------------------------
-      IMPLICIT NONE
-      REAL(wp), DIMENSION(:,:,:), INTENT(in)  :: fsp, xsp           ! value and coordinate
-      REAL(wp), DIMENSION(:,:,:), INTENT(out) :: asp, bsp, csp, dsp ! coefficients of
-                                                                    ! the interpoated function
-      INTEGER, INTENT(in) :: polynomial_type                        ! 1: cubic spline
-                                                                    ! 2: Linear
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   fsp, xsp           ! value and coordinate
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   asp, bsp, csp, dsp ! coefficients of the interpoated function
+      INTEGER                   , INTENT(in   ) ::   polynomial_type    ! 1: cubic spline   ;   2: Linear
       !
       INTEGER  ::   ji, jj, jk                 ! dummy loop indices
@@ -1246,10 +1320,10 @@
       REAL(wp) ::   zdf(size(fsp,3))
       !!----------------------------------------------------------------------
-
+      !
+!!gm  WHAT !!!!!   THIS IS VERY DANGEROUS !!!!!  
       jpi   = size(fsp,1)
       jpj   = size(fsp,2)
       jpkm1 = size(fsp,3) - 1
-
-
+      !
       IF (polynomial_type == 1) THEN     ! Constrained Cubic Spline
          DO ji = 1, jpi
@@ -1284,8 +1358,7 @@
 
                zdf(1)     = 1.5_wp * ( fsp(ji,jj,2) - fsp(ji,jj,1) ) / &
-                          &          ( xsp(ji,jj,2) - xsp(ji,jj,1) ) -  0.5_wp * zdf(2)
+                          &          ( xsp(ji,jj,2) - xsp(ji,jj,1) )           -  0.5_wp * zdf(2)
                zdf(jpkm1) = 1.5_wp * ( fsp(ji,jj,jpkm1) - fsp(ji,jj,jpkm1-1) ) / &
-                          &          ( xsp(ji,jj,jpkm1) - xsp(ji,jj,jpkm1-1) ) - &
-                          & 0.5_wp * zdf(jpkm1 - 1)
+                          &          ( xsp(ji,jj,jpkm1) - xsp(ji,jj,jpkm1-1) ) - 0.5_wp * zdf(jpkm1 - 1)
 
                DO jk = 1, jpkm1 - 1
@@ -1310,5 +1383,5 @@
          END DO
 
-      ELSE IF (polynomial_type == 2) THEN     ! Linear
+      ELSEIF ( polynomial_type == 2 ) THEN     ! Linear
          DO ji = 1, jpi
             DO jj = 1, jpj
@@ -1341,21 +1414,20 @@
       !!                extrapolation is also permitted (no value limit)
       !!----------------------------------------------------------------------
-      IMPLICIT NONE
       REAL(wp), INTENT(in) ::  x, xl, xr, fl, fr
       REAL(wp)             ::  f ! result of the interpolation (extrapolation)
       REAL(wp)             ::  zdeltx
       !!----------------------------------------------------------------------
-
+      !
       zdeltx = xr - xl
-      IF(abs(zdeltx) <= 10._wp * EPSILON(x)) THEN
-        f = 0.5_wp * (fl + fr)
+      IF( abs(zdeltx) <= 10._wp * EPSILON(x) ) THEN
+         f = 0.5_wp * (fl + fr)
       ELSE
-        f = ( (x - xl ) * fr - ( x - xr ) * fl ) / zdeltx
+         f = ( (x - xl ) * fr - ( x - xr ) * fl ) / zdeltx
       ENDIF
-
+      !
    END FUNCTION interp1
 
 
-   FUNCTION interp2(x, a, b, c, d)  RESULT(f)
+   FUNCTION interp2( x, a, b, c, d )  RESULT(f)
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE interp1  ***
@@ -1366,15 +1438,14 @@
       !!
       !!----------------------------------------------------------------------
-      IMPLICIT NONE
       REAL(wp), INTENT(in) ::  x, a, b, c, d
       REAL(wp)             ::  f ! value from the interpolation
       !!----------------------------------------------------------------------
-
+      !
       f = a + x* ( b + x * ( c + d * x ) )
-
+      !
    END FUNCTION interp2
 
 
-   FUNCTION interp3(x, a, b, c, d)  RESULT(f)
+   FUNCTION interp3( x, a, b, c, d )  RESULT(f)
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE interp1  ***
@@ -1386,15 +1457,14 @@
       !!
       !!----------------------------------------------------------------------
-      IMPLICIT NONE
       REAL(wp), INTENT(in) ::  x, a, b, c, d
       REAL(wp)             ::  f ! value from the interpolation
       !!----------------------------------------------------------------------
-
+      !
       f = b + x * ( 2._wp * c + 3._wp * d * x)
-
+      !
    END FUNCTION interp3
 
 
-   FUNCTION integ_spline(xl, xr, a, b, c, d)  RESULT(f)
+   FUNCTION integ_spline( xl, xr, a, b, c, d )  RESULT(f)
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE interp1  ***
@@ -1405,17 +1475,16 @@
       !!
       !!----------------------------------------------------------------------
-      IMPLICIT NONE
       REAL(wp), INTENT(in) ::  xl, xr, a, b, c, d
       REAL(wp)             ::  za1, za2, za3
       REAL(wp)             ::  f                   ! integration result
       !!----------------------------------------------------------------------
-
+      !
       za1 = 0.5_wp * b
       za2 = c / 3.0_wp
       za3 = 0.25_wp * d
-
+      !
       f  = xr * ( a + xr * ( za1 + xr * ( za2 + za3 * xr ) ) ) - &
          & xl * ( a + xl * ( za1 + xl * ( za2 + za3 * xl ) ) )
-
+      !
    END FUNCTION integ_spline
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 6808)
@@ -4,5 +4,7 @@
    !! Ocean physics:  lateral diffusivity trends 
    !!=====================================================================
-   !! History :  9.0  !  05-11  (G. Madec)  Original code (new step architecture)
+   !! History :  2.0  ! 2005-11  (G. Madec)  Original code (new step architecture)
+   !!            3.7  ! 2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification,
+   !!                 !                                  add velocity dependent coefficient and optional read in file
    !!----------------------------------------------------------------------
 
@@ -14,13 +16,10 @@
    USE dom_oce        ! ocean space and time domain
    USE phycst         ! physical constants
-   USE ldfdyn_oce     ! ocean dynamics lateral physics
-   USE ldftra_oce     ! ocean tracers  lateral physics
-   USE ldfslp         ! lateral mixing: slopes of mixing orientation
-   USE dynldf_bilapg  ! lateral mixing            (dyn_ldf_bilapg routine)
-   USE dynldf_bilap   ! lateral mixing            (dyn_ldf_bilap  routine)
-   USE dynldf_iso     ! lateral mixing            (dyn_ldf_iso    routine)
-   USE dynldf_lap     ! lateral mixing            (dyn_ldf_lap    routine)
+   USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
+   USE ldfslp         ! lateral diffusion: slopes of mixing orientation
+   USE dynldf_lap_blp ! lateral mixing   (dyn_ldf_lap & dyn_ldf_blp routines)
+   USE dynldf_iso     ! lateral mixing                 (dyn_ldf_iso routine )
    USE trd_oce        ! trends: ocean variables
-   USE trddyn         ! trend manager: dynamics   (trd_dyn        routine)
+   USE trddyn         ! trend manager: dynamics   (trd_dyn      routine)
    !
    USE prtctl         ! Print control
@@ -28,6 +27,6 @@
    USE lib_mpp        ! distribued memory computing library
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -37,11 +36,17 @@
    PUBLIC   dyn_ldf_init  ! called by opa  module 
 
-   INTEGER ::   nldf = -2   ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals)
+   !                      ! Parameter to control the type of lateral viscous operator
+   INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10   ! error in setting the operator
+   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00   ! without operator (i.e. no lateral viscous trend)
+   !                          !!      laplacian     !    bilaplacian    !
+   INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  ! iso-level operator
+   INTEGER, PARAMETER, PUBLIC ::   np_lap_i  = 11                       ! iso-neutral or geopotential operator
+
+   INTEGER ::   nldf   ! type of lateral diffusion used defined from ln_dynldf_... (namlist logicals)
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -62,6 +67,6 @@
       IF( nn_timing == 1 )  CALL timing_start('dyn_ldf')
       !
-      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )
+      IF( l_trddyn )   THEN                      ! temporary save of momentum trends
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )
          ztrdu(:,:,:) = ua(:,:,:) 
          ztrdv(:,:,:) = va(:,:,:) 
@@ -70,35 +75,8 @@
       SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
       !
-      CASE ( 0 )    ;   CALL dyn_ldf_lap    ( kt )      ! iso-level laplacian
-      CASE ( 1 )    ;   CALL dyn_ldf_iso    ( kt )      ! rotated laplacian (except dk[ dk[.] ] part)
-      CASE ( 2 )    ;   CALL dyn_ldf_bilap  ( kt )      ! iso-level bilaplacian
-      CASE ( 3 )    ;   CALL dyn_ldf_bilapg ( kt )      ! s-coord. horizontal bilaplacian
-      CASE ( 4 )                                        ! iso-level laplacian + bilaplacian
-         CALL dyn_ldf_lap    ( kt )
-         CALL dyn_ldf_bilap  ( kt )
-      CASE ( 5 )                                        ! rotated laplacian + bilaplacian (s-coord)
-         CALL dyn_ldf_iso    ( kt )
-         CALL dyn_ldf_bilapg ( kt )
+      CASE ( np_lap   )    ;   CALL dyn_ldf_lap  ( kt, ub, vb, ua, va, 1 )      ! iso-level    laplacian
+      CASE ( np_lap_i )    ;   CALL dyn_ldf_iso  ( kt )                         ! rotated      laplacian
+      CASE ( np_blp   )    ;   CALL dyn_ldf_blp  ( kt, ub, vb, ua, va    )      ! iso-level bi-laplacian
       !
-      CASE ( -1 )                                       ! esopa: test all possibility with control print
-                        CALL dyn_ldf_lap    ( kt )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf0 - Ua: ', mask1=umask,   &
-            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-                        CALL dyn_ldf_iso    ( kt )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf1 - Ua: ', mask1=umask,   &
-            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-                        CALL dyn_ldf_bilap  ( kt )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf2 - Ua: ', mask1=umask,   &
-            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-                        CALL dyn_ldf_bilapg ( kt )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf3 - Ua: ', mask1=umask,   &
-            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-      !
-      CASE ( -2 )                                       ! neither laplacian nor bilaplacian schemes used
-         IF( kt == nit000 ) THEN
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'dyn_ldf : no lateral diffusion on momentum setup'
-            IF(lwp) WRITE(numout,*) '~~~~~~~ '
-         ENDIF
       END SELECT
 
@@ -107,5 +85,5 @@
          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
          CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt )
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )
       ENDIF
       !                                          ! print sum trends (used for debugging)
@@ -126,7 +104,7 @@
       INTEGER ::   ioptio, ierr         ! temporary integers 
       !!----------------------------------------------------------------------
-    
+      !
       !                                   ! Namelist nam_dynldf: already read in ldfdyn module
-
+      !
       IF(lwp) THEN                        ! Namelist print
          WRITE(numout,*)
@@ -134,99 +112,76 @@
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '       Namelist nam_dynldf : set lateral mixing parameters (type, direction, coefficients)'
-         WRITE(numout,*) '          laplacian operator          ln_dynldf_lap   = ', ln_dynldf_lap
-         WRITE(numout,*) '          bilaplacian operator        ln_dynldf_bilap = ', ln_dynldf_bilap
-         WRITE(numout,*) '          iso-level                   ln_dynldf_level = ', ln_dynldf_level
-         WRITE(numout,*) '          horizontal (geopotential)   ln_dynldf_hor   = ', ln_dynldf_hor
-         WRITE(numout,*) '          iso-neutral                 ln_dynldf_iso   = ', ln_dynldf_iso
+         WRITE(numout,*) '          laplacian operator          ln_dynldf_lap = ', ln_dynldf_lap
+         WRITE(numout,*) '          bilaplacian operator        ln_dynldf_blp = ', ln_dynldf_blp
+         WRITE(numout,*) '          iso-level                   ln_dynldf_lev = ', ln_dynldf_lev
+         WRITE(numout,*) '          horizontal (geopotential)   ln_dynldf_hor = ', ln_dynldf_hor
+         WRITE(numout,*) '          iso-neutral                 ln_dynldf_iso = ', ln_dynldf_iso
       ENDIF
-
-      !                                   ! control the consistency
+      !                                   ! use of lateral operator or not
+      nldf = np_ERROR
       ioptio = 0
-      IF( ln_dynldf_lap   )   ioptio = ioptio + 1
-      IF( ln_dynldf_bilap )   ioptio = ioptio + 1
-      IF( ioptio <  1 ) CALL ctl_warn( '          neither laplacian nor bilaplacian operator set for dynamics' )
-      ioptio = 0
-      IF( ln_dynldf_level )   ioptio = ioptio + 1
-      IF( ln_dynldf_hor   )   ioptio = ioptio + 1
-      IF( ln_dynldf_iso   )   ioptio = ioptio + 1
-      IF( ioptio >  1 ) CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
-
-      IF( ln_dynldf_iso .AND. ln_traldf_hor ) CALL ctl_stop &
-      &   ( 'Not sensible to use geopotential diffusion for tracers with isoneutral diffusion for dynamics' )
-
-      !                                   ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals
-      ierr = 0
-      IF ( ln_dynldf_lap ) THEN      ! laplacian operator
-         IF ( ln_zco ) THEN                ! z-coordinate
-            IF ( ln_dynldf_level )   nldf = 0      ! iso-level  (no rotation)
-            IF ( ln_dynldf_hor   )   nldf = 0      ! horizontal (no rotation)
-            IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+      IF( ln_dynldf_lap )   ioptio = ioptio + 1
+      IF( ln_dynldf_blp )   ioptio = ioptio + 1
+      IF( ioptio >  1   )   CALL ctl_stop( 'dyn_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on momentum' )
+      IF( ioptio == 0   )   nldf = np_no_ldf     ! No lateral mixing operator
+      !
+      IF( nldf /= np_no_ldf ) THEN        ! direction ==>> type of operator  
+         ioptio = 0
+         IF( ln_dynldf_lev )   ioptio = ioptio + 1
+         IF( ln_dynldf_hor )   ioptio = ioptio + 1
+         IF( ln_dynldf_iso )   ioptio = ioptio + 1
+         IF( ioptio >  1   )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
+         IF( ioptio == 0   )   CALL ctl_stop( '          use at least ONE direction (level/hor/iso)' )
+         !
+         !                                   ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals
+         ierr = 0
+         IF ( ln_dynldf_lap ) THEN      ! laplacian operator
+            IF ( ln_zco ) THEN                ! z-coordinate
+               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_iso )   nldf = np_lap_i   ! iso-neutral            (   rotation)
+            ENDIF
+            IF ( ln_zps ) THEN             ! z-coordinate with partial step
+               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level              (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_lap     ! iso-level              (no rotation)
+               IF ( ln_dynldf_iso )   nldf = np_lap_i   ! iso-neutral            (   rotation)
+            ENDIF
+            IF ( ln_sco ) THEN             ! s-coordinate
+               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_lap_i   ! horizontal             (   rotation)
+               IF ( ln_dynldf_iso )   nldf = np_lap_i   ! iso-neutral            (   rotation)
+            ENDIF
          ENDIF
-         IF ( ln_zps ) THEN             ! z-coordinate
-            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed
-            IF ( ln_dynldf_hor   )   nldf = 0      ! horizontal (no rotation)
-            IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         !
+         IF( ln_dynldf_blp ) THEN          ! bilaplacian operator
+            IF ( ln_zco ) THEN                ! z-coordinate
+               IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation)
+            ENDIF
+            IF ( ln_zps ) THEN             ! z-coordinate with partial step
+               IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_blp     ! iso-level              (no rotation)
+               IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation)
+            ENDIF
+            IF ( ln_sco ) THEN             ! s-coordinate
+               IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation)
+               IF ( ln_dynldf_hor )   ierr = 2          ! horizontal             (   rotation)
+               IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation)
+            ENDIF
          ENDIF
-         IF ( ln_sco ) THEN             ! s-coordinate
-            IF ( ln_dynldf_level )   nldf = 0      ! iso-level  (no rotation)
-            IF ( ln_dynldf_hor   )   nldf = 1      ! horizontal (   rotation)
-            IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
-         ENDIF
-      ENDIF
-
-      IF( ln_dynldf_bilap ) THEN      ! bilaplacian operator
-         IF ( ln_zco ) THEN                ! z-coordinate
-            IF ( ln_dynldf_level )   nldf = 2      ! iso-level  (no rotation)
-            IF ( ln_dynldf_hor   )   nldf = 2      ! horizontal (no rotation)
-            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_zps ) THEN             ! z-coordinate
-            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed 
-            IF ( ln_dynldf_hor   )   nldf = 2      ! horizontal (no rotation)
-            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_sco ) THEN             ! s-coordinate
-            IF ( ln_dynldf_level )   nldf = 2      ! iso-level  (no rotation)
-            IF ( ln_dynldf_hor   )   nldf = 3      ! horizontal (   rotation)
-            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-      ENDIF
-      
-      IF( ln_dynldf_lap .AND. ln_dynldf_bilap ) THEN  ! mixed laplacian and bilaplacian operators
-         IF ( ln_zco ) THEN                ! z-coordinate
-            IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation)
-            IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation)
-            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_zps ) THEN             ! z-coordinate
-            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed 
-            IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation)
-            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_sco ) THEN             ! s-coordinate
-            IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation)
-            IF ( ln_dynldf_hor   )   nldf = 5      ! horizontal (   rotation)
-            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-      ENDIF
-
-      IF( lk_esopa )                 nldf = -1     ! esopa test
-
-      IF( ierr == 1 )   CALL ctl_stop( 'iso-level in z-coordinate - partial step, not allowed' )
-      IF( ierr == 2 )   CALL ctl_stop( 'isoneutral bilaplacian operator does not exist' )
-      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
-         IF( .NOT.lk_ldfslp )   CALL ctl_stop( 'the rotation of the diffusive tensor require key_ldfslp' )
+         !
+         IF( ierr == 2 )   CALL ctl_stop( 'rotated bi-laplacian operator does not exist' )
+         !
+         IF( nldf == np_lap_i )   l_ldfslp = .TRUE.      ! rotation require the computation of the slopes
+         !
       ENDIF
 
       IF(lwp) THEN
          WRITE(numout,*)
-         IF( nldf == -2 )   WRITE(numout,*) '              neither laplacian nor bilaplacian schemes used'
-         IF( nldf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
-         IF( nldf ==  0 )   WRITE(numout,*) '              laplacian operator'
-         IF( nldf ==  1 )   WRITE(numout,*) '              rotated laplacian operator'
-         IF( nldf ==  2 )   WRITE(numout,*) '              bilaplacian operator'
-         IF( nldf ==  3 )   WRITE(numout,*) '              rotated bilaplacian'
-         IF( nldf ==  4 )   WRITE(numout,*) '              laplacian and bilaplacian operators'
-         IF( nldf ==  5 )   WRITE(numout,*) '              rotated laplacian and bilaplacian operators'
+         IF( nldf == np_no_ldf )   WRITE(numout,*) '              NO lateral viscosity'
+         IF( nldf == np_lap    )   WRITE(numout,*) '              iso-level laplacian operator'
+         IF( nldf == np_lap_i  )   WRITE(numout,*) '              rotated laplacian operator with iso-level background'
+         IF( nldf == np_blp    )   WRITE(numout,*) '              iso-level bi-laplacian operator'
       ENDIF
       !
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90	(revision 6807)
+++ 	(revision )
@@ -1,215 +1,0 @@
-MODULE dynldf_bilap
-   !!======================================================================
-   !!                     ***  MODULE  dynldf_bilap  ***
-   !! Ocean dynamics:  lateral viscosity trend
-   !!======================================================================
-   !! History :  OPA  ! 1990-09  (G. Madec)  Original code
-   !!            4.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon)
-   !!            6.0  ! 1996-01  (G. Madec)  statement function for e3
-   !!            8.0  ! 1997-07  (G. Madec)  lbc calls
-   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module
-   !!            2.0  ! 2004-08  (C. Talandier) New trends organization
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dyn_ldf_bilap : update the momentum trend with the lateral diffusion
-   !!                   using an iso-level bilaplacian operator
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE ldfdyn_oce      ! ocean dynamics: lateral physics
-   !
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dyn_ldf_bilap   ! called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldfdyn_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dyn_ldf_bilap( kt )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE dyn_ldf_bilap  ***
-      !!
-      !! ** Purpose :   Compute the before trend of the lateral momentum
-      !!      diffusion and add it to the general trend of momentum equation.
-      !!
-      !! ** Method  :   The before horizontal momentum diffusion trend is a 
-      !!      bi-harmonic operator (bilaplacian type) which separates the
-      !!      divergent and rotational parts of the flow.
-      !!      Its horizontal components are computed as follow:
-      !!      laplacian:
-      !!          zlu = 1/e1u di[ hdivb ] - 1/(e2u*e3u) dj-1[ e3f rotb ]
-      !!          zlv = 1/e2v dj[ hdivb ] + 1/(e1v*e3v) di-1[ e3f rotb ]
-      !!      third derivative:
-      !!       * multiply by the eddy viscosity coef. at u-, v-point, resp.
-      !!          zlu = ahmu * zlu
-      !!          zlv = ahmv * zlv
-      !!       * curl and divergence of the laplacian
-      !!          zuf = 1/(e1f*e2f) ( di[e2v zlv] - dj[e1u zlu] )
-      !!          zut = 1/(e1t*e2t*e3t) ( di[e2u*e3u zlu] + dj[e1v*e3v zlv] )
-      !!      bilaplacian:
-      !!              diffu = 1/e1u di[ zut ] - 1/(e2u*e3u) dj-1[ e3f zuf ]
-      !!              diffv = 1/e2v dj[ zut ] + 1/(e1v*e3v) di-1[ e3f zuf ]
-      !!      If ln_sco=F and ln_zps=F, the vertical scale factors in the
-      !!      rotational part of the diffusion are simplified
-      !!      Add this before trend to the general trend (ua,va):
-      !!            (ua,va) = (ua,va) + (diffu,diffv)
-      !!
-      !! ** Action : - Update (ua,va) with the before iso-level biharmonic
-      !!               mixing trend.
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj, jk                  ! dummy loop indices
-      REAL(wp) ::   zua, zva, zbt, ze2u, ze2v   ! temporary scalar
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zcu, zcv
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zuf, zut, zlu, zlv
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_bilap')
-      !
-      CALL wrk_alloc( jpi, jpj,      zcu, zcv           )
-      CALL wrk_alloc( jpi, jpj, jpk, zuf, zut, zlu, zlv ) 
-      !
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'dyn_ldf_bilap : iso-level bilaplacian operator'
-         WRITE(numout,*) '~~~~~~~~~~~~~'
-      ENDIF
-
-!!bug gm this should be enough
-!!$      zuf(:,:,jpk) = 0.e0
-!!$      zut(:,:,jpk) = 0.e0
-!!$      zlu(:,:,jpk) = 0.e0
-!!$      zlv(:,:,jpk) = 0.e0
-      zuf(:,:,:) = 0._wp
-      zut(:,:,:) = 0._wp
-      zlu(:,:,:) = 0._wp
-      zlv(:,:,:) = 0._wp
-
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         ! Laplacian
-         ! ---------
-
-         IF( ln_sco .OR. ln_zps ) THEN   ! s-coordinate or z-coordinate with partial steps
-            zuf(:,:,jk) = rotb(:,:,jk) * fse3f(:,:,jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zlu(ji,jj,jk) = - ( zuf(ji,jj,jk) - zuf(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
-                     &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) / e1u(ji,jj)
-   
-                  zlv(ji,jj,jk) = + ( zuf(ji,jj,jk) - zuf(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
-                     &         + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) / e2v(ji,jj)
-               END DO
-            END DO
-         ELSE                            ! z-coordinate - full step
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zlu(ji,jj,jk) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) / e2u(ji,jj)   &
-                     &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj  ,jk) ) / e1u(ji,jj)
-   
-                  zlv(ji,jj,jk) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) / e1v(ji,jj)   &
-                     &         + ( hdivb(ji,jj+1,jk) - hdivb(ji  ,jj,jk) ) / e2v(ji,jj)
-               END DO  
-            END DO  
-         ENDIF
-      END DO
-      CALL lbc_lnk( zlu, 'U', -1. )   ;   CALL lbc_lnk( zlv, 'V', -1. )   ! Boundary conditions
-
-         
-      DO jk = 1, jpkm1
-   
-         ! Third derivative
-         ! ----------------
-         
-         ! Multiply by the eddy viscosity coef. (at u- and v-points)
-         zlu(:,:,jk) = zlu(:,:,jk) * ( fsahmu(:,:,jk) * (1-nkahm_smag) + nkahm_smag)
-
-         zlv(:,:,jk) = zlv(:,:,jk) * ( fsahmv(:,:,jk) * (1-nkahm_smag) + nkahm_smag)
-         
-         ! Contravariant "laplacian"
-         zcu(:,:) = e1u(:,:) * zlu(:,:,jk)
-         zcv(:,:) = e2v(:,:) * zlv(:,:,jk)
-         
-         ! Laplacian curl ( * e3f if s-coordinates or z-coordinate with partial steps)
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zuf(ji,jj,jk) = fmask(ji,jj,jk) * (  zcv(ji+1,jj  ) - zcv(ji,jj)      &
-                  &                            - zcu(ji  ,jj+1) + zcu(ji,jj)  )   &
-                  &       * fse3f(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) )
-            END DO  
-         END DO  
-
-         ! Laplacian Horizontal fluxes
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zlu(ji,jj,jk) = e2u(ji,jj) * fse3u(ji,jj,jk) * zlu(ji,jj,jk)
-               zlv(ji,jj,jk) = e1v(ji,jj) * fse3v(ji,jj,jk) * zlv(ji,jj,jk)
-            END DO
-         END DO
-
-         ! Laplacian divergence
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi   ! vector opt.
-               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-               zut(ji,jj,jk) = (  zlu(ji,jj,jk) - zlu(ji-1,jj  ,jk)   &
-                  &             + zlv(ji,jj,jk) - zlv(ji  ,jj-1,jk) ) / zbt
-            END DO
-         END DO
-      END DO
-
-
-      ! boundary conditions on the laplacian curl and div (zuf,zut)
-!!bug gm no need to do this 2 following lbc...
-      CALL lbc_lnk( zuf, 'F', 1. )
-      CALL lbc_lnk( zut, 'T', 1. )
-
-      DO jk = 1, jpkm1      
-   
-         ! Bilaplacian
-         ! -----------
-
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ze2u = e2u(ji,jj) * fse3u(ji,jj,jk)
-               ze2v = e1v(ji,jj) * fse3v(ji,jj,jk)
-               ! horizontal biharmonic diffusive trends
-               zua = - ( zuf(ji  ,jj,jk) - zuf(ji,jj-1,jk) ) / ze2u   &
-                  &  + ( zut(ji+1,jj,jk) - zut(ji,jj  ,jk) ) / e1u(ji,jj)
-
-               zva = + ( zuf(ji,jj  ,jk) - zuf(ji-1,jj,jk) ) / ze2v   &
-                  &  + ( zut(ji,jj+1,jk) - zut(ji  ,jj,jk) ) / e2v(ji,jj)
-               ! add it to the general momentum trends
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zua * ( fsahmu(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag ))
-               va(ji,jj,jk) = va(ji,jj,jk) + zva * ( fsahmv(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag ))
-            END DO
-         END DO
-
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-      CALL wrk_dealloc( jpi, jpj,      zcu, zcv           )
-      CALL wrk_dealloc( jpi, jpj, jpk, zuf, zut, zlu, zlv ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_bilap')
-      !
-   END SUBROUTINE dyn_ldf_bilap
-
-   !!======================================================================
-END MODULE dynldf_bilap
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90	(revision 6807)
+++ 	(revision )
@@ -1,493 +1,0 @@
-MODULE dynldf_bilapg
-   !!======================================================================
-   !!                       ***  MODULE  dynldf_bilapg  ***
-   !! Ocean dynamics:  lateral viscosity trend
-   !!======================================================================
-   !! History :  OPA  !  1997-07  (G. Madec)  Original code
-   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
-   !!            2.0  !  2004-08  (C. Talandier) New trends organization
-   !!----------------------------------------------------------------------
-#if defined key_ldfslp   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_ldfslp'                              Rotation of mixing tensor
-   !!----------------------------------------------------------------------
-   !!   dyn_ldf_bilapg : update the momentum trend with the horizontal part
-   !!                    of the horizontal s-coord. bilaplacian diffusion
-   !!   ldfguv         : 
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE ldfdyn_oce      ! ocean dynamics lateral physics
-   USE zdf_oce         ! ocean vertical physics
-   USE ldfslp          ! iso-neutral slopes available
-   USE ldftra_oce, ONLY: ln_traldf_iso
-   !
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dyn_ldf_bilapg       ! called by step.F90
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zfuw, zfvw , zdiu, zdiv   ! 2D workspace (ldfguv)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zdju, zdj1u, zdjv, zdj1v  ! 2D workspace (ldfguv)
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldfdyn_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION dyn_ldf_bilapg_alloc()
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE dyn_ldf_bilapg_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( zfuw(jpi,jpk) , zfvw (jpi,jpk) , zdiu(jpi,jpk) , zdiv (jpi,jpk) ,     &
-         &      zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_bilapg_alloc )
-         !
-      IF( dyn_ldf_bilapg_alloc /= 0 )   CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays')
-   END FUNCTION dyn_ldf_bilapg_alloc
-
-
-   SUBROUTINE dyn_ldf_bilapg( kt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE dyn_ldf_bilapg  ***
-      !!                      
-      !! ** Purpose :   Compute the before trend of the horizontal momentum
-      !!      diffusion and add it to the general trend of momentum equation.
-      !!
-      !! ** Method  :   The lateral momentum diffusive trends is provided by a 
-      !!      a 4th order operator rotated along geopotential surfaces. It is 
-      !!      computed using before fields (forward in time) and geopotential
-      !!      slopes computed in routine inildf.
-      !!         -1- compute the geopotential harmonic operator applied to
-      !!      (ub,vb) and multiply it by the eddy diffusivity coefficient
-      !!      (done by a call to ldfgpu and ldfgpv routines) The result is in
-      !!      (zwk1,zwk2) arrays. Applied the domain lateral boundary conditions
-      !!      by call to lbc_lnk.
-      !!         -2- applied to (zwk1,zwk2) the geopotential harmonic operator
-      !!      by a second call to ldfgpu and ldfgpv routines respectively. The
-      !!      result is in (zwk3,zwk4) arrays.
-      !!         -3- Add this trend to the general trend (ta,sa):
-      !!            (ua,va) = (ua,va) + (zwk3,zwk4)
-      !!
-      !! ** Action  : - Update (ua,va) arrays with the before geopotential
-      !!                biharmonic mixing trend.
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
-      !
-      INTEGER ::   ji, jj, jk                 ! dummy loop indices
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwk1, zwk2, zwk3, zwk4
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_bilapg')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 ) 
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn_ldf_bilapg : horizontal biharmonic operator in s-coordinate'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
-         !                                      ! allocate dyn_ldf_bilapg arrays
-         IF( dyn_ldf_bilapg_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_bilapg: failed to allocate arrays')
-      ENDIF
-
-      ! s-coordinate: Iso-level diffusion on tracer, but geopotential level diffusion on momentum
-      IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN
-         !
-         DO jk = 1, jpk         ! set the slopes of iso-level
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk)
-                  vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)
-                  wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5
-                  wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5
-               END DO
-            END DO
-         END DO
-         ! Lateral boundary conditions on the slopes
-         CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )
-         CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )
- 
-!!bug
-         IF( kt == nit000 ) then
-            IF(lwp) WRITE(numout,*) ' max slop: u', SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  &
-               &                             ' wi', sqrt(MAXVAL(wslpi))     , ' wj', sqrt(MAXVAL(wslpj))
-         endif
-!!end
-      ENDIF
-
-      zwk1(:,:,:) = 0.e0   ;   zwk3(:,:,:) = 0.e0
-      zwk2(:,:,:) = 0.e0   ;   zwk4(:,:,:) = 0.e0
-
-      ! Laplacian of (ub,vb) multiplied by ahm
-      ! --------------------------------------  
-      CALL ldfguv( ub, vb, zwk1, zwk2, 1 )      ! rotated harmonic operator applied to (ub,vb)
-      !                                         ! and multiply by ahmu, ahmv (output in (zwk1,zwk2) )
-      CALL lbc_lnk( zwk1, 'U', -1. )   ;   CALL lbc_lnk( zwk2, 'V', -1. )     ! Lateral boundary conditions
-
-      ! Bilaplacian of (ub,vb)
-      ! ---------------------- 
-      CALL ldfguv( zwk1, zwk2, zwk3, zwk4, 2 )  ! rotated harmonic operator applied to (zwk1,zwk2) 
-      !                                         ! (output in (zwk3,zwk4) )
-
-      ! Update the momentum trends
-      ! --------------------------
-      DO jj = 2, jpjm1               ! add the diffusive trend to the general momentum trends
-         DO jk = 1, jpkm1
-            DO ji = 2, jpim1
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zwk3(ji,jj,jk)
-               va(ji,jj,jk) = va(ji,jj,jk) + zwk4(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_bilapg')
-      !
-   END SUBROUTINE dyn_ldf_bilapg
-
-
-   SUBROUTINE ldfguv( pu, pv, plu, plv, kahm )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldfguv  ***
-      !!      
-      !! ** Purpose :   Apply a geopotential harmonic operator to (pu,pv)
-      !!      (defined at u- and v-points) and multiply it by the eddy
-      !!      viscosity coefficient (if kahm=1).
-      !!
-      !! ** Method  :   The harmonic operator rotated along geopotential 
-      !!      surfaces is applied to (pu,pv) using the slopes of geopotential
-      !!      surfaces computed in inildf routine. The result is provided in
-      !!      (plu,plv) arrays. It is computed in 2 stepv:
-      !!
-      !!      First step: horizontal part of the operator. It is computed on
-      !!      ==========  pu as follows (idem on pv)
-      !!      horizontal fluxes :
-      !!         zftu = e2u*e3u/e1u di[ pu ] - e2u*uslp dk[ mi(mk(pu)) ]
-      !!         zftv = e1v*e3v/e2v dj[ pu ] - e1v*vslp dk[ mj(mk(pu)) ]
-      !!      take the horizontal divergence of the fluxes (no divided by
-      !!      the volume element :
-      !!         plu  = di-1[ zftu ] +  dj-1[ zftv ]
-      !!
-      !!      Second step: vertical part of the operator. It is computed on
-      !!      ===========  pu as follows (idem on pv)
-      !!      vertical fluxes :
-      !!         zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2)  dk-1[ pu ]
-      !!              -     e2t     *       wslpi        di[ mi(mk(pu)) ]
-      !!              -     e1t     *       wslpj        dj[ mj(mk(pu)) ]
-      !!      take the vertical divergence of the fluxes add it to the hori-
-      !!      zontal component, divide the result by the volume element and
-      !!      if kahm=1, multiply by the eddy diffusivity coefficient:
-      !!         plu  = aht / (e1t*e2t*e3t) { plu + dk[ zftw ] }
-      !!      else:
-      !!         plu  =  1  / (e1t*e2t*e3t) { plu + dk[ zftw ] }
-      !!
-      !! ** Action :
-      !!        plu, plv        : partial harmonic operator applied to
-      !!                          pu and pv (all the components except
-      !!                          second order vertical derivative term)
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu , pv    ! 1st call: before horizontal velocity 
-      !                                                               ! 2nd call: ahm x these fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   plu, plv   ! partial harmonic operator applied to
-      !                                                               ! pu and pv (all the components except
-      !                                                               ! second order vertical derivative term)
-      INTEGER                         , INTENT(in   ) ::   kahm       ! =1 1st call ; =2 2nd call
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zabe1 , zabe2 , zcof1 , zcof2        ! local scalar
-      REAL(wp) ::   zcoef0, zcoef3, zcoef4               !   -      -
-      REAL(wp) ::   zbur, zbvr, zmkt, zmkf, zuav, zvav   !   -      -
-      REAL(wp) ::   zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      -
-      !
-      REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ldfguv')
-      !
-      CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v ) 
-      !
-      !                               ! ********** !   ! ===============
-      DO jk = 1, jpkm1                ! First step !   ! Horizontal slab
-         !                            ! ********** !   ! ===============
-
-         ! I.1 Vertical gradient of pu and pv at level jk and jk+1
-         ! -------------------------------------------------------
-         ! surface boundary condition: zdku(jk=1)=zdku(jk=2)
-         !                             zdkv(jk=1)=zdkv(jk=2)
-
-         zdk1u(:,:) = ( pu(:,:,jk) - pu(:,:,jk+1) ) * umask(:,:,jk+1)
-         zdk1v(:,:) = ( pv(:,:,jk) - pv(:,:,jk+1) ) * vmask(:,:,jk+1)
-
-         IF( jk == 1 ) THEN
-            zdku(:,:) = zdk1u(:,:)
-            zdkv(:,:) = zdk1v(:,:)
-         ELSE
-            zdku(:,:) = ( pu(:,:,jk-1) - pu(:,:,jk) ) * umask(:,:,jk)
-            zdkv(:,:) = ( pv(:,:,jk-1) - pv(:,:,jk) ) * vmask(:,:,jk)
-         ENDIF
-
-         !                                -----f-----
-         ! I.2 Horizontal fluxes on U          |
-         ! ------------------------===     t   u   t
-         !                                     |
-         ! i-flux at t-point              -----f-----
-         DO jj = 1, jpjm1
-            DO ji = 2, jpi
-               zabe1 = e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)
-
-               zmkt  = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   &
-                              + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. )
-
-               zcof1 = -e2t(ji,jj) * zmkt   &
-                     * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
-
-               ziut(ji,jj) = tmask(ji,jj,jk) *   &
-                           (  zabe1 * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) )   &
-                            + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     &
-                                       +zdk1u(ji,jj) + zdku (ji-1,jj) )  )
-            END DO
-         END DO
-
-         ! j-flux at f-point
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zabe2 = e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj)
-
-               zmkf  = 1./MAX(  umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)   &
-                              + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ), 1. )
-
-               zcof2 = -e1f(ji,jj) * zmkf   &
-                     * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
-
-               zjuf(ji,jj) = fmask(ji,jj,jk) *   &
-                           (  zabe2 * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) )   &
-                            + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     &
-                                       +zdk1u(ji,jj+1) + zdku (ji,jj) )  )
-            END DO
-         END DO
-
-         !                                 |   t   |
-         ! I.3 Horizontal fluxes on V      |       |
-         ! ------------------------===     f---v---f
-         !                                 |       |
-         ! i-flux at f-point               |   t   |
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zabe1 = e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)
-
-               zmkf  = 1./MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)   &
-                              + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ), 1. )
-
-               zcof1 = -e2f(ji,jj) * zmkf   &
-                     * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
-
-               zivf(ji,jj) = fmask(ji,jj,jk) *   &
-                           (  zabe1 * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) )   &
-                            + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj)     &
-                                       +zdk1u(ji,jj) + zdku (ji+1,jj) )  )
-            END DO
-         END DO
-
-         ! j-flux at t-point
-         DO jj = 2, jpj
-            DO ji = 1, jpim1
-               zabe2 = e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)
-
-               zmkt  = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   &
-                              + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. )
-
-               zcof2 = -e1t(ji,jj) * zmkt   &
-                     * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
-
-               zjvt(ji,jj) = tmask(ji,jj,jk) *   &
-                           (  zabe2 * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) )   &
-                            + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj)     &
-                                       +zdk1u(ji,jj-1) + zdku (ji,jj) )  )
-            END DO
-         END DO
-
-
-         ! I.4 Second derivative (divergence) (not divided by the volume)
-         ! ---------------------
-
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               plu(ji,jj,jk) = ziut (ji+1,jj) - ziut (ji,jj  )   &
-                             + zjuf (ji  ,jj) - zjuf (ji,jj-1)
-               plv(ji,jj,jk) = zivf (ji,jj  ) - zivf (ji-1,jj)   &
-                             + zjvt (ji,jj+1) - zjvt (ji,jj  ) 
-            END DO
-         END DO
-
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
-
-      !                             ! ************ !   ! ===============
-      DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
-         !                          ! ************ !   ! ===============
-
-         ! II.1 horizontal (pu,pv) gradients
-         ! ---------------------------------
-
-         DO jk = 1, jpk
-            DO ji = 2, jpi
-               ! i-gradient of u at jj
-               zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( pu(ji,jj  ,jk) - pu(ji-1,jj  ,jk) )
-               ! j-gradient of u and v at jj
-               zdju (ji,jk) = fmask(ji,jj  ,jk) * ( pu(ji,jj+1,jk) - pu(ji  ,jj  ,jk) )
-               zdjv (ji,jk) = tmask(ji,jj  ,jk) * ( pv(ji,jj  ,jk) - pv(ji  ,jj-1,jk) )
-               ! j-gradient of u and v at jj+1
-               zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( pu(ji,jj  ,jk) - pu(ji  ,jj-1,jk) )
-               zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( pv(ji,jj+1,jk) - pv(ji  ,jj  ,jk) )
-            END DO
-         END DO
-         DO jk = 1, jpk
-            DO ji = 1, jpim1
-               ! i-gradient of v at jj
-               zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( pv(ji+1,jj,jk) - pv(ji  ,jj  ,jk) )
-            END DO
-         END DO
-
-
-         ! II.2 Vertical fluxes
-         ! --------------------
-
-         ! Surface and bottom vertical fluxes set to zero
-
-         zfuw(:, 1 ) = 0.e0
-         zfvw(:, 1 ) = 0.e0
-         zfuw(:,jpk) = 0.e0
-         zfvw(:,jpk) = 0.e0
-
-         ! interior (2=<jk=<jpk-1) on pu field
-
-         DO jk = 2, jpkm1
-            DO ji = 2, jpim1
-               ! i- and j-slopes at uw-point
-               zuwslpi = 0.5 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) )
-               zuwslpj = 0.5 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) )
-               ! coef. for the vertical dirative
-               zcoef0 = e1u(ji,jj) * e2u(ji,jj) / fse3u(ji,jj,jk)   &
-                      * ( zuwslpi * zuwslpi + zuwslpj * zuwslpj )
-               ! weights for the i-k, j-k averaging at t- and f-points, resp.
-               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)   &
-                             + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. )
-               zmkf = 1./MAX(  fmask(ji,jj-1,jk-1)+fmask(ji,jj,jk-1)   &
-                             + fmask(ji,jj-1,jk  )+fmask(ji,jj,jk  ), 1. )
-               ! coef. for the horitontal derivative
-               zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi
-               zcoef4 = - e1u(ji,jj) * zmkf * zuwslpj
-               ! vertical flux on u field
-               zfuw(ji,jk) = umask(ji,jj,jk) *   &
-                           (  zcoef0 * ( pu  (ji,jj,jk-1) - pu  (ji,jj,jk) )   &
-                            + zcoef3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1)     &
-                                        +zdiu (ji,jk  ) + zdiu (ji+1,jk  ) )   &
-                            + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji  ,jk-1)     &
-                                        +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) ) )
-            END DO
-         END DO
-
-         ! interior (2=<jk=<jpk-1) on pv field
-
-         DO jk = 2, jpkm1
-            DO ji = 2, jpim1
-               ! i- and j-slopes at vw-point
-               zvwslpi = 0.5 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) )
-               zvwslpj = 0.5 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) )
-               ! coef. for the vertical derivative
-               zcoef0 = e1v(ji,jj) * e2v(ji,jj) / fse3v(ji,jj,jk)   &
-                      * ( zvwslpi * zvwslpi + zvwslpj * zvwslpj )
-               ! weights for the i-k, j-k averaging at f- and t-points, resp.
-               zmkf = 1./MAX(  fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1)   &
-                             + fmask(ji-1,jj,jk  )+fmask(ji,jj,jk  ), 1. )
-               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1)   &
-                             + tmask(ji,jj,jk  )+tmask(ji,jj+1,jk  ), 1. )
-               ! coef. for the horizontal derivatives
-               zcoef3 = - e2v(ji,jj) * zmkf * zvwslpi
-               zcoef4 = - e1v(ji,jj) * zmkt * zvwslpj
-               ! vertical flux on pv field
-               zfvw(ji,jk) = vmask(ji,jj,jk) *   &
-                           (  zcoef0 * ( pv  (ji,jj,jk-1) - pv  (ji,jj,jk) )   &
-                            + zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     &
-                                        +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   &
-                            + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     &
-                                        +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) )  )
-            END DO
-         END DO
-
-
-         ! II.3 Divergence of vertical fluxes added to the horizontal divergence
-         ! ---------------------------------------------------------------------
-         IF( (kahm -nkahm_smag) ==1 ) THEN
-            ! multiply the laplacian by the eddy viscosity coefficient
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  ! eddy coef. divided by the volume element
-                  zbur = fsahmu(ji,jj,jk) / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) )
-                  zbvr = fsahmv(ji,jj,jk) / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) )
-                  ! vertical divergence
-                  zuav = zfuw(ji,jk) - zfuw(ji,jk+1)
-                  zvav = zfvw(ji,jk) - zfvw(ji,jk+1)
-                  ! harmonic operator applied to (pu,pv) and multiply by ahm
-                  plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur
-                  plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr
-               END DO
-            END DO
-         ELSEIF( (kahm +nkahm_smag ) == 2 ) THEN
-            ! second call, no multiplication
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  ! inverse of the volume element
-                  zbur = 1. / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) )
-                  zbvr = 1. / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) )
-                  ! vertical divergence
-                  zuav = zfuw(ji,jk) - zfuw(ji,jk+1)
-                  zvav = zfvw(ji,jk) - zfvw(ji,jk+1)
-                  ! harmonic operator applied to (pu,pv) 
-                  plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur
-                  plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr
-               END DO
-            END DO
-         ELSE
-            IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm
-            IF(lwp)WRITE(numout,*) '         We stop'
-            STOP 'ldfguv'
-         ENDIF
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      CALL wrk_dealloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('ldfguv')
-      !
-   END SUBROUTINE ldfguv
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                         NO rotation of mixing tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE dyn_ldf_bilapg( kt )               ! Dummy routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'dyn_ldf_bilapg: You should not have seen this print! error?', kt
-   END SUBROUTINE dyn_ldf_bilapg
-#endif
-
-   !!======================================================================
-END MODULE dynldf_bilapg
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 6808)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                     ***  MODULE  dynldf_iso  ***
-   !! Ocean dynamics:  lateral viscosity trend
+   !! Ocean dynamics:   lateral viscosity trend (rotated laplacian operator)
    !!======================================================================
    !! History :  OPA  !  97-07  (G. Madec)  Original code
@@ -8,8 +8,8 @@
    !!             -   !  2004-08  (C. Talandier) New trends organization
    !!            2.0  !  2005-11  (G. Madec)  s-coordinate: horizontal diffusion
+   !!            3.7  !  2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification,
+   !!                 !                                   add velocity dependent coefficient and optional read in file
    !!----------------------------------------------------------------------
-#if defined key_ldfslp   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_ldfslp'                      slopes of the direction of mixing
+
    !!----------------------------------------------------------------------
    !!   dyn_ldf_iso  : update the momentum trend with the horizontal part
@@ -19,12 +19,12 @@
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
-   USE ldfdyn_oce      ! ocean dynamics lateral physics
-   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE ldfdyn          ! lateral diffusion: eddy viscosity coef.
+   USE ldftra          ! lateral physics: eddy diffusivity
    USE zdf_oce         ! ocean vertical physics
    USE ldfslp          ! iso-neutral slopes 
    !
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE in_out_manager  ! I/O manager
    USE lib_mpp         ! MPP library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE prtctl          ! Print control
    USE wrk_nemo        ! Memory Allocation
@@ -41,6 +41,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldfdyn_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -83,13 +81,13 @@
       !!      horizontal fluxes associated with the rotated lateral mixing:
       !!      u-component:
-      !!         ziut = ( ahmt + ahmb0 ) e2t * e3t / e1t  di[ ub ]
-      !!               -      ahmt       e2t * mi-1(uslp) dk[ mi(mk(ub)) ]
-      !!         zjuf = ( ahmf + ahmb0 ) e1f * e3f / e2f  dj[ ub ]
-      !!               -      ahmf       e1f * mi(vslp)   dk[ mj(mk(ub)) ]
+      !!         ziut = ( ahmt + rn_ahm_b ) e2t * e3t / e1t  di[ ub ]
+      !!               -  ahmt              e2t * mi-1(uslp) dk[ mi(mk(ub)) ]
+      !!         zjuf = ( ahmf + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ]
+      !!               -  ahmf              e1f * mi(vslp)   dk[ mj(mk(ub)) ]
       !!      v-component:
-      !!         zivf = ( ahmf + ahmb0 ) e2t * e3t / e1t  di[ vb ]
-      !!               -      ahmf       e2t * mj(uslp)   dk[ mi(mk(vb)) ]
-      !!         zjvt = ( ahmt + ahmb0 ) e1f * e3f / e2f  dj[ ub ]
-      !!               -      ahmt       e1f * mj-1(vslp) dk[ mj(mk(vb)) ]
+      !!         zivf = ( ahmf + rn_ahm_b ) e2t * e3t / e1t  di[ vb ]
+      !!               -  ahmf              e2t * mj(uslp)   dk[ mi(mk(vb)) ]
+      !!         zjvt = ( ahmt + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ]
+      !!               -  ahmt              e1f * mj-1(vslp) dk[ mj(mk(vb)) ]
       !!      take the horizontal divergence of the fluxes:
       !!         diffu = 1/(e1u*e2u*e3u) {  di  [ ziut ] + dj-1[ zjuf ]  }
@@ -106,10 +104,9 @@
       !!      of the rotated operator in dynzdf module
       !!----------------------------------------------------------------------
-      !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   zabe1, zabe2, zcof1, zcof2                       ! local scalars
-      REAL(wp) ::   zmskt, zmskf, zbu, zbv, zuah, zvah               !   -      -
+      REAL(wp) ::   zmskt, zmskf                                     !   -      -
       REAL(wp) ::   zcoef0, zcoef3, zcoef4, zmkt, zmkf               !   -      -
       REAL(wp) ::   zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      -
@@ -130,5 +127,6 @@
       ENDIF
 
-      ! s-coordinate: Iso-level diffusion on tracer, but geopotential level diffusion on momentum
+!!gm bug is dyn_ldf_iso called before tra_ldf_iso ....   <<<<<===== TO BE CHECKED
+      ! s-coordinate: Iso-level diffusion on momentum but not on tracer
       IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN
          !
@@ -136,8 +134,8 @@
             DO jj = 2, jpjm1
                DO ji = 2, jpim1
-                  uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk)
-                  vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)
-                  wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5
-                  wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5
+                  uslp (ji,jj,jk) = - ( gdept_b(ji+1,jj,jk) - gdept_b(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
+                  vslp (ji,jj,jk) = - ( gdept_b(ji,jj+1,jk) - gdept_b(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)
+                  wslpi(ji,jj,jk) = - ( gdepw_b(ji+1,jj,jk) - gdepw_b(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5
+                  wslpj(ji,jj,jk) = - ( gdepw_b(ji,jj+1,jk) - gdepw_b(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5
                END DO
             END DO
@@ -184,11 +182,26 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, jpi   ! vector opt.
-                  zabe1 = (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) / e1t(ji,jj)
-
-                  zmskt = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   &
-                     &           + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. )
-
-                  zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
+                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( e3u_n(ji,jj,jk), e3u_n(ji-1,jj,jk) ) * r1_e1t(ji,jj)
+
+                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)     &
+                     &                 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ) , 1._wp )
+
+                  zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
    
+                  ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )    &
+                     &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)      &
+                     &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         ELSE                   ! other coordinate system (zco or sco) : e3t
+            DO jj = 2, jpjm1
+               DO ji = fs_2, jpi   ! vector opt.
+                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * e3t_n(ji,jj,jk) * r1_e1t(ji,jj)
+
+                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  ) + umask(ji,jj,jk+1)     &
+                     &                 + umask(ji-1,jj,jk+1) + umask(ji,jj,jk  ) , 1._wp )
+
+                  zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
+
                   ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )   &
                      &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     &
@@ -196,19 +209,4 @@
                END DO
             END DO
-         ELSE                   ! other coordinate system (zco or sco) : e3t
-            DO jj = 2, jpjm1
-               DO ji = fs_2, jpi   ! vector opt.
-                  zabe1 = (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)
-
-                  zmskt = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   &
-                     &           + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. )
-
-                  zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
-
-                  ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )   &
-                     &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     &
-                     &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk)
-               END DO
-            END DO
          ENDIF
 
@@ -216,10 +214,10 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
-               zabe2 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj)
-
-               zmskf = 1./MAX(  umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)   &
-                  &           + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ), 1. )
-
-               zcof2 = - aht0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
+               zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * e3f_n(ji,jj,jk) * r1_e2f(ji,jj)
+
+               zmskf = 1._wp / MAX(   umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)     &
+                  &                 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ) , 1._wp )
+
+               zcof2 = - rn_aht_0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
 
                zjuf(ji,jj) = (  zabe2 * ( ub(ji,jj+1,jk) - ub(ji,jj,jk) )   &
@@ -237,14 +235,14 @@
          DO jj = 2, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
-               zabe1 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)
-
-               zmskf = 1./MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)   &
-                  &           + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ), 1. )
-
-               zcof1 = - aht0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
-
-               zivf(ji,jj) = (  zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) )   &
-                  &           + zcof1 * ( zdkv (ji,jj) + zdk1v(ji+1,jj)     &
-                  &                      +zdk1v(ji,jj) + zdkv (ji+1,jj) )  ) * fmask(ji,jj,jk)
+               zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * e3f_n(ji,jj,jk) * r1_e1f(ji,jj)
+
+               zmskf = 1._wp / MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)     &
+                  &                + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
+
+               zcof1 = - rn_aht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
+
+               zivf(ji,jj) = (  zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) )    &
+                  &           + zcof1 * (  zdkv (ji,jj) + zdk1v(ji+1,jj)      &
+                  &                      + zdk1v(ji,jj) + zdkv (ji+1,jj) )  ) * fmask(ji,jj,jk)
             END DO
          END DO
@@ -254,10 +252,25 @@
             DO jj = 2, jpj
                DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe2 = (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) / e2t(ji,jj)
+                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( e3v_n(ji,jj,jk), e3v_n(ji,jj-1,jk) ) * r1_e2t(ji,jj)
+
+                  zmskt = 1._wp / MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)     &
+                     &                + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
+
+                  zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
+
+                  zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )    &
+                     &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)      &
+                     &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         ELSE                   ! other coordinate system (zco or sco) : e3t
+            DO jj = 2, jpj
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * e3t_n(ji,jj,jk) * r1_e2t(ji,jj)
 
                   zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   &
                      &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. )
 
-                  zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
+                  zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
 
                   zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )   &
@@ -266,19 +279,4 @@
                END DO
             END DO
-         ELSE                   ! other coordinate system (zco or sco) : e3t
-            DO jj = 2, jpj
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe2 = (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)
-
-                  zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   &
-                     &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. )
-
-                  zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
-
-                  zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )   &
-                     &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)     &
-                     &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk)
-               END DO
-            END DO
          ENDIF
 
@@ -286,18 +284,10 @@
          ! Second derivative (divergence) and add to the general trend
          ! -----------------------------------------------------------
-
          DO jj = 2, jpjm1
-            DO ji = 2, jpim1          !! Question vectop possible??? !!bug
-               ! volume elements
-               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
-               ! horizontal component of isopycnal momentum diffusive trends
-               zuah =( ziut (ji+1,jj) - ziut (ji,jj  ) +   &
-                  &    zjuf (ji  ,jj) - zjuf (ji,jj-1)  ) / zbu
-               zvah =( zivf (ji,jj  ) - zivf (ji-1,jj) +   &
-                  &    zjvt (ji,jj+1) - zjvt (ji,jj  )  ) / zbv
-               ! add the trends to the general trends
-               ua (ji,jj,jk) = ua (ji,jj,jk) + zuah
-               va (ji,jj,jk) = va (ji,jj,jk) + zvah
+            DO ji = 2, jpim1          !!gm Question vectop possible??? !!bug
+               ua(ji,jj,jk) = ua(ji,jj,jk) + (  ziut(ji+1,jj) - ziut(ji,jj  )    &
+                  &                           + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + (  zivf(ji,jj  ) - zivf(ji-1,jj)    &
+                  &                           + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
             END DO
          END DO
@@ -358,13 +348,13 @@
          DO jk = 2, jpkm1
             DO ji = 2, jpim1
-               zcoef0= 0.5 * aht0 * umask(ji,jj,jk)
-
+               zcoef0= 0.5 * rn_aht_0 * umask(ji,jj,jk)
+               !
                zuwslpi = zcoef0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) )
                zuwslpj = zcoef0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) )
-
+               !
                zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)   &
                              + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. )
-               zmkf = 1./MAX(  fmask(ji,jj-1,jk-1)+fmask(ji,jj,jk-1)   &
-                             + fmask(ji,jj-1,jk  )+fmask(ji,jj,jk  ), 1. )
+               zmkf = 1./MAX(  fmask(ji,jj-1,jk-1) + fmask(ji,jj,jk-1)   &
+                             + fmask(ji,jj-1,jk  ) + fmask(ji,jj,jk  ), 1. )
 
                zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi
@@ -376,6 +366,6 @@
                                        +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) )
                ! update avmu (add isopycnal vertical coefficient to avmu)
-               ! Caution: zcoef0 include aht0, so divided by aht0 to obtain slp^2 * aht0
-               avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / aht0
+               ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / rn_aht_0
             END DO
          END DO
@@ -384,5 +374,5 @@
          DO jk = 2, jpkm1
             DO ji = 2, jpim1
-               zcoef0= 0.5 * aht0 * vmask(ji,jj,jk)
+               zcoef0 = 0.5 * rn_aht_0 * vmask(ji,jj,jk)
 
                zvwslpi = zcoef0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) )
@@ -398,10 +388,10 @@
                ! vertical flux on v field
                zfvw(ji,jk) = zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     &
-                                       +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   &
-                           + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     &
-                                       +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) )
+                  &                    +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   &
+                  &        + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     &
+                  &                    +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) )
                ! update avmv (add isopycnal vertical coefficient to avmv)
-               ! Caution: zcoef0 include aht0, so divided by aht0 to obtain slp^2 * aht0
-               avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / aht0
+               ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / rn_aht_0
             END DO
          END DO
@@ -412,13 +402,6 @@
          DO jk = 1, jpkm1
             DO ji = 2, jpim1
-               ! volume elements
-               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
-               ! part of the k-component of isopycnal momentum diffusive trends
-               zuav = ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / zbu
-               zvav = ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / zbv
-               ! add the trends to the general trends
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zuav
-               va(ji,jj,jk) = va(ji,jj,jk) + zvav
+               ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
             END DO
          END DO
@@ -432,15 +415,4 @@
    END SUBROUTINE dyn_ldf_iso
 
-# else
-   !!----------------------------------------------------------------------
-   !!   Dummy module                           NO rotation of mixing tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE dyn_ldf_iso( kt )               ! Empty routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'dyn_ldf_iso: You should not have seen this print! error?', kt
-   END SUBROUTINE dyn_ldf_iso
-#endif
-
    !!======================================================================
 END MODULE dynldf_iso
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90	(revision 6807)
+++ 	(revision )
@@ -1,100 +1,0 @@
-MODULE dynldf_lap
-   !!======================================================================
-   !!                       ***  MODULE  dynldf_lap  ***
-   !! Ocean dynamics:  lateral viscosity trend
-   !!======================================================================
-   !! History :  OPA  ! 1990-09 (G. Madec) Original code
-   !!            4.0  ! 1991-11 (G. Madec)
-   !!            6.0  ! 1996-01 (G. Madec) statement function for e3 and ahm
-   !!   NEMO     1.0  ! 2002-06 (G. Madec)  F90: Free form and module
-   !!             -   ! 2004-08 (C. Talandier) New trends organization
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dyn_ldf_lap  : update the momentum trend with the lateral diffusion
-   !!                  using an iso-level harmonic operator
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE ldfdyn_oce      ! ocean dynamics: lateral physics
-   USE zdf_oce         ! ocean vertical physics
-   !
-   USE in_out_manager  ! I/O manager
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC dyn_ldf_lap  ! called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldfdyn_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dyn_ldf_lap( kt )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE dyn_ldf_lap  ***
-      !!                       
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   The before horizontal momentum diffusion trend is an
-      !!      harmonic operator (laplacian type) which separates the divergent
-      !!      and rotational parts of the flow.
-      !!      Its horizontal components are computed as follow:
-      !!         difu = 1/e1u di[ahmt hdivb] - 1/(e2u*e3u) dj-1[e3f ahmf rotb]
-      !!         difv = 1/e2v dj[ahmt hdivb] + 1/(e1v*e3v) di-1[e3f ahmf rotb]
-      !!      in the rotational part of the diffusion.
-      !!      Add this before trend to the general trend (ua,va):
-      !!            (ua,va) = (ua,va) + (diffu,diffv)
-      !!
-      !! ** Action : - Update (ua,va) with the iso-level harmonic mixing trend
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj, jk             ! dummy loop indices
-      REAL(wp) ::   zua, zva, ze2u, ze1v   ! local scalars
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_lap')
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator'
-         IF(lwp) WRITE(numout,*) '~~~~~~~ '
-      ENDIF
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ze2u = rotb (ji,jj,jk) * fsahmf(ji,jj,jk) * fse3f(ji,jj,jk)
-               ze1v = hdivb(ji,jj,jk) * fsahmt(ji,jj,jk)
-               ! horizontal diffusive trends
-               zua = - ( ze2u - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk)*fse3f(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
-                     + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v                   ) / e1u(ji,jj)
-
-               zva = + ( ze2u - rotb (ji-1,jj,jk)*fsahmf(ji-1,jj,jk)*fse3f(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
-                     + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v                   ) / 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
-      !                                                ! ===============
-      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_lap')
-      !
-   END SUBROUTINE dyn_ldf_lap
-
-   !!======================================================================
-END MODULE dynldf_lap
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90	(revision 6808)
@@ -0,0 +1,163 @@
+MODULE dynldf_lap_blp
+   !!======================================================================
+   !!                   ***  MODULE  dynldf_lap_blp  ***
+   !! Ocean dynamics:  lateral viscosity trend (laplacian and bilaplacian)
+   !!======================================================================
+   !! History : 3.7  ! 2014-01  (G. Madec, S. Masson)  Original code, re-entrant laplacian
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_ldf_lap   : update the momentum trend with the lateral viscosity using an iso-level   laplacian operator
+   !!   dyn_ldf_blp   : update the momentum trend with the lateral viscosity using an iso-level bilaplacian operator
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
+   USE ldfslp         ! iso-neutral slopes 
+   USE zdf_oce        ! ocean vertical physics
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dyn_ldf_lap  ! called by dynldf.F90
+   PUBLIC dyn_ldf_blp  ! called by dynldf.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_ldf_lap( kt, pub, pvb, pua, pva, kpass )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dyn_ldf_lap  ***
+      !!                       
+      !! ** Purpose :   Compute the before horizontal momentum diffusive 
+      !!      trend and add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The Laplacian operator apply on horizontal velocity is 
+      !!      writen as :   grad_h( ahmt div_h(U )) - curl_h( ahmf curl_z(U) ) 
+      !!
+      !! ** Action : - pua, pva increased by the harmonic operator applied on pub, pvb.
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity  [m/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! velocity trend   [m/s2]
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zsign        ! local scalars
+      REAL(wp) ::   zua, zva     ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zcur, zdiv
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass
+         WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dyn_ldf_lap')
+      !
+      CALL wrk_alloc( jpi, jpj, zcur, zdiv ) 
+      !
+      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign
+      ELSE                    ;   zsign = -1._wp      !  (eddy viscosity coef. >0)
+      ENDIF
+      !
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         DO jj = 2, jpj
+            DO ji = fs_2, jpi   ! vector opt.
+               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1)
+!!gm open question here : e3f  at before or now ?    probably now...
+!!gm note that ahmf has already been multiplied by fmask
+               zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f_n(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &
+                  &     * (  e2v(ji  ,jj-1) * pvb(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk)  &
+                  &        - e1u(ji-1,jj  ) * pub(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk)  )
+               !                                      ! ahm * div        (computed from 2 to jpi/jpj)
+!!gm note that ahmt has already been multiplied by tmask
+               zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t_b(ji,jj,jk)                                         &
+                  &     * (  e2u(ji,jj)*e3u_b(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*e3u_b(ji-1,jj,jk) * pub(ji-1,jj,jk)  &
+                  &        + e1v(ji,jj)*e3v_b(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*e3v_b(ji,jj-1,jk) * pvb(ji,jj-1,jk)  )
+            END DO  
+         END DO  
+         !
+         DO jj = 2, jpjm1                             ! - curl( curl) + grad( div )
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * (                                                 &
+                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk)   &
+                  &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                     )
+                  !
+               pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * (                                                 &
+                  &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v_n(ji,jj,jk)   &
+                  &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                     )
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      CALL wrk_dealloc( jpi, jpj, zcur, zdiv ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_lap')
+      !
+   END SUBROUTINE dyn_ldf_lap
+
+
+   SUBROUTINE dyn_ldf_blp( kt, pub, pvb, pua, pva )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dyn_ldf_blp  ***
+      !!                    
+      !! ** Purpose :   Compute the before lateral momentum viscous trend 
+      !!              and add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The lateral viscous trends is provided by a bilaplacian
+      !!      operator applied to before field (forward in time).
+      !!      It is computed by two successive calls to dyn_ldf_lap routine
+      !!
+      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! momentum trend
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zulap, zvlap   ! laplacian at u- and v-point
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_blp')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zulap, zvlap ) 
+      !
+      IF( kt == nit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+      !
+      zulap(:,:,:) = 0._wp
+      zvlap(:,:,:) = 0._wp
+      !
+      CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 )   ! rotated laplacian applied to ptb (output in zlap)
+      !
+      CALL lbc_lnk( zulap(:,:,:) , 'U', -1. )             ! Lateral boundary conditions
+      CALL lbc_lnk( zvlap(:,:,:) , 'V', -1. )
+      !
+      CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 )   ! rotated laplacian applied to zlap (output in pta)
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zulap, zvlap ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_blp')
+      !
+   END SUBROUTINE dyn_ldf_blp
+
+   !!======================================================================
+END MODULE dynldf_lap_blp
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90	(revision 6807)
+++ 	(revision )
@@ -1,597 +1,0 @@
-MODULE dynnept
-   !!======================================================================
-   !!                       ***  MODULE  dynnept  ***
-   !! Ocean dynamics: Neptune effect as proposed by Greg Holloway,
-   !!                 recoded version of simplest case (u*, v* only)
-   !!======================================================================
-   !! History :  1.0  !  2007-06  (Michael Dunphy)  Modular form: - new namelist parameters
-   !!                                                             - horizontal diffusion for Neptune
-   !!                                                             - vertical diffusion for gm in momentum eqns
-   !!                                                             - option to use Neptune in Coriolis eqn
-   !!                    2011-08  (Jeff Blundell, NOCS) Simplified form for temporally invariant u*, v*
-   !!                                               Horizontal and vertical diffusivity formulations removed
-   !!                                               Dynamic allocation of storage added
-   !!                                               Option of ramping Neptune vel. down
-   !!                                               to zero added in shallow depths added
-   !!----------------------------------------------------------------------
-   !! dynnept_alloc        :
-   !! dyn_nept_init        :
-   !! dyn_nept_div_cur_init:
-   !! dyn_nept_cor         :
-   !! dyn_nept_vel         :
-   !! dyn_nept_smooth_vel  :
-   !!----------------------------------------------------------------------
-   USE oce              ! ocean dynamics and tracers
-   USE dom_oce          ! ocean space and time domain
-   USE in_out_manager   ! I/O manager
-   USE lib_mpp          ! distributed memory computing
-   USE prtctl           ! Print control
-   USE phycst
-   USE lbclnk
-   USE wrk_nemo        ! Memory Allocation
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC dyn_nept_init      ! routine called by nemogcm.F90
-   PUBLIC dyn_nept_cor       ! routine called by step.F90
-   !! dynnept_alloc()         is called only by dyn_nept_init, within this module
-   !! dyn_nept_div_cur_init   is called only by dyn_nept_init, within this module
-   !! dyn_nept_vel            is called only by dyn_nept_cor,  within this module
-
-   !! * Shared module variables
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)    :: zunep, zvnep  ! Neptune u and v
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: zhdivnep      ! hor. div for Neptune vel.
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: zmrotnep      ! curl for Neptune vel.
-
-
-   !! * Namelist namdyn_nept variables
-   LOGICAL, PUBLIC  ::  ln_neptsimp          ! yes/no simplified neptune
-
-   LOGICAL          ::  ln_smooth_neptvel    ! yes/no smooth zunep, zvnep
-   REAL(wp)         ::  rn_tslse             ! value of lengthscale L at the equator
-   REAL(wp)         ::  rn_tslsp             ! value of lengthscale L at the pole
-!! Specify whether to ramp down the Neptune velocity in shallow
-!! water, and the depth range controlling such ramping down
-   LOGICAL          ::  ln_neptramp          ! ramp down Neptune velocity in shallow water
-   REAL(wp)         ::  rn_htrmin            ! min. depth of transition range
-   REAL(wp)         ::  rn_htrmax            ! max. depth of transition range
-
-   !! * Module variables
-
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , implemented by Bedford Institute of Oceanography
-   !!----------------------------------------------------------------------
-
-   !! $Id$
- CONTAINS
-
-   INTEGER FUNCTION dynnept_alloc()
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE dynnept_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( zunep(jpi,jpj) , zvnep(jpi,jpj) ,     &
-         &      zhdivnep(jpi,jpj,jpk) , zmrotnep(jpi,jpj,jpk) , STAT=dynnept_alloc )
-         !
-      IF( dynnept_alloc /= 0 )   CALL ctl_warn('dynnept_alloc: array allocate failed.')
-   END FUNCTION dynnept_alloc
-
-
-   SUBROUTINE dyn_nept_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_nept_init  ***
-      !!
-      !! ** Purpose :   Read namelist parameters, initialise arrays
-      !!                and compute the arrays zunep and zvnep
-      !!
-      !! ** Method  :   zunep =
-      !!                zvnep =
-      !!
-      !! ** History :  1.0  !   07-05  (Zeliang Wang)   Original code for zunep, zvnep
-      !!               1.1  !   07-06  (Michael Dunphy) namelist and  initialisation
-      !!               2.0  ! 2011-07  (Jeff Blundell, NOCS)
-      !!                    ! Simplified form for temporally invariant u*, v*
-      !!                    ! Horizontal and vertical diffusivity formulations removed
-      !!                    ! Includes optional tapering-off in shallow depths
-      !!----------------------------------------------------------------------
-      USE iom
-      !!
-      INTEGER  ::   ji, jj, jk    ! dummy loop indices
-      REAL(wp) :: unemin,unemax,vnemin,vnemax   ! extrema of (u*, v*) fields
-      REAL(wp) :: zhdivmin,zhdivmax             ! extrema of horizontal divergence of (u*, v*) fields
-      REAL(wp) :: zmrotmin,zmrotmax             ! extrema of the curl of the (u*, v*) fields
-      REAL(wp) :: ustar,vstar                   ! (u*, v*) before tapering in shallow water
-      REAL(wp) :: hramp                         ! depth over which Neptune vel. is ramped down
-      !
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n      
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: znmask
-      !!
-      NAMELIST/namdyn_nept/ ln_neptsimp, ln_smooth_neptvel, rn_tslse, rn_tslsp,      &
-                            ln_neptramp, rn_htrmin, rn_htrmax
-      INTEGER  ::   ios
-      !!----------------------------------------------------------------------
-      ! Define the (simplified) Neptune parameters
-      ! ==========================================
-
-      REWIND( numnam_ref )              ! Namelist namdyn_nept in reference namelist : Simplified Neptune
-      READ  ( numnam_ref, namdyn_nept, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_nept in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namdyn_nept in reference namelist : Simplified Neptune
-      READ  ( numnam_cfg, namdyn_nept, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_nept in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namdyn_nept )
-
-      IF(lwp) THEN                      ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dyn_nept_init : Simplified Neptune module'
-         WRITE(numout,*) '~~~~~~~~~~~~~'
-         WRITE(numout,*) ' -->   Reading namelist namdyn_nept parameters:'
-         WRITE(numout,*) '       ln_neptsimp          = ', ln_neptsimp
-         WRITE(numout,*)
-         IF( ln_neptsimp ) THEN
-            WRITE(numout,*) '       ln_smooth_neptvel    = ', ln_smooth_neptvel
-            WRITE(numout,*) '       rn_tslse             = ', rn_tslse
-            WRITE(numout,*) '       rn_tslsp             = ', rn_tslsp
-            WRITE(numout,*)
-            WRITE(numout,*) '       ln_neptramp          = ', ln_neptramp
-            WRITE(numout,*) '       rn_htrmin            = ', rn_htrmin
-            WRITE(numout,*) '       rn_htrmax            = ', rn_htrmax
-            WRITE(numout,*)
-         ENDIF
-      ENDIF
-      !
-      IF( .NOT. ln_neptsimp ) RETURN
-      !                                 ! Dynamically allocate local work arrays
-      CALL wrk_alloc( jpi, jpj     , zht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n  ) 
-      CALL wrk_alloc( jpi, jpj, jpk, znmask                                          ) 
-
-      IF( ln_smooth_neptvel ) THEN
-         IF(lwp) WRITE(numout,*) ' -->   neptune velocities will be smoothed'
-      ELSE
-         IF(lwp) WRITE(numout,*) ' -->   neptune velocities will not be smoothed'
-      ENDIF
-
-      IF( ln_neptramp ) THEN
-          IF(lwp) WRITE(numout,*) ' -->   ln_neptramp enabled, ramp down Neptune'
-          IF(lwp) WRITE(numout,*) ' -->   velocity components in shallow water'
-      ELSE
-          IF(lwp) WRITE(numout,*) ' -->   ln_neptramp disabled'
-      ENDIF
-
-
-!!    Perform dynamic allocation of shared module variables
-      IF( dynnept_alloc() /= 0 )   CALL ctl_warn('dynnept_alloc: array allocate failed.')
-
-      IF( .not. ln_rstart ) THEN      ! If restarting, these arrays are read from the restart file
-         zhdivnep(:,:,:) = 0.0_wp
-         zmrotnep(:,:,:) = 0.0_wp
-      END IF
-
-      ! Computation of nmask: same as fmask, but fmask cannot be used
-      ! because it is modified after it is computed in dom_msk
-      ! (this can be optimised to save memory, such as merge into next loop)
-      DO jk = 1, jpk
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector loop
-               znmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
-                   &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
-            END DO
-         END DO
-      END DO
-
-      CALL lbc_lnk( znmask, 'F', 1.0_wp )
-
-
-      ! now compute zunep, zvnep (renamed from earlier versions)
-
-      zunep(:,:) = 0.0_wp
-      zvnep(:,:) = 0.0_wp
-
-      htn(:,:) = 0.0_wp            ! ocean depth at F-point
-      DO jk = 1, jpk
-         htn(:,:) = htn(:,:) + fse3f(:,:,jk) * znmask(:,:,jk)
-      END DO
-
-      IF( ln_smooth_neptvel ) THEN
-         CALL dyn_nept_smooth_vel( htn, zht, .TRUE. )
-      !! overwrites zht with a smoothed version of htn
-      ELSE
-         zht(:,:) = htn(:,:)
-      !! use unsmoothed version of htn
-      ENDIF
-      CALL lbc_lnk( zht, 'F', 1.0_wp )
-
-      !! Compute tsp, a stream function for the Neptune velocity,
-      !! with the usual geophysical sign convention
-      !! Then zunep = -latitudinal derivative "-(1/H)*d(tsp)/dy"
-      !!      zvnep = longitudinal derivative " (1/H)*d(tsp)/dx"
-
-      tsp(:,:)    = 0.0_wp
-      tscale(:,:) = 0.0_wp
-
-      tscale(:,:) = rn_tslsp + (rn_tslse - rn_tslsp) *   &
-                   ( 0.5_wp + 0.5_wp * COS( 2.0_wp * rad * gphif(:,:) )  )
-      tsp   (:,:) = -2.0_wp * omega * SIN( rad * gphif(:,:) ) * tscale(:,:) * tscale(:,:) * zht(:,:)
-
-
-      IF( ln_smooth_neptvel ) THEN
-         CALL dyn_nept_smooth_vel( hu, hu_n, .TRUE. )
-      !! overwrites hu_n with a smoothed version of hu
-      ELSE
-         hu_n(:,:) = hu(:,:)
-      !! use unsmoothed version of hu
-      ENDIF
-      CALL lbc_lnk( hu_n, 'U', 1.0_wp )
-      hu_n(:,:) = hu_n(:,:) * umask(:,:,1)
-
-      WHERE( hu_n(:,:) == 0.0_wp )
-         hur_n(:,:) = 0.0_wp
-      ELSEWHERE
-         hur_n(:,:) = 1.0_wp / hu_n(:,:)
-      END WHERE
-
-
-      IF( ln_smooth_neptvel ) THEN
-         CALL dyn_nept_smooth_vel( hv, hv_n, .TRUE. )
-      !! overwrites hv_n with a smoothed version of hv
-      ELSE
-         hv_n(:,:) = hv(:,:)
-      !! use unsmoothed version of hv
-      ENDIF
-      CALL lbc_lnk( hv_n, 'V', 1.0_wp )
-      hv_n(:,:) = hv_n(:,:) * vmask(:,:,1)
-
-      WHERE( hv_n == 0.0_wp )
-         hvr_n(:,:) = 0.0_wp
-      ELSEWHERE
-         hvr_n(:,:) = 1.0_wp / hv_n(:,:)
-      END WHERE
-
-
-      unemin =  1.0e35
-      unemax = -1.0e35
-      vnemin =  1.0e35
-      vnemax = -1.0e35
-      hramp = rn_htrmax - rn_htrmin
-      DO jj = 2, jpj-1
-         DO ji = 2, jpi-1
-            if ( umask(ji,jj,1) /= 0.0_wp ) then
-               ustar =-1.0_wp/e2u(ji,jj) * hur_n(ji,jj) * ( tsp(ji,jj)-tsp(ji,jj-1) ) * umask(ji,jj,1)
-               if ( ln_neptramp ) then
-!!                Apply ramp down to velocity component
-                  if ( hu_n(ji,jj) <= rn_htrmin ) then
-                    zunep(ji,jj) = 0.0_wp
-                   else if ( hu_n(ji,jj) >= rn_htrmax ) then
-                    zunep(ji,jj) = ustar
-                   else if ( hramp > 0.0_wp ) then
-                    zunep(ji,jj) = ( hu_n(ji,jj) - rn_htrmin) * ustar/hramp
-                  endif
-                else
-                 zunep(ji,jj) = ustar
-               endif 
-             else
-              zunep(ji,jj) = 0.0_wp
-            endif
-            if ( vmask(ji,jj,1) /= 0.0_wp ) then
-               vstar = 1.0_wp/e1v(ji,jj) * hvr_n(ji,jj) * ( tsp(ji,jj)-tsp(ji-1,jj) ) * vmask(ji,jj,1)
-               if ( ln_neptramp ) then
-!!                Apply ramp down to velocity component
-                  if ( hv_n(ji,jj) <= rn_htrmin ) then
-                    zvnep(ji,jj) = 0.0_wp
-                   else if ( hv_n(ji,jj) >= rn_htrmax ) then
-                    zvnep(ji,jj) = vstar
-                   else if ( hramp > 0.0_wp ) then
-                    zvnep(ji,jj) = ( hv_n(ji,jj) - rn_htrmin) * vstar/hramp
-                  endif
-                else
-                  zvnep(ji,jj) = vstar
-               endif
-             else
-              zvnep(ji,jj) = 0.0_wp
-            endif
-            unemin = min( unemin, zunep(ji,jj) )
-            unemax = max( unemax, zunep(ji,jj) )
-            vnemin = min( vnemin, zvnep(ji,jj) )
-            vnemax = max( vnemax, zvnep(ji,jj) )
-         END DO
-      END DO
-      CALL lbc_lnk( zunep, 'U', -1.0_wp )
-      CALL lbc_lnk( zvnep, 'V', -1.0_wp )
-      WRITE(numout,*) '      zunep: min, max       = ', unemin,unemax
-      WRITE(numout,*) '      zvnep: min, max       = ', vnemin,vnemax
-      WRITE(numout,*)
-
-      !!  Compute, once and for all, the horizontal divergence (zhdivnep)
-      !!  and the curl (zmrotnep) of the Neptune velocity field (zunep, zvnep)
-      CALL dyn_nept_div_cur_init
-
-      !! Check the ranges of the computed divergence & vorticity
-      zhdivmin =  1.0e35
-      zhdivmax = -1.0e35
-      zmrotmin =  1.0e35
-      zmrotmax = -1.0e35
-      hramp = rn_htrmax - rn_htrmin
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         DO jj = 2, jpj-1
-            DO ji = 2, jpi-1
-               zhdivmin = min( zhdivmin, zhdivnep(ji,jj,jk) )
-               zhdivmax = max( zhdivmax, zhdivnep(ji,jj,jk) )
-               zmrotmin = min( zmrotmin, zmrotnep(ji,jj,jk) )
-               zmrotmax = max( zmrotmax, zmrotnep(ji,jj,jk) )
-            END DO
-         END DO
-      END DO
-      WRITE(numout,*) '   zhdivnep: min, max       = ', zhdivmin,zhdivmax
-      WRITE(numout,*) '   zmrotnep: min, max       = ', zmrotmin,zmrotmax
-      WRITE(numout,*)
-
-!!    Deallocate temporary workspace arrays, which are all local to
-!!    this routine, except where passed as arguments to other routines
-      CALL wrk_dealloc( jpi, jpj     , zht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n  ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, znmask                                          ) 
-      !
-   END SUBROUTINE dyn_nept_init
-
-
-   SUBROUTINE dyn_nept_div_cur_init
-      !!----------------------------------------------------------------------
-      !!             ***  ROUTINE dyn_nept_div_cur_init  ***
-      !!
-      !! ** Purpose :   compute the horizontal divergence and the relative
-      !!                vorticity of the time-invariant u* and v* Neptune
-      !!                effect velocities (called zunep, zvnep)
-      !!
-      !! ** Method  : - Divergence:
-      !!      - compute the divergence given by :
-      !!         zhdivnep = 1/(e1t*e2t*e3t) ( di[e2u*e3u zunep] + dj[e1v*e3v zvnep] )
-      !!      - compute the curl in tensorial formalism:
-      !!         zmrotnep = 1/(e1f*e2f) ( di[e2v zvnep] - dj[e1u zunep] )
-      !!      Note: Coastal boundary condition: lateral friction set through
-      !!      the value of fmask along the coast (see dommsk.F90) and shlat
-      !!      (namelist parameter)
-      !!
-      !! ** Action  : - compute zhdivnep, the hor. divergence of (u*, v*)
-      !!              - compute zmrotnep, the rel. vorticity  of (u*, v*)
-      !!
-      !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code
-      !!            4.0  ! 1991-11  (G. Madec)
-      !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions
-      !!            7.0  ! 1996-01  (G. Madec)  s-coordinates
-      !!            8.0  ! 1997-06  (G. Madec)  lateral boundary cond., lbc
-      !!            8.1  ! 1997-08  (J.M. Molines)  Open boundaries
-      !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
-      !!  NEMO      1.0  ! 2002-09  (G. Madec, E. Durand)  Free form, F90
-      !!             -   ! 2005-01  (J. Chanut) Unstructured open boundaries
-      !!             -   ! 2003-08  (G. Madec)  merged of cur and div, free form, F90
-      !!             -   ! 2005-01  (J. Chanut, A. Sellar) unstructured open boundaries
-      !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
-      !!                 ! 2011-06  (Jeff Blundell, NOCS) Adapt code from divcur.F90
-      !!                 !           to compute Neptune effect fields only
-      !!----------------------------------------------------------------------
-      !
-      INTEGER  ::   ji, jj, jk          ! dummy loop indices
-      !!----------------------------------------------------------------------
-      !    
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'dyn_nept_div_cur_init :'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~'
-      IF(lwp) WRITE(numout,*) 'horizontal velocity divergence and'
-      IF(lwp) WRITE(numout,*) 'relative vorticity of Neptune flow'
-#if defined key_noslip_accurate
-   !!----------------------------------------------------------------------
-   !!   'key_noslip_accurate'                     2nd order centered scheme
-   !!                                                4th order at the coast
-   !!----------------------------------------------------------------------
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'WARNING: key_noslip_accurate option'
-      IF(lwp) WRITE(numout,*) 'not implemented in simplified Neptune'
-      CALL ctl_warn( ' noslip_accurate option not implemented' )
-#endif
-
-   !!----------------------------------------------------------------------
-   !!   Default option                           2nd order centered schemes
-   !!----------------------------------------------------------------------
-
-      ! Apply the div and curl operators to the depth-dependent velocity
-      ! field produced by multiplying (zunep, zvnep) by (umask, vmask), exactly
-      ! equivalent to the equivalent calculation in the unsimplified code
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !                                             ! --------
-         ! Horizontal divergence                       !   div
-         !                                             ! --------
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zhdivnep(ji,jj,jk) =   &
-               &   (  e2u(ji  ,jj  )*fse3u(ji  ,jj  ,jk) * zunep(ji  ,jj  ) * umask(ji  ,jj  ,jk)    &
-               &    - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk) * zunep(ji-1,jj  ) * umask(ji-1,jj  ,jk)    &
-               &    + e1v(ji  ,jj  )*fse3v(ji  ,jj  ,jk) * zvnep(ji  ,jj  ) * vmask(ji  ,jj  ,jk)    &
-               &    - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk) * zvnep(ji  ,jj-1) * vmask(ji  ,jj-1,jk) )  &
-               &  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO
-         END DO
-
-         IF( .NOT. AGRIF_Root() ) THEN
-            IF ((nbondi ==  1).OR.(nbondi == 2))  zhdivnep(nlci-1 , :     ,jk) = 0.0_wp   ! east
-            IF ((nbondi == -1).OR.(nbondi == 2))  zhdivnep(2      , :     ,jk) = 0.0_wp   ! west
-            IF ((nbondj ==  1).OR.(nbondj == 2))  zhdivnep(:      ,nlcj-1 ,jk) = 0.0_wp   ! north
-            IF ((nbondj == -1).OR.(nbondj == 2))  zhdivnep(:      ,2      ,jk) = 0.0_wp   ! south
-         ENDIF
-
-         !                                             ! --------
-         ! relative vorticity                          !   rot
-         !                                             ! --------
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zmrotnep(ji,jj,jk) =   &
-                  &       (  e2v(ji+1,jj  ) * zvnep(ji+1,jj  ) * vmask(ji+1,jj  ,jk)     &
-                  &        - e2v(ji  ,jj  ) * zvnep(ji  ,jj  ) * vmask(ji  ,jj  ,jk)     &
-                  &        - e1u(ji  ,jj+1) * zunep(ji  ,jj+1) * umask(ji  ,jj+1,jk)     &
-                  &        + e1u(ji  ,jj  ) * zunep(ji  ,jj  ) * umask(ji  ,jj  ,jk)  )  &
-                  &       * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj) )
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      ! 4. Lateral boundary conditions on zhdivnep and zmrotnep
-      ! ----------------------------------=======-----=======
-      CALL lbc_lnk( zhdivnep, 'T', 1. )   ;   CALL lbc_lnk( zmrotnep , 'F', 1. )     ! lateral boundary cond. (no sign change)
-      !
-   END SUBROUTINE dyn_nept_div_cur_init
-
-
-   SUBROUTINE dyn_nept_cor( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_nept_cor  ***
-      !!
-      !! ** Purpose :  Add or subtract the Neptune velocity from the now velocities
-      !!
-      !! ** Method  :  First call : kt not equal to lastkt -> subtract zunep, zvnep
-      !!               Second call: kt     equal to lastkt -> add zunep, zvnep
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
-      !!
-      INTEGER, SAVE :: lastkt             ! store previous kt
-      DATA lastkt/-1/                     ! initialise previous kt
-      !!----------------------------------------------------------------------
-      !
-      IF( ln_neptsimp ) THEN
-         !
-         IF( lastkt /= kt ) THEN          ! 1st call for this kt: subtract the Neptune velocities zunep, zvnep from un, vn
-            CALL dyn_nept_vel( -1 )      ! -1 = subtract
-            !
-         ELSE                              ! 2nd call for this kt: add the Neptune velocities zunep, zvnep to un, vn
-            CALL dyn_nept_vel(  1 )      !  1 = add
-            !
-         ENDIF
-         !
-         lastkt = kt     ! Store kt
-         !
-      ENDIF
-      !
-   END SUBROUTINE dyn_nept_cor
-
-
-   SUBROUTINE dyn_nept_vel( ksign )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_nept_vel  ***
-      !!
-      !! ** Purpose :  Add or subtract the Neptune velocity from the now
-      !!               velocities based on ksign
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   ksign    ! 1 or -1 to add or subtract neptune velocities
-      !!
-      INTEGER :: jk                       ! dummy loop index
-      !!----------------------------------------------------------------------
-      !
-      ! Adjust the current velocity un, vn by adding or subtracting the
-      ! Neptune velocities zunep, zvnep, as determined by argument ksign
-      DO jk=1, jpk
-         un(:,:,jk) = un(:,:,jk) + ksign * zunep(:,:) * umask(:,:,jk)
-         vn(:,:,jk) = vn(:,:,jk) + ksign * zvnep(:,:) * vmask(:,:,jk)
-      END DO
-      !
-   END SUBROUTINE dyn_nept_vel
-
-
-   SUBROUTINE dyn_nept_smooth_vel( htold, htnew, ld_option )
-
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_nept_smooth_vel  ***
-      !!
-      !! ** Purpose :  Compute smoothed topography field.
-      !!
-      !! ** Action : - Updates the array htnew (output) with a smoothed
-      !!               version of the (input) array htold. Form of smoothing
-      !!               algorithm is controlled by the (logical) argument ld_option.
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )  ::  htold      ! temporary 2D workspace
-      LOGICAL                     , INTENT(in   )  ::  ld_option  ! temporary 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)  ::  htnew      ! temporary 2D workspace
-      !
-      INTEGER                           ::  ji, jj  ! dummy loop indices
-      INTEGER , POINTER, DIMENSION(:,:) ::  nb, iwork
-      REAL(wp), POINTER, DIMENSION(:,:) ::  work    ! temporary 2D workspace
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi, jpj, nb, iwork ) 
-      CALL wrk_alloc( jpi, jpj, work      ) 
-      !
-      iwork(:,:) = 0
-
-      !! iwork is a mask of gridpoints: iwork = 1 => ocean, iwork = 0 => land
-      WHERE( htold(:,:) > 0 )
-         iwork(:,:) = 1
-         htnew(:,:) = htold(:,:)
-      ELSEWHERE
-         iwork(:,:) = 0
-         htnew(:,:) = 0.0_wp
-      END WHERE
-      !! htnew contains valid ocean depths from htold, or zero
-
-      !! set work to a smoothed/averaged version of htnew; choice controlled by ld_option
-      !! nb is set to the sum of the weights of the valid values used in work
-      IF( ld_option ) THEN
-
-         !! Apply scale-selective smoothing in determining work from htnew
-         DO jj=2,jpj-1
-            DO ji=2,jpi-1
-               work(ji,jj) = 4.0*htnew( ji , jj ) +                        &
-                           & 2.0*htnew(ji+1, jj ) + 2.0*htnew(ji-1, jj ) + &
-                           & 2.0*htnew( ji ,jj+1) + 2.0*htnew( ji ,jj-1) + &
-                           &     htnew(ji+1,jj+1) +     htnew(ji+1,jj-1) + &
-                           &     htnew(ji-1,jj+1) +     htnew(ji-1,jj-1)
-
-               nb(ji,jj)   = 4 * iwork( ji , jj ) +                        &
-                           & 2 * iwork(ji+1, jj ) + 2 * iwork(ji-1, jj ) + &
-                           & 2 * iwork( ji ,jj+1) + 2 * iwork( ji ,jj-1) + &
-                           &     iwork(ji+1,jj+1) +     iwork(ji+1,jj-1) + &
-                           &     iwork(ji-1,jj+1) +     iwork(ji-1,jj-1)
-            END DO
-         END DO
-
-      ELSE
-
-         !! Apply simple 9-point averaging in determining work from htnew
-         DO jj=2,jpj-1
-            DO ji=2,jpi-1
-               work(ji,jj) =  htnew( ji , jj ) +                    &
-                           &  htnew(ji+1, jj ) + htnew(ji-1, jj ) + &
-                           &  htnew( ji ,jj+1) + htnew( ji ,jj-1) + &
-                           &  htnew(ji+1,jj+1) + htnew(ji+1,jj-1) + &
-                           &  htnew(ji-1,jj+1) + htnew(ji-1,jj-1)
-
-               nb(ji,jj) =    iwork( ji , jj ) +                    &
-                           &  iwork(ji+1, jj ) + iwork(ji-1, jj ) + &
-                           &  iwork( ji ,jj+1) + iwork( ji ,jj-1) + &
-                           &  iwork(ji+1,jj+1) + iwork(ji+1,jj-1) + &
-                           &  iwork(ji-1,jj+1) + iwork(ji-1,jj-1)
-            END DO
-         END DO
-
-      ENDIF
-
-      !! write averaged value of work into htnew,
-      !! if average is valid and point is unmasked
-      WHERE( (htold(:,:) /= 0.0_wp ) .AND. ( nb(:,:) /= 0 ) )
-         htnew(:,:) = work(:,:)/real(nb(:,:))
-      ELSEWHERE
-         htnew(:,:) = 0.0_wp
-      END WHERE
-
-      !!    Deallocate temporary workspace arrays, all local to this routine
-      CALL wrk_dealloc( jpi, jpj, nb, iwork ) 
-      CALL wrk_dealloc( jpi, jpj, work      ) 
-      !
-   END SUBROUTINE dyn_nept_smooth_vel
-
-END MODULE dynnept
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 6808)
@@ -18,32 +18,33 @@
    !!            3.3  !  2011-03  (P. Oddo) Bug fix for time-splitting+(BDY-OBC) and not VVL
    !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes
-   !!            3.7  !  2014-04  (G. Madec) add the diagnostic of the time filter trends
+   !!            3.6  !  2014-04  (G. Madec) add the diagnostic of the time filter trends
+   !!            3.7  !  2015-11  (J. Chanut) Free surface simplification
    !!-------------------------------------------------------------------------
   
    !!-------------------------------------------------------------------------
-   !!   dyn_nxt      : obtain the next (after) horizontal velocity
+   !!   dyn_nxt       : obtain the next (after) horizontal velocity
    !!-------------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE phycst          ! physical constants
-   USE dynspg_oce      ! type of surface pressure gradient
-   USE dynadv          ! dynamics: vector invariant versus flux form
-   USE domvvl          ! variable volume
-   USE bdy_oce         ! ocean open boundary conditions
-   USE bdydta          ! ocean open boundary conditions
-   USE bdydyn          ! ocean open boundary conditions
-   USE bdyvol          ! ocean open boundary condition (bdy_vol routines)
-   USE trd_oce         ! trends: ocean variables
-   USE trddyn          ! trend manager: dynamics
-   USE trdken          ! trend manager: kinetic energy
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE phycst         ! physical constants
+   USE dynadv         ! dynamics: vector invariant versus flux form
+   USE dynspg_ts      ! surface pressure gradient: split-explicit scheme
+   USE domvvl         ! variable volume
+   USE bdy_oce        ! ocean open boundary conditions
+   USE bdydta         ! ocean open boundary conditions
+   USE bdydyn         ! ocean open boundary conditions
+   USE bdyvol         ! ocean open boundary condition (bdy_vol routines)
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics
+   USE trdken         ! trend manager: kinetic energy
    !
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O manager library
-   USE lbclnk          ! lateral boundary condition (or mpp link)
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE prtctl          ! Print control
-   USE timing          ! Timing
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lbclnk         ! lateral boundary condition (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE prtctl         ! Print control
+   USE timing         ! Timing
 #if defined key_agrif
    USE agrif_opa_interp
@@ -55,6 +56,4 @@
    PUBLIC    dyn_nxt   ! routine called by step.F90
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -68,16 +67,11 @@
       !!                  ***  ROUTINE dyn_nxt  ***
       !!                   
-      !! ** Purpose :   Compute the after horizontal velocity. Apply the boundary 
-      !!             condition on the after velocity, achieved the time stepping 
+      !! ** Purpose :   Finalize after horizontal velocity. Apply the boundary 
+      !!             condition on the after velocity, achieve the time stepping 
       !!             by applying the Asselin filter on now fields and swapping 
       !!             the fields.
       !!
-      !! ** Method  : * After velocity is compute using a leap-frog scheme:
-      !!                       (ua,va) = (ub,vb) + 2 rdt (ua,va)
-      !!             Note that with flux form advection and variable volume layer
-      !!             (lk_vvl=T), the leap-frog is applied on thickness weighted
-      !!             velocity.
-      !!             Note also that in filtered free surface (lk_dynspg_flt=T),
-      !!             the time stepping has already been done in dynspg module
+      !! ** Method  : * Ensure after velocities transport matches time splitting
+      !!             estimate (ln_dynspg_ts=T)
       !!
       !!              * Apply lateral boundary conditions on after velocity 
@@ -90,7 +84,7 @@
       !!                (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ]
       !!                (un,vn) = (ua,va).
-      !!             Note that with flux form advection and variable volume layer
-      !!             (lk_vvl=T), the time filter is applied on thickness weighted
-      !!             velocity.
+      !!             Note that with flux form advection and non linear free surface,
+      !!             the time filter is applied on thickness weighted velocity.
+      !!             As a result, dyn_nxt MUST be called after tra_nxt.
       !!
       !! ** Action :   ub,vb   filtered before horizontal velocity of next time-step
@@ -100,9 +94,6 @@
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   iku, ikv     ! local integers
-#if ! defined key_dynspg_flt
-      REAL(wp) ::   z2dt         ! temporary scalar
-#endif
-      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zec      ! local scalars
+      INTEGER  ::   ikt          ! local integers
+      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zcoef    ! local scalars
       REAL(wp) ::   zve3a, zve3n, zve3b, zvf, z1_2dt   !   -      -
       REAL(wp), POINTER, DIMENSION(:,:)   ::  zue, zve
@@ -112,6 +103,6 @@
       IF( nn_timing == 1 )   CALL timing_start('dyn_nxt')
       !
-      CALL wrk_alloc( jpi,jpj,jpk,  ze3u_f, ze3v_f, zua, zva )
-      IF( lk_dynspg_ts )   CALL wrk_alloc( jpi,jpj, zue, zve )
+      IF( ln_dynspg_ts       )   CALL wrk_alloc( jpi,jpj,       zue, zve)
+      IF( l_trddyn           )   CALL wrk_alloc( jpi,jpj,jpk,   zua, zva)
       !
       IF( kt == nit000 ) THEN
@@ -121,86 +112,48 @@
       ENDIF
 
-#if defined key_dynspg_flt
-      !
-      ! Next velocity :   Leap-frog time stepping already done in dynspg_flt.F routine
-      ! -------------
-
-      ! Update after velocity on domain lateral boundaries      (only local domain required)
-      ! --------------------------------------------------
-      CALL lbc_lnk( ua, 'U', -1. )         ! local domain boundaries
-      CALL lbc_lnk( va, 'V', -1. ) 
-      !
-#else
-
-# if defined key_dynspg_exp
-      ! Next velocity :   Leap-frog time stepping
-      ! -------------
-      z2dt = 2. * rdt                                 ! Euler or leap-frog time step 
-      IF( neuler == 0 .AND. kt == nit000 )  z2dt = rdt
-      !
-      IF( ln_dynadv_vec .OR. .NOT. lk_vvl ) THEN      ! applied on velocity
+      IF ( ln_dynspg_ts ) THEN
+         ! Ensure below that barotropic velocities match time splitting estimate
+         ! Compute actual transport and replace it with ts estimate at "after" time step
+         zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1)
+         zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1)
+         DO jk = 2, jpkm1
+            zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)
+            zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)
+         END DO
          DO jk = 1, jpkm1
-            ua(:,:,jk) = ( ub(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk)
-            va(:,:,jk) = ( vb(:,:,jk) + z2dt * va(:,:,jk) ) * vmask(:,:,jk)
+            ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk)
+            va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk)
          END DO
-      ELSE                                            ! applied on thickness weighted velocity
-         DO jk = 1, jpkm1
-            ua(:,:,jk) = (          ub(:,:,jk) * fse3u_b(:,:,jk)      &
-               &           + z2dt * ua(:,:,jk) * fse3u_n(:,:,jk)  )   &
-               &         / fse3u_a(:,:,jk) * umask(:,:,jk)
-            va(:,:,jk) = (          vb(:,:,jk) * fse3v_b(:,:,jk)      &
-               &           + z2dt * va(:,:,jk) * fse3v_n(:,:,jk)  )   &
-               &         / fse3v_a(:,:,jk) * vmask(:,:,jk)
-         END DO
-      ENDIF
-# endif
-
-# if defined key_dynspg_ts
-!!gm IF ( lk_dynspg_ts ) THEN ....
-      ! Ensure below that barotropic velocities match time splitting estimate
-      ! Compute actual transport and replace it with ts estimate at "after" time step
-      zue(:,:) = fse3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1)
-      zve(:,:) = fse3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1)
-      DO jk = 2, jpkm1
-         zue(:,:) = zue(:,:) + fse3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)
-         zve(:,:) = zve(:,:) + fse3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)
-      END DO
-      DO jk = 1, jpkm1
-         ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * hur_a(:,:) + ua_b(:,:) ) * umask(:,:,jk)
-         va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * hvr_a(:,:) + va_b(:,:) ) * vmask(:,:,jk)
-      END DO
-
-      IF (lk_dynspg_ts.AND.(.NOT.ln_bt_fw)) THEN
-         ! Remove advective velocity from "now velocities" 
-         ! prior to asselin filtering     
-         ! In the forward case, this is done below after asselin filtering   
-         ! so that asselin contribution is removed at the same time 
-         DO jk = 1, jpkm1
-            un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk)
-            vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk)
-         END DO  
-      ENDIF
-!!gm ENDIF
-# endif
+         !
+         IF( .NOT.ln_bt_fw ) THEN
+            ! Remove advective velocity from "now velocities" 
+            ! prior to asselin filtering     
+            ! In the forward case, this is done below after asselin filtering   
+            ! so that asselin contribution is removed at the same time 
+            DO jk = 1, jpkm1
+               un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk)
+               vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk)
+            END DO  
+         ENDIF
+      ENDIF
 
       ! Update after velocity on domain lateral boundaries
       ! --------------------------------------------------      
-      CALL lbc_lnk( ua, 'U', -1. )     !* local domain boundaries
-      CALL lbc_lnk( va, 'V', -1. ) 
-      !
-# if defined key_bdy
-      !                                !* BDY open boundaries
-      IF( lk_bdy .AND. lk_dynspg_exp ) CALL bdy_dyn( kt )
-      IF( lk_bdy .AND. lk_dynspg_ts  ) CALL bdy_dyn( kt, dyn3d_only=.true. )
-
-!!$   Do we need a call to bdy_vol here??
-      !
-# endif
-      !
 # if defined key_agrif
       CALL Agrif_dyn( kt )             !* AGRIF zoom boundaries
 # endif
-#endif
-
+      !
+      CALL lbc_lnk( ua, 'U', -1. )     !* local domain boundaries
+      CALL lbc_lnk( va, 'V', -1. ) 
+      !
+# if defined key_bdy
+      !                                !* BDY open boundaries
+      IF( lk_bdy .AND. ln_dynspg_exp )   CALL bdy_dyn( kt )
+      IF( lk_bdy .AND. ln_dynspg_ts  )   CALL bdy_dyn( kt, dyn3d_only=.true. )
+
+!!$   Do we need a call to bdy_vol here??
+      !
+# endif
+      !
       IF( l_trddyn ) THEN             ! prepare the atf trend computation + some diagnostics
          z1_2dt = 1._wp / (2. * rdt)        ! Euler or leap-frog time step 
@@ -229,14 +182,14 @@
             vn(:,:,jk) = va(:,:,jk)
          END DO
-         IF (lk_vvl) THEN
+         IF(.NOT.ln_linssh ) THEN
             DO jk = 1, jpkm1
-               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
-               fse3u_b(:,:,jk) = fse3u_n(:,:,jk)
-               fse3v_b(:,:,jk) = fse3v_n(:,:,jk)
-            ENDDO
+               e3t_b(:,:,jk) = e3t_n(:,:,jk)
+               e3u_b(:,:,jk) = e3u_n(:,:,jk)
+               e3v_b(:,:,jk) = e3v_n(:,:,jk)
+            END DO
          ENDIF
       ELSE                                             !* Leap-Frog : Asselin filter and swap
          !                                ! =============!
-         IF( .NOT. lk_vvl ) THEN          ! Fixed volume !
+         IF( ln_linssh ) THEN             ! Fixed volume !
             !                             ! =============!
             DO jk = 1, jpkm1                              
@@ -259,22 +212,32 @@
             ! (used as a now filtered scale factor until the swap)
             ! ----------------------------------------------------
-            IF (lk_dynspg_ts.AND.ln_bt_fw) THEN
-               ! No asselin filtering on thicknesses if forward time splitting
-                  fse3t_b(:,:,:) = fse3t_n(:,:,:)
+            IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN    ! No asselin filtering on thicknesses if forward time splitting
+               e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1)
             ELSE
-               fse3t_b(:,:,:) = fse3t_n(:,:,:) + atfp * ( fse3t_b(:,:,:) - 2._wp * fse3t_n(:,:,:) + fse3t_a(:,:,:) )
+               DO jk = 1, jpkm1
+                  e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) )
+               END DO
                ! Add volume filter correction: compatibility with tracer advection scheme
                ! => time filter + conservation correction (only at the first level)
-               fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) &
-                              &                                          -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1)
+               zcoef = atfp * rdt * r1_rau0
+               IF ( .NOT. ln_isf ) THEN   ! if no ice shelf melting
+                  e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) &
+                                 &                      - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1)
+               ELSE                     ! if ice shelf melting
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        ikt = mikt(ji,jj)
+                        e3t_b(ji,jj,ikt) = e3t_b(ji,jj,ikt) - zcoef * (  emp_b   (ji,jj) - emp   (ji,jj)  &
+                           &                                           - rnf_b   (ji,jj) + rnf   (ji,jj)  &
+                           &                                           + fwfisf_b(ji,jj) - fwfisf(ji,jj)  ) * tmask(ji,jj,ikt)
+                     END DO
+                  END DO
+               END IF
             ENDIF
             !
-            IF( ln_dynadv_vec ) THEN
-               ! Before scale factor at (u/v)-points
-               ! -----------------------------------
-               CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' )
-               CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' )
-               ! Leap-Frog - Asselin filter and swap: applied on velocity
-               ! -----------------------------------
+            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity
+               ! Before filtered scale factor at (u/v)-points
+               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
+               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
                DO jk = 1, jpkm1
                   DO jj = 1, jpj
@@ -291,20 +254,19 @@
                END DO
                !
-            ELSE
-               ! Temporary filtered scale factor at (u/v)-points (will become before scale factor)
-               !------------------------------------------------
-               CALL dom_vvl_interpol( fse3t_b(:,:,:), ze3u_f, 'U' )
-               CALL dom_vvl_interpol( fse3t_b(:,:,:), ze3v_f, 'V' )
-               ! Leap-Frog - Asselin filter and swap: applied on thickness weighted velocity
-               ! -----------------------------------             ===========================
+            ELSE                          ! Asselin filter applied on thickness weighted velocity
+               !
+               CALL wrk_alloc( jpi,jpj,jpk,   ze3u_f, ze3v_f )
+               ! Before filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f
+               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' )
+               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' )
                DO jk = 1, jpkm1
                   DO jj = 1, jpj
                      DO ji = 1, jpi                  
-                        zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk)
-                        zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk)
-                        zue3n = un(ji,jj,jk) * fse3u_n(ji,jj,jk)
-                        zve3n = vn(ji,jj,jk) * fse3v_n(ji,jj,jk)
-                        zue3b = ub(ji,jj,jk) * fse3u_b(ji,jj,jk)
-                        zve3b = vb(ji,jj,jk) * fse3v_b(ji,jj,jk)
+                        zue3a = e3u_a(ji,jj,jk) * ua(ji,jj,jk)
+                        zve3a = e3v_a(ji,jj,jk) * va(ji,jj,jk)
+                        zue3n = e3u_n(ji,jj,jk) * un(ji,jj,jk)
+                        zve3n = e3v_n(ji,jj,jk) * vn(ji,jj,jk)
+                        zue3b = e3u_b(ji,jj,jk) * ub(ji,jj,jk)
+                        zve3b = e3v_b(ji,jj,jk) * vb(ji,jj,jk)
                         !
                         zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk)
@@ -318,22 +280,24 @@
                   END DO
                END DO
-               fse3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)      ! e3u_b <-- filtered scale factor
-               fse3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1)
+               e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)        ! e3u_b <-- filtered scale factor
+               e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1)
+               !
+               CALL wrk_dealloc( jpi,jpj,jpk,   ze3u_f, ze3v_f )
             ENDIF
             !
          ENDIF
          !
-         IF (lk_dynspg_ts.AND.ln_bt_fw) THEN
+         IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN
             ! Revert "before" velocities to time split estimate
             ! Doing it here also means that asselin filter contribution is removed  
-            zue(:,:) = fse3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1)
-            zve(:,:) = fse3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)    
+            zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1)
+            zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)    
             DO jk = 2, jpkm1
-               zue(:,:) = zue(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)
-               zve(:,:) = zve(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)    
+               zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)
+               zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)    
             END DO
             DO jk = 1, jpkm1
-               ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * hur(:,:) - un_b(:,:)) * umask(:,:,jk)
-               vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * hvr(:,:) - vn_b(:,:)) * vmask(:,:,jk)
+               ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk)
+               vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk)
             END DO
          ENDIF
@@ -346,38 +310,34 @@
       !
       !
-      IF (lk_vvl) THEN
-         hu_b(:,:) = 0.
-         hv_b(:,:) = 0.
-         DO jk = 1, jpkm1
-            hu_b(:,:) = hu_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk)
-            hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk)
+      IF(.NOT.ln_linssh ) THEN
+         hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1)
+         hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1)
+         DO jk = 2, jpkm1
+            hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk)
+            hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk)
          END DO
-         hur_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1._wp - umask_i(:,:) )
-         hvr_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1._wp - vmask_i(:,:) )
-      ENDIF
-      !
-      un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp
-      ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp
-      !
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               un_b(ji,jj) = un_b(ji,jj) + fse3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)
-               vn_b(ji,jj) = vn_b(ji,jj) + fse3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)
-               !
-               ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk)
-               vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk)
-            END DO
-         END DO
+         r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )
+         r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) )
+      ENDIF
+      !
+      un_b(:,:) = e3u_a(:,:,1) * un(:,:,1) * umask(:,:,1)
+      ub_b(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1)
+      vn_b(:,:) = e3v_a(:,:,1) * vn(:,:,1) * vmask(:,:,1)
+      vb_b(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)
+      DO jk = 2, jpkm1
+         un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(:,:,jk)
+         ub_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)
+         vn_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk)
+         vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)
       END DO
-      !
-      !
-      un_b(:,:) = un_b(:,:) * hur_a(:,:)
-      vn_b(:,:) = vn_b(:,:) * hvr_a(:,:)
-      ub_b(:,:) = ub_b(:,:) * hur_b(:,:)
-      vb_b(:,:) = vb_b(:,:) * hvr_b(:,:)
-      !
-      !
-
+      un_b(:,:) = un_b(:,:) * r1_hu_a(:,:)
+      vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:)
+      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)
+      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)
+      !
+      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents
+         CALL iom_put(  "ubar", un_b(:,:) )
+         CALL iom_put(  "vbar", vn_b(:,:) )
+      ENDIF
       IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum
          zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt
@@ -389,6 +349,6 @@
          &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask )
       ! 
-      CALL wrk_dealloc( jpi,jpj,jpk,  ze3u_f, ze3v_f, zua, zva )
-      IF( lk_dynspg_ts )   CALL wrk_dealloc( jpi,jpj, zue, zve )
+      IF( ln_dynspg_ts )   CALL wrk_dealloc( jpi,jpj,       zue, zve )
+      IF( l_trddyn     )   CALL wrk_dealloc( jpi,jpj,jpk,   zua, zva )
       !
       IF( nn_timing == 1 )  CALL timing_stop('dyn_nxt')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 6808)
@@ -9,6 +9,6 @@
 
    !!----------------------------------------------------------------------
-   !!   dyn_spg     : update the dynamics trend with the lateral diffusion
-   !!   dyn_spg_ctl : initialization, namelist read, and parameters control
+   !!   dyn_spg     : update the dynamics trend with surface pressure gradient 
+   !!   dyn_spg_init: initialization, namelist read, and parameters control
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers variables
@@ -18,12 +18,8 @@
    USE sbc_oce        ! surface boundary condition: ocean
    USE sbcapr         ! surface boundary condition: atmospheric pressure
-   USE dynspg_oce     ! surface pressure gradient variables
    USE dynspg_exp     ! surface pressure gradient     (dyn_spg_exp routine)
    USE dynspg_ts      ! surface pressure gradient     (dyn_spg_ts  routine)
-   USE dynspg_flt     ! surface pressure gradient     (dyn_spg_flt routine)
-   USE dynadv         ! dynamics: vector invariant versus flux form
-   USE dynhpg, ONLY: ln_dynhpg_imp
-   USE sbctide
-   USE updtide
+   USE sbctide        ! 
+   USE updtide        ! 
    USE trd_oce        ! trends: ocean variables
    USE trddyn         ! trend manager: dynamics
@@ -32,9 +28,7 @@
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
-   USE solver         ! solver initialization
    USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
 
-
    IMPLICIT NONE
    PRIVATE
@@ -45,6 +39,10 @@
    INTEGER ::   nspg = 0   ! type of surface pressure gradient scheme defined from lk_dynspg_... 
 
+   !                       ! Parameter to control the surface pressure gradient scheme
+   INTEGER, PARAMETER ::   np_TS  = 1   ! split-explicit time stepping (Time-Splitting)
+   INTEGER, PARAMETER ::   np_EXP = 0   !       explicit time stepping
+   INTEGER, PARAMETER ::   np_NO  =-1   ! no surface pressure gradient, no scheme
+
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -55,19 +53,14 @@
 CONTAINS
 
-   SUBROUTINE dyn_spg( kt, kindic )
+   SUBROUTINE dyn_spg( kt )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_spg  ***
       !!
-      !! ** Purpose :   achieve the momentum time stepping by computing the
-      !!              last trend, the surface pressure gradient including the 
-      !!              atmospheric pressure forcing (ln_apr_dyn=T), and performing
-      !!              the Leap-Frog integration.
-      !!gm              In the current version only the filtered solution provide
-      !!gm            the after velocity, in the 2 other (ua,va) are still the trends
+      !! ** Purpose :   compute surface pressure gradient including the 
+      !!              atmospheric pressure forcing (ln_apr_dyn=T).
       !!
-      !! ** Method  :   Three schemes:
-      !!              - explicit computation      : the spg is evaluated at now
-      !!              - filtered computation      : the Roulet & madec (2000) technique is used
-      !!              - split-explicit computation: a time splitting technique is used
+      !! ** Method  :   Two schemes:
+      !!              - explicit       : the spg is evaluated at now
+      !!              - split-explicit : a time splitting technique is used
       !!
       !!              ln_apr_dyn=T : the atmospheric pressure forcing is applied 
@@ -77,11 +70,6 @@
       !!             Note that as all external forcing a time averaging over a two rdt
       !!             period is used to prevent the divergence of odd and even time step.
-      !!
-      !! N.B. : When key_esopa is used all the scheme are tested, regardless 
-      !!        of the physical meaning of the results. 
-      !!----------------------------------------------------------------------
-      !
+      !!----------------------------------------------------------------------
       INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
-      INTEGER, INTENT(  out) ::   kindic   ! solver flag
       !
       INTEGER  ::   ji, jj, jk                             ! dummy loop indices
@@ -93,18 +81,12 @@
       IF( nn_timing == 1 )  CALL timing_start('dyn_spg')
       !
-
-!!gm NOTA BENE : the dynspg_exp and dynspg_ts should be modified so that 
-!!gm             they return the after velocity, not the trends (as in trazdf_imp...)
-!!gm             In this case, change/simplify dynnxt
-
-
       IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
          ztrdu(:,:,:) = ua(:,:,:)
          ztrdv(:,:,:) = va(:,:,:)
       ENDIF
-
+      !
       IF(      ln_apr_dyn                                                &   ! atmos. pressure
-         .OR.  ( .NOT.lk_dynspg_ts .AND. (ln_tide_pot .AND. lk_tide) )   &   ! tide potential (no time slitting)
+         .OR.  ( .NOT.ln_dynspg_ts .AND. (ln_tide_pot .AND. lk_tide) )   &   ! tide potential (no time slitting)
          .OR.  nn_ice_embd == 2  ) THEN                                      ! embedded sea-ice
          !
@@ -116,12 +98,12 @@
          END DO         
          !
-         IF( ln_apr_dyn .AND. (.NOT. lk_dynspg_ts) ) THEN                    !==  Atmospheric pressure gradient (added later in time-split case) ==!
+         IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN   !==  Atmospheric pressure gradient (added later in time-split case) ==!
             zg_2 = grav * 0.5
             DO jj = 2, jpjm1                          ! gradient of Patm using inverse barometer ssh
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   spgu(ji,jj) = spgu(ji,jj) + zg_2 * (  ssh_ib (ji+1,jj) - ssh_ib (ji,jj)    &
-                     &                      + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) /e1u(ji,jj)
+                     &                      + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
                   spgv(ji,jj) = spgv(ji,jj) + zg_2 * (  ssh_ib (ji,jj+1) - ssh_ib (ji,jj)    &
-                     &                      + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) /e2v(ji,jj)
+                     &                      + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
                END DO
             END DO
@@ -129,5 +111,5 @@
          !
          !                                    !==  tide potential forcing term  ==!
-         IF( .NOT.lk_dynspg_ts .AND. ( ln_tide_pot .AND. lk_tide )  ) THEN   ! N.B. added directly at sub-time-step in ts-case
+         IF( .NOT.ln_dynspg_ts .AND. ( ln_tide_pot .AND. lk_tide )  ) THEN   ! N.B. added directly at sub-time-step in ts-case
             !
             CALL upd_tide( kt )                      ! update tide potential
@@ -135,6 +117,6 @@
             DO jj = 2, jpjm1                         ! add tide potential forcing
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj)
-                  spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj)
+                  spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
+                  spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
                END DO 
             END DO
@@ -142,5 +124,5 @@
          !
          IF( nn_ice_embd == 2 ) THEN          !== embedded sea ice: Pressure gradient due to snow-ice mass ==!
-            CALL wrk_alloc( jpi, jpj, zpice )
+            CALL wrk_alloc( jpi,jpj,   zpice )
             !                                            
             zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc )
@@ -149,13 +131,13 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj)
-                  spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj)
+                  spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
+                  spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
                END DO
             END DO
             !
-            CALL wrk_dealloc( jpi, jpj, zpice )         
+            CALL wrk_dealloc( jpi,jpj,   zpice )         
          ENDIF
          !
-         DO jk = 1, jpkm1                     !== Add all terms to the general trend
+         DO jk = 1, jpkm1                    !== Add all terms to the general trend
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -165,43 +147,21 @@
             END DO
          END DO    
-         
+         !
 !!gm add here a call to dyn_trd for ice pressure gradient, the surf pressure trends ????
-              
-      ENDIF
-
-      SELECT CASE ( nspg )                       ! compute surf. pressure gradient trend and add it to the general trend
-      !                                                     
-      CASE (  0 )   ;   CALL dyn_spg_exp( kt )              ! explicit
-      CASE (  1 )   ;   CALL dyn_spg_ts ( kt )              ! time-splitting
-      CASE (  2 )   ;   CALL dyn_spg_flt( kt, kindic )      ! filtered
-      !                                                    
-      CASE ( -1 )                                ! esopa: test all possibility with control print
-                        CALL dyn_spg_exp( kt )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' spg0 - Ua: ', mask1=umask, &
-         &                            tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-                        CALL dyn_spg_ts ( kt )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' spg1 - Ua: ', mask1=umask, &
-         &                           tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-                        CALL dyn_spg_flt( kt, kindic )
-                        CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, &
-         &                            tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+         !    
+      ENDIF
+      !
+      SELECT CASE ( nspg )                   !== surface pressure gradient computed and add to the general trend ==!
+      CASE ( np_EXP )   ;   CALL dyn_spg_exp( kt )              ! explicit
+      CASE ( np_TS  )   ;   CALL dyn_spg_ts ( kt )              ! time-splitting
       END SELECT
       !                    
-      IF( l_trddyn )   THEN                      ! save the surface pressure gradient trends for further diagnostics
-         SELECT CASE ( nspg )
-         CASE ( 0, 1 )
-            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CASE( 2 )
-            z2dt = 2. * rdt
-            IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt
-            ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / z2dt - ztrdu(:,:,:)
-            ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / z2dt - ztrdv(:,:,:)
-         END SELECT
+      IF( l_trddyn )   THEN                  ! save the surface pressure gradient trends for further diagnostics
+         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
          CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt )
-         !
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
-      ENDIF
-      !                                          ! print mean trends (used for debugging)
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
+      ENDIF
+      !                                      ! print mean trends (used for debugging)
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg  - Ua: ', mask1=umask, &
          &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
@@ -216,68 +176,53 @@
       !!                  ***  ROUTINE dyn_spg_init  ***
       !!                
-      !! ** Purpose :   Control the consistency between cpp options for 
+      !! ** Purpose :   Control the consistency between namelist options for 
       !!              surface pressure gradient schemes
       !!----------------------------------------------------------------------
-      INTEGER ::   ioptio
+      INTEGER ::   ioptio, ios   ! local integers
+      !
+      NAMELIST/namdyn_spg/ ln_dynspg_exp       , ln_dynspg_ts,   &
+      &                    ln_bt_fw, ln_bt_av  , ln_bt_auto  ,   &
+      &                    nn_baro , rn_bt_cmax, nn_bt_flt
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('dyn_spg_init')
       !
-      IF(lwp) THEN             ! Control print
+      REWIND( numnam_ref )              ! Namelist namdyn_spg in reference namelist : Free surface
+      READ  ( numnam_ref, namdyn_spg, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_spg in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namdyn_spg in configuration namelist : Free surface
+      READ  ( numnam_cfg, namdyn_spg, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdyn_spg )
+      !
+      IF(lwp) THEN             ! Namelist print
          WRITE(numout,*)
          WRITE(numout,*) 'dyn_spg_init : choice of the surface pressure gradient scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '     Explicit free surface                  lk_dynspg_exp = ', lk_dynspg_exp
-         WRITE(numout,*) '     Free surface with time splitting       lk_dynspg_ts  = ', lk_dynspg_ts
-         WRITE(numout,*) '     Filtered free surface cst volume       lk_dynspg_flt = ', lk_dynspg_flt
-      ENDIF
-
-      IF( lk_dynspg_ts ) CALL dyn_spg_ts_init( nit000 )
-      ! (do it now, to set nn_baro, used to allocate some arrays later on)
-      !                        ! allocate dyn_spg arrays
-      IF( lk_dynspg_ts ) THEN
-         IF( dynspg_oce_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_oce arrays')
-         IF( dyn_spg_ts_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_ts  arrays')
-         IF ((neuler/=0).AND.(ln_bt_fw)) CALL ts_rst( nit000, 'READ' )
-      ENDIF
-
-      !                        ! Control of surface pressure gradient scheme options
-      ioptio = 0
-      IF(lk_dynspg_exp)   ioptio = ioptio + 1
-      IF(lk_dynspg_ts )   ioptio = ioptio + 1
-      IF(lk_dynspg_flt)   ioptio = ioptio + 1
-      !
-      IF( ( ioptio > 1 .AND. .NOT. lk_esopa ) .OR. ( ioptio == 0 .AND. .NOT. lk_c1d ) )   &
-           &   CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' )
-      IF( ( lk_dynspg_ts .OR. lk_dynspg_exp ) .AND. ln_isfcav )   &
-           &   CALL ctl_stop( ' dynspg_ts and dynspg_exp not tested with ice shelf cavity ' )
-      !
-      IF( lk_esopa     )   nspg = -1
-      IF( lk_dynspg_exp)   nspg =  0
-      IF( lk_dynspg_ts )   nspg =  1
-      IF( lk_dynspg_flt)   nspg =  2
-      !
-      IF( lk_esopa     )   nspg = -1
+         WRITE(numout,*) '     Explicit free surface                  ln_dynspg_exp = ', ln_dynspg_exp
+         WRITE(numout,*) '     Free surface with time splitting       ln_dynspg_ts  = ', ln_dynspg_ts
+      ENDIF
+      !                          ! Control of surface pressure gradient scheme options
+      ;                              nspg =  np_NO    ;   ioptio = 0
+      IF( ln_dynspg_exp ) THEN   ;   nspg =  np_EXP   ;   ioptio = ioptio + 1   ;   ENDIF
+      IF( ln_dynspg_ts  ) THEN   ;   nspg =  np_TS    ;   ioptio = ioptio + 1   ;   ENDIF
+      !
+      IF( ioptio  > 1 )   CALL ctl_stop( 'Choose only one surface pressure gradient scheme' )
+      IF( ioptio == 0 )   CALL ctl_warn( 'NO surface pressure gradient trend in momentum Eqs.' )
+      IF( ln_dynspg_exp .AND. ln_isfcav )   &
+           &   CALL ctl_stop( ' dynspg_exp not tested with ice shelf cavity ' )
       !
       IF(lwp) THEN
          WRITE(numout,*)
-         IF( nspg == -1 )   WRITE(numout,*) '     ESOPA test All scheme used'
-         IF( nspg ==  0 )   WRITE(numout,*) '     explicit free surface'
-         IF( nspg ==  1 )   WRITE(numout,*) '     free surface with time splitting scheme'
-         IF( nspg ==  2 )   WRITE(numout,*) '     filtered free surface'
-      ENDIF
-
-#if defined key_dynspg_flt || defined key_esopa
-      CALL solver_init( nit000 )   ! Elliptic solver initialisation
-#endif
-
-      !                        ! Control of timestep choice
-      IF( lk_dynspg_ts .OR. lk_dynspg_exp ) THEN
-         IF( nn_cla == 1 )   CALL ctl_stop( 'Crossland advection not implemented for this free surface formulation' )
-      ENDIF
-
-      !			       ! Control of hydrostatic pressure choice
-      IF( lk_dynspg_ts .AND. ln_dynhpg_imp ) THEN
-         CALL ctl_stop( 'Semi-implicit hpg not compatible with time splitting' )
+         IF( nspg == np_EXP )   WRITE(numout,*) '     explicit free surface'
+         IF( nspg == np_TS  )   WRITE(numout,*) '     free surface with time splitting scheme'
+         IF( nspg == np_NO  )   WRITE(numout,*) '     No surface surface pressure gradient trend in momentum Eqs.'
+      ENDIF
+      !
+      IF( nspg == np_TS ) THEN   ! split-explicit scheme initialisation
+         CALL dyn_spg_ts_init          ! do it first: set nn_baro used to allocate some arrays later on
+         IF( dyn_spg_ts_alloc() /= 0  )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_ts  arrays' )
+         IF( neuler/=0 .AND. ln_bt_fw )   CALL ts_rst( nit000, 'READ' )
       ENDIF
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 6808)
@@ -2,12 +2,10 @@
    !!======================================================================
    !!                   ***  MODULE  dynspg_exp  ***
-   !! Ocean dynamics:  surface pressure gradient trend
+   !! Ocean dynamics:  surface pressure gradient trend, explicit scheme
    !!======================================================================
    !! History :  2.0  !  2005-11  (V. Garnier, G. Madec, L. Bessieres) Original code
    !!            3.2  !  2009-06  (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module
    !!----------------------------------------------------------------------
-#if defined key_dynspg_exp   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_dynspg_exp'                              explicit free surface
+
    !!----------------------------------------------------------------------
    !!   dyn_spg_exp  : update the momentum trend with the surface 
@@ -27,12 +25,10 @@
    USE timing          ! Timing
 
-
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   dyn_spg_exp   ! routine called by step.F90
+   PUBLIC   dyn_spg_exp   ! routine called by dynspg.F90 
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -74,13 +70,13 @@
          spgu(:,:) = 0._wp   ;   spgv(:,:) = 0._wp
          !
-         IF( lk_vvl .AND. lwp ) WRITE(numout,*) '              lk_vvl=T : spg is included in dynhpg'
+         IF( .NOT.ln_linssh .AND. lwp ) WRITE(numout,*) '      non linear free surface: spg is included in dynhpg'
       ENDIF
 
-      IF( .NOT. lk_vvl ) THEN          !* fixed volume : add the surface pressure gradient trend
+      IF( ln_linssh ) THEN          !* linear free surface : add the surface pressure gradient trend
          !
          DO jj = 2, jpjm1                    ! now surface pressure gradient
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) / e1u(ji,jj)
-               spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) / e2v(ji,jj)
+               spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj)
+               spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj)
             END DO 
          END DO
@@ -101,14 +97,4 @@
    END SUBROUTINE dyn_spg_exp
 
-#else
-   !!----------------------------------------------------------------------
-   !!   Default case :   Empty module   No standart explicit free surface 
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE dyn_spg_exp( kt )       ! Empty routine
-      WRITE(*,*) 'dyn_spg_exp: You should not have seen this print! error?', kt
-   END SUBROUTINE dyn_spg_exp
-#endif
-
    !!======================================================================
 END MODULE dynspg_exp
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90	(revision 6807)
+++ 	(revision )
@@ -1,426 +1,0 @@
-MODULE dynspg_flt
-   !!======================================================================
-   !!                   ***  MODULE  dynspg_flt  ***
-   !! Ocean dynamics:  surface pressure gradient trend
-   !!======================================================================
-   !! History    OPA  !  1998-05  (G. Roullet)  free surface
-   !!                 !  1998-10  (G. Madec, M. Imbard)  release 8.2
-   !!   NEMO     O.1  !  2002-08  (G. Madec)  F90: Free form and module
-   !!             -   !  2002-11  (C. Talandier, A-M Treguier) Open boundaries
-   !!            1.0  !  2004-08  (C. Talandier) New trends organization
-   !!             -   !  2005-11  (V. Garnier) Surface pressure gradient organization
-   !!            2.0  !  2006-07  (S. Masson)  distributed restart using iom
-   !!             -   !  2006-08  (J.Chanut, A.Sellar) Calls to BDY routines. 
-   !!            3.2  !  2009-03  (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module
-   !!            3.7  !  2014-04  (F. Roquet, G. Madec)  add some trends diag
-   !!----------------------------------------------------------------------
-#if defined key_dynspg_flt   ||   defined key_esopa  
-   !!----------------------------------------------------------------------
-   !!   'key_dynspg_flt'                              filtered free surface
-   !!----------------------------------------------------------------------
-   !!   dyn_spg_flt  : update the momentum trend with the surface pressure gradient in the filtered free surface case 
-   !!   flt_rst      : read/write the time-splitting restart fields in the ocean restart file
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers 
-   USE dom_oce         ! ocean space and time domain 
-   USE zdf_oce         ! ocean vertical physics
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE bdy_oce         ! Lateral open boundary condition
-   USE sol_oce         ! ocean elliptic solver
-   USE phycst          ! physical constants
-   USE domvvl          ! variable volume
-   USE dynadv          ! advection 
-   USE solmat          ! matrix construction for elliptic solvers
-   USE solpcg          ! preconditionned conjugate gradient solver
-   USE solsor          ! Successive Over-relaxation solver
-   USE bdydyn          ! ocean open boundary condition on dynamics
-   USE bdyvol          ! ocean open boundary condition (bdy_vol routine)
-   USE cla             ! cross land advection
-   USE trd_oce         ! trends: ocean variables
-   USE trddyn          ! trend manager: dynamics
-   !
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distributed memory computing library
-   USE wrk_nemo        ! Memory Allocation
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE iom
-   USE lib_fortran
-   USE timing          ! Timing
-#if defined key_agrif
-   USE agrif_opa_interp
-#endif
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dyn_spg_flt  ! routine called by step.F90
-   PUBLIC   flt_rst      ! routine called by istate.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dyn_spg_flt( kt, kindic )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine dyn_spg_flt  ***
-      !!
-      !! ** Purpose :   Compute the now trend due to the surface pressure 
-      !!      gradient in case of filtered free surface formulation  and add
-      !!      it to the general trend of momentum equation.
-      !!
-      !! ** Method  :   Filtered free surface formulation. The surface
-      !!      pressure gradient is given by:
-      !!         spgu = 1/rau0 d/dx(ps) =  1/e1u di( sshn + btda )
-      !!         spgv = 1/rau0 d/dy(ps) =  1/e2v dj( sshn + btda )
-      !!      where sshn is the free surface elevation and btda is the after
-      !!      time derivative of the free surface elevation
-      !!       -1- evaluate the surface presure trend (including the addi-
-      !!      tional force) in three steps:
-      !!        a- compute the right hand side of the elliptic equation:
-      !!            gcb = 1/(e1t e2t) [ di(e2u spgu) + dj(e1v spgv) ]
-      !!         where (spgu,spgv) are given by:
-      !!            spgu = vertical sum[ e3u (ub+ 2 rdt ua ) ]
-      !!                 - grav 2 rdt hu /e1u di[sshn + (emp-rnf)]
-      !!            spgv = vertical sum[ e3v (vb+ 2 rdt va) ]
-      !!                 - grav 2 rdt hv /e2v dj[sshn + (emp-rnf)]
-      !!         and define the first guess from previous computation :
-      !!            zbtd = btda
-      !!            btda = 2 zbtd - btdb
-      !!            btdb = zbtd
-      !!        b- compute the relative accuracy to be reached by the
-      !!         iterative solver
-      !!        c- apply the solver by a call to sol... routine
-      !!       -2- compute and add the free surface pressure gradient inclu-
-      !!      ding the additional force used to stabilize the equation.
-      !!
-      !! ** Action : - Update (ua,va) with the surf. pressure gradient trend
-      !!
-      !! References : Roullet and Madec, JGR, 2000.
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
-      INTEGER, INTENT(  out) ::   kindic   ! solver convergence flag (<0 if not converge)
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
-      REAL(wp), POINTER, DIMENSION(:,:)   ::  zpw
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_flt')
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn_spg_flt : surface pressure gradient trend'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   (free surface constant volume case)'
-       
-         ! set to zero free surface specific arrays
-         spgu(:,:) = 0._wp                     ! surface pressure gradient (i-direction)
-         spgv(:,:) = 0._wp                     ! surface pressure gradient (j-direction)
-
-         ! read filtered free surface arrays in restart file
-         ! when using agrif, sshn, gcx have to be read in istate
-         IF(.NOT. lk_agrif)   CALL flt_rst( nit000, 'READ' )      ! read or initialize the following fields:
-         !                                                        ! gcx, gcxb
-      ENDIF
-
-      ! Local constant initialization
-      z2dt = 2. * rdt                                             ! time step: leap-frog
-      IF( neuler == 0 .AND. kt == nit000   )   z2dt = rdt         ! time step: Euler if restart from rest
-      IF( neuler == 0 .AND. kt == nit000+1 )   CALL sol_mat( kt )
-      z2dtg  = grav * z2dt
-
-      ! Evaluate the masked next velocity (effect of the additional force not included)
-      ! ---------------------------------  
-      IF( lk_vvl ) THEN          ! variable volume  (surface pressure gradient already included in dyn_hpg)
-         !
-         IF( ln_dynadv_vec ) THEN      ! vector form : applied on velocity
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ua(ji,jj,jk) = (  ub(ji,jj,jk) + z2dt * ua(ji,jj,jk)  ) * umask(ji,jj,jk)
-                     va(ji,jj,jk) = (  vb(ji,jj,jk) + z2dt * va(ji,jj,jk)  ) * vmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-            !
-         ELSE                          ! flux form : applied on thickness weighted velocity
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ua(ji,jj,jk) = (        ub(ji,jj,jk) * fse3u_b(ji,jj,jk)      &
-                        &           + z2dt * ua(ji,jj,jk) * fse3u_n(ji,jj,jk)  )   &
-                        &         / fse3u_a(ji,jj,jk) * umask(ji,jj,jk)
-                     va(ji,jj,jk) = (        vb(ji,jj,jk) * fse3v_b(ji,jj,jk)      &
-                        &           + z2dt * va(ji,jj,jk) * fse3v_n(ji,jj,jk)  )   &
-                        &         / fse3v_a(ji,jj,jk) * vmask(ji,jj,jk)
-                 END DO
-               END DO
-            END DO
-            !
-         ENDIF
-         !
-      ELSE                       ! fixed volume  (add the surface pressure gradient + unweighted time stepping)
-         !
-         DO jj = 2, jpjm1              ! Surface pressure gradient (now)
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) / e1u(ji,jj)
-               spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) / e2v(ji,jj)
-            END DO 
-         END DO 
-         DO jk = 1, jpkm1              ! unweighted time stepping 
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ua(ji,jj,jk) = (  ub(ji,jj,jk) + z2dt * ( ua(ji,jj,jk) + spgu(ji,jj) )  ) * umask(ji,jj,jk)
-                  va(ji,jj,jk) = (  vb(ji,jj,jk) + z2dt * ( va(ji,jj,jk) + spgv(ji,jj) )  ) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         !
-         IF( l_trddyn )   THEN                      ! temporary save of spg trends
-            CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )
-            DO jk = 1, jpkm1              ! unweighted time stepping 
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ztrdu(ji,jj,jk) = spgu(ji,jj) * umask(ji,jj,jk)
-                     ztrdv(ji,jj,jk) = spgv(ji,jj) * vmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-            CALL trd_dyn( ztrdu, ztrdv, jpdyn_spgexp, kt )
-         ENDIF
-         !
-      ENDIF
-
-#if defined key_bdy
-      IF( lk_bdy ) CALL bdy_dyn( kt )   ! Update velocities on each open boundary
-      IF( lk_bdy ) CALL bdy_vol( kt )   ! Correction of the barotropic component velocity to control the volume of the system
-#endif
-#if defined key_agrif
-      CALL Agrif_dyn( kt )    ! Update velocities on each coarse/fine interfaces 
-#endif
-      IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_dynspg( kt )      ! Cross Land Advection (update (ua,va))
-
-      ! compute the next vertically averaged velocity (effect of the additional force not included)
-      ! ---------------------------------------------
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            spgu(ji,jj) = fse3u_a(ji,jj,1) * ua(ji,jj,1)
-            spgv(ji,jj) = fse3v_a(ji,jj,1) * va(ji,jj,1)
-         END DO
-      END DO
-      DO jk = 2, jpkm1                     ! vertical sum
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk)
-               spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      DO jj = 2, jpjm1                     ! transport: multiplied by the horizontal scale factor
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            spgu(ji,jj) = spgu(ji,jj) * e2u(ji,jj)
-            spgv(ji,jj) = spgv(ji,jj) * e1v(ji,jj)
-         END DO
-      END DO
-      CALL lbc_lnk( spgu, 'U', -1. )       ! lateral boundary conditions 
-      CALL lbc_lnk( spgv, 'V', -1. )
-
-      IF( lk_vvl ) CALL sol_mat( kt )      ! build the matrix at kt (vvl case only)
-
-      ! Right hand side of the elliptic equation and first guess
-      ! --------------------------------------------------------
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ! Divergence of the after vertically averaged velocity
-            zgcb =  spgu(ji,jj) - spgu(ji-1,jj)   &
-                  + spgv(ji,jj) - spgv(ji,jj-1)
-            gcb(ji,jj) = gcdprc(ji,jj) * zgcb
-            ! First guess of the after barotropic transport divergence
-            zbtd = gcx(ji,jj)
-            gcx (ji,jj) = 2. * zbtd   - gcxb(ji,jj)
-            gcxb(ji,jj) =      zbtd
-         END DO
-      END DO
-      ! applied the lateral boundary conditions
-      IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 )   CALL lbc_lnk_e( gcb, c_solver_pt, 1., jpr2di, jpr2dj )   
-
-#if defined key_agrif
-      IF( .NOT. AGRIF_ROOT() ) THEN
-         ! add contribution of gradient of after barotropic transport divergence 
-         IF( nbondi == -1 .OR. nbondi == 2 )   gcb(3     ,:) =   &
-            &    gcb(3     ,:) - z2dtg * z2dt * laplacu(2     ,:) * gcdprc(3     ,:) * hu(2     ,:) * e2u(2     ,:)
-         IF( nbondi ==  1 .OR. nbondi == 2 )   gcb(nlci-2,:) =   &
-            &    gcb(nlci-2,:) + z2dtg * z2dt * laplacu(nlci-2,:) * gcdprc(nlci-2,:) * hu(nlci-2,:) * e2u(nlci-2,:)
-         IF( nbondj == -1 .OR. nbondj == 2 )   gcb(:     ,3) =   &
-            &    gcb(:,3     ) - z2dtg * z2dt * laplacv(:,2     ) * gcdprc(:,3     ) * hv(:,2     ) * e1v(:,2     )
-         IF( nbondj ==  1 .OR. nbondj == 2 )   gcb(:,nlcj-2) =   &
-            &    gcb(:,nlcj-2) + z2dtg * z2dt * laplacv(:,nlcj-2) * gcdprc(:,nlcj-2) * hv(:,nlcj-2) * e1v(:,nlcj-2)
-      ENDIF
-#endif
-
-
-      ! Relative precision (computation on one processor)
-      ! ------------------
-      rnorme =0.e0
-      rnorme = GLOB_SUM( gcb(1:jpi,1:jpj) * gcdmat(1:jpi,1:jpj) * gcb(1:jpi,1:jpj) * bmask(:,:) )
-
-      epsr = eps * eps * rnorme
-      ncut = 0
-      ! if rnorme is 0, the solution is 0, the solver is not called
-      IF( rnorme == 0._wp ) THEN
-         gcx(:,:) = 0._wp
-         res   = 0._wp
-         niter = 0
-         ncut  = 999
-      ENDIF
-
-      ! Evaluate the next transport divergence
-      ! --------------------------------------
-      !    Iterarive solver for the elliptic equation (except IF sol.=0)
-      !    (output in gcx with boundary conditions applied)
-      kindic = 0
-      IF( ncut == 0 ) THEN
-         IF    ( nn_solv == 1 ) THEN   ;   CALL sol_pcg( kindic )      ! diagonal preconditioned conjuguate gradient
-         ELSEIF( nn_solv == 2 ) THEN   ;   CALL sol_sor( kindic )      ! successive-over-relaxation
-         ENDIF
-      ENDIF
-
-      ! Transport divergence gradient multiplied by z2dt
-      ! --------------------------------------------====
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ! trend of Transport divergence gradient
-            ztdgu = z2dtg * (gcx(ji+1,jj  ) - gcx(ji,jj) ) / e1u(ji,jj)
-            ztdgv = z2dtg * (gcx(ji  ,jj+1) - gcx(ji,jj) ) / e2v(ji,jj)
-            ! multiplied by z2dt
-#if defined key_bdy
-            IF(lk_bdy) THEN
-            ! caution : grad D = 0 along open boundaries
-               spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj)
-               spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj)
-            ELSE
-               spgu(ji,jj) = z2dt * ztdgu
-               spgv(ji,jj) = z2dt * ztdgv
-            ENDIF
-#else
-            spgu(ji,jj) = z2dt * ztdgu
-            spgv(ji,jj) = z2dt * ztdgv
-#endif
-         END DO
-      END DO
-
-#if defined key_agrif      
-      IF( .NOT. Agrif_Root() ) THEN
-         ! caution : grad D (fine) = grad D (coarse) at coarse/fine interface
-         IF( nbondi == -1 .OR. nbondi == 2 ) spgu(2     ,:) = z2dtg * z2dt * laplacu(2     ,:) * umask(2     ,:,1)
-         IF( nbondi ==  1 .OR. nbondi == 2 ) spgu(nlci-2,:) = z2dtg * z2dt * laplacu(nlci-2,:) * umask(nlci-2,:,1)
-         IF( nbondj == -1 .OR. nbondj == 2 ) spgv(:,2     ) = z2dtg * z2dt * laplacv(:,2     ) * vmask(:     ,2,1)
-         IF( nbondj ==  1 .OR. nbondj == 2 ) spgv(:,nlcj-2) = z2dtg * z2dt * laplacv(:,nlcj-2) * vmask(:,nlcj-2,1)
-      ENDIF
-#endif      
-
-      IF( l_trddyn )   THEN                     
-         ztrdu(:,:,:) = ua(:,:,:)                 ! save the after velocity before the filtered SPG
-         ztrdv(:,:,:) = va(:,:,:)
-         !
-         CALL wrk_alloc( jpi, jpj, zpw )
-         !
-         zpw(:,:) = - z2dt * gcx(:,:)
-         CALL iom_put( "ssh_flt" , zpw )          ! output equivalent ssh modification due to implicit filter
-         !
-         !                                        ! save surface pressure flux: -pw at z=0
-         zpw(:,:) = - rau0 * grav * sshn(:,:) * wn(:,:,1) * tmask(:,:,1)
-         CALL iom_put( "pw0_exp" , zpw )
-         zpw(:,:) = wn(:,:,1)
-         CALL iom_put( "w0" , zpw )
-         zpw(:,:) =  rau0 * z2dtg * gcx(:,:) * wn(:,:,1) * tmask(:,:,1)
-         CALL iom_put( "pw0_flt" , zpw )
-         !
-         CALL wrk_dealloc( jpi, jpj, zpw ) 
-         !                                   
-      ENDIF
-      
-      ! Add the trends multiplied by z2dt to the after velocity
-      ! -------------------------------------------------------
-      !     ( c a u t i o n : (ua,va) here are the after velocity not the
-      !                       trend, the leap-frog time stepping will not
-      !                       be done in dynnxt.F90 routine)
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) = ( ua(ji,jj,jk) + spgu(ji,jj) ) * umask(ji,jj,jk)
-               va(ji,jj,jk) = ( va(ji,jj,jk) + spgv(ji,jj) ) * vmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      IF( l_trddyn )   THEN                      ! save the explicit SPG trends for further diagnostics
-         ztrdu(:,:,:) = ( ua(:,:,:) - ztrdu(:,:,:) ) / z2dt
-         ztrdv(:,:,:) = ( va(:,:,:) - ztrdv(:,:,:) ) / z2dt
-         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spgflt, kt )
-         !
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
-      ENDIF
-
-      IF( lrst_oce )   CALL flt_rst( kt, 'WRITE' )      ! write filtered free surface arrays in restart file
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('dyn_spg_flt')
-      !
-   END SUBROUTINE dyn_spg_flt
-
-
-   SUBROUTINE flt_rst( kt, cdrw )
-      !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE ts_rst  ***
-      !!
-      !! ** Purpose : Read or write filtered free surface arrays in restart file
-      !!----------------------------------------------------------------------
-      INTEGER         , INTENT(in) ::   kt     ! ocean time-step
-      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
-      !!----------------------------------------------------------------------
-      !
-      IF( TRIM(cdrw) == 'READ' ) THEN
-         IF( iom_varid( numror, 'gcx', ldstop = .FALSE. ) > 0 ) THEN
-! Caution : extra-hallow
-! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)
-            CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj) )
-            CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj) )
-            IF( neuler == 0 )   gcxb(:,:) = gcx (:,:)
-         ELSE
-            gcx (:,:) = 0.e0
-            gcxb(:,:) = 0.e0
-         ENDIF
-      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
-! Caution : extra-hallow
-! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)
-         CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) )
-         CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) )
-      ENDIF
-      !
-   END SUBROUTINE flt_rst
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default case :   Empty module   No standart free surface cst volume
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE dyn_spg_flt( kt, kindic )       ! Empty routine
-      WRITE(*,*) 'dyn_spg_flt: You should not have seen this print! error?', kt, kindic
-   END SUBROUTINE dyn_spg_flt
-   SUBROUTINE flt_rst    ( kt, cdrw )         ! Empty routine
-      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
-      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
-      WRITE(*,*) 'flt_rst: You should not have seen this print! error?', kt, cdrw
-   END SUBROUTINE flt_rst
-#endif
-   
-   !!======================================================================
-END MODULE dynspg_flt
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90	(revision 6807)
+++ 	(revision )
@@ -1,71 +1,0 @@
-MODULE dynspg_oce
-   !!======================================================================
-   !!                       ***  MODULE dynspg_oce  ***
-   !!       
-   !! Ocean dynamics: Define in memory some surface pressure gradient variables
-   !!======================================================================
-   !! History :  1.0  ! 2005-12  (C. Talandier, G. Madec)  Original code
-   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE lib_mpp        ! MPP library
-
-   IMPLICIT NONE
-   PUBLIC           
-
-   PUBLIC   dynspg_oce_alloc   ! called in dynspg.F90
-   
-   !                                                       !!! Surface pressure gradient logicals
-#if   defined key_dynspg_exp  ||  defined key_esopa
-   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_exp = .TRUE.   !: Explicit free surface flag
-#else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_exp = .FALSE.  !: Explicit free surface flag
-#endif
-#if   defined key_dynspg_ts   ||  defined key_esopa
-   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_ts  = .TRUE.   !: Free surface with time splitting flag
-#else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_ts  = .FALSE.  !: Free surface with time splitting flag
-#endif
-#if   defined key_dynspg_flt  ||  defined key_esopa
-   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_flt = .TRUE.   !: Filtered free surface cst volume flag
-#else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_flt = .FALSE.  !: Filtered free surface cst volume flag
-#endif
-
-  !                                                                         !!! Time splitting scheme (key_dynspg_ts) 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshn_e, ssha_e   ! sea surface heigth (now, after)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ua_e  , va_e     ! barotropic velocities (after)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_e  , hv_e     ! now ocean depth ( = Ho+sshn_e )
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hur_e , hvr_e    ! inverse of hu_e and hv_e
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv, vn_adv   ! Advection vel. at "now" barocl. step
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b,  vb2_b    ! Half step fluxes (ln_bt_fw=T)
-#if defined key_agrif
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_i_b,  vb2_i_b! Half step time integrated fluxes 
-#endif
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION dynspg_oce_alloc()
-      !!----------------------------------------------------------------------
-      !!                  ***  routine dynspg_oce_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( sshn_e(jpi,jpj) , ua_e(jpi,jpj) , hu_e(jpi,jpj) , hur_e(jpi,jpj) ,      &
-         &      ssha_e(jpi,jpj) , va_e(jpi,jpj) , hv_e(jpi,jpj) , hvr_e(jpi,jpj) ,      &
-         &      ub2_b(jpi,jpj)  , vb2_b(jpi,jpj)                                 ,      &
-#if defined key_agrif
-         &      ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                               ,      &
-#endif
-         &      un_adv(jpi,jpj) , vn_adv(jpi,jpj)                                , STAT = dynspg_oce_alloc )
-         !
-      IF( lk_mpp                )   CALL mpp_sum ( dynspg_oce_alloc )
-      IF( dynspg_oce_alloc /= 0 )   CALL ctl_warn('dynspg_oce_alloc: failed to allocate arrays')
-      !
-   END FUNCTION dynspg_oce_alloc
-
-   !!======================================================================
-END MODULE dynspg_oce
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 6808)
@@ -1,3 +1,6 @@
 MODULE dynspg_ts
+   !!======================================================================
+   !!                   ***  MODULE  dynspg_ts  ***
+   !! Ocean dynamics:  surface pressure gradient trend, split-explicit scheme
    !!======================================================================
    !! History :   1.0  ! 2004-12  (L. Bessieres, G. Madec)  Original code
@@ -11,35 +14,38 @@
    !!             3.5  ! 2013-07  (J. Chanut) Switch to Forward-backward time stepping
    !!             3.6  ! 2013-11  (A. Coward) Update for z-tilde compatibility
+   !!             3.7  ! 2015-11  (J. Chanut) free surface simplification
    !!---------------------------------------------------------------------
-#if defined key_dynspg_ts   ||   defined key_esopa
+
    !!----------------------------------------------------------------------
-   !!   'key_dynspg_ts'         split explicit free surface
-   !!----------------------------------------------------------------------
-   !!   dyn_spg_ts  : compute surface pressure gradient trend using a time-
-   !!                 splitting scheme and add to the general trend 
+   !!   dyn_spg_ts     : compute surface pressure gradient trend using a time-splitting scheme 
+   !!   dyn_spg_ts_init: initialisation of the time-splitting scheme
+   !!   ts_wgt         : set time-splitting weights for temporal averaging (or not)
+   !!   ts_rst         : read/write time-splitting fields in restart file
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
    USE sbc_oce         ! surface boundary condition: ocean
+   USE zdf_oce         ! Bottom friction coefts
    USE sbcisf          ! ice shelf variable (fwfisf)
-   USE dynspg_oce      ! surface pressure gradient variables
+   USE sbcapr          ! surface boundary condition: atmospheric pressure
+   USE dynadv    , ONLY: ln_dynadv_vec
    USE phycst          ! physical constants
    USE dynvor          ! vorticity term
+   USE wet_dry         ! wetting/drying flux limter
    USE bdy_par         ! for lk_bdy
-   USE bdytides        ! open boundary condition data     
+   USE bdytides        ! open boundary condition data
    USE bdydyn2d        ! open boundary conditions on barotropic variables
    USE sbctide         ! tides
    USE updtide         ! tide potential
+   !
+   USE in_out_manager  ! I/O manager
    USE lib_mpp         ! distributed memory computing library
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE prtctl          ! Print control
-   USE in_out_manager  ! I/O manager
    USE iom             ! IOM library
    USE restart         ! only for lrst_oce
-   USE zdf_oce         ! Bottom friction coefts
    USE wrk_nemo        ! Memory Allocation
    USE timing          ! Timing    
-   USE sbcapr          ! surface boundary condition: atmospheric pressure
-   USE dynadv, ONLY: ln_dynadv_vec
+   USE diatmb          ! Top,middle,bottom output
 #if defined key_agrif
    USE agrif_opa_interp ! agrif
@@ -49,4 +55,5 @@
 #endif
 
+
    IMPLICIT NONE
    PRIVATE
@@ -60,20 +67,14 @@
    REAL(wp),SAVE :: rdtbt   ! Barotropic time step
 
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: &
-                    wgtbtp1, &              ! Primary weights used for time filtering of barotropic variables
-                    wgtbtp2                 ! Secondary weights used for time filtering of barotropic variables
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zwz          ! ff/h at F points
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftnw, ftne   ! triad of coriolis parameter
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse   ! (only used with een vorticity scheme)
-
-   ! Arrays below are saved to allow testing of the "no time averaging" option
-   ! If this option is not retained, these could be replaced by temporary arrays
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  sshbb_e, sshb_e, & ! Instantaneous barotropic arrays
-                                                   ubb_e, ub_e,     &
-                                                   vbb_e, vb_e
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   wgtbtp1, wgtbtp2   !: 1st & 2nd weights used in time filtering of barotropic fields
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zwz          !: ff/h at F points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftnw, ftne   !: triad of coriolis parameter
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse   !: (only used with een vorticity scheme)
+
+   !! Time filtered arrays at baroclinic time step:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv , vn_adv     !: Advection vel. at "now" barocl. step
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -91,29 +92,28 @@
       !!----------------------------------------------------------------------
       ierr(:) = 0
-
-      ALLOCATE( sshb_e(jpi,jpj), sshbb_e(jpi,jpj), &
-         &      ub_e(jpi,jpj)  , vb_e(jpi,jpj)   , &
-         &      ubb_e(jpi,jpj) , vbb_e(jpi,jpj)  , STAT= ierr(1) )
-
-      ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) )
-
-      IF( ln_dynvor_een .or. ln_dynvor_een_old ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 
-                                                    &      ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) )
-
-      dyn_spg_ts_alloc = MAXVAL(ierr(:))
-
+      !
+      ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT=ierr(1) )
+      !
+      IF( ln_dynvor_een )   ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 
+         &                            ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(2) )
+         !
+      ALLOCATE( un_adv(jpi,jpj), vn_adv(jpi,jpj)                    , STAT=ierr(3) )
+      !
+      dyn_spg_ts_alloc = MAXVAL( ierr(:) )
+      !
       IF( lk_mpp                )   CALL mpp_sum( dyn_spg_ts_alloc )
-      IF( dyn_spg_ts_alloc /= 0 )   CALL ctl_warn('dynspg_oce_alloc: failed to allocate arrays')
+      IF( dyn_spg_ts_alloc /= 0 )   CALL ctl_warn('dyn_spg_ts_alloc: failed to allocate arrays')
       !
    END FUNCTION dyn_spg_ts_alloc
+
 
    SUBROUTINE dyn_spg_ts( kt )
       !!----------------------------------------------------------------------
       !!
-      !! ** Purpose :   
-      !!      -Compute the now trend due to the explicit time stepping
-      !!      of the quasi-linear barotropic system. 
+      !! ** Purpose : - Compute the now trend due to the explicit time stepping
+      !!              of the quasi-linear barotropic system, and add it to the
+      !!              general momentum trend. 
       !!
-      !! ** Method  :  
+      !! ** Method  : - split-explicit schem (time splitting) :
       !!      Barotropic variables are advanced from internal time steps
       !!      "n"   to "n+1" if ln_bt_fw=T
@@ -129,32 +129,32 @@
       !!      continuity equation taken at the baroclinic time steps. This 
       !!      ensures tracers conservation.
-      !!      -Update 3d trend (ua, va) with barotropic component.
+      !!      - (ua, va) momentum trend updated with barotropic component.
       !!
-      !! References : Shchepetkin, A.F. and J.C. McWilliams, 2005: 
-      !!              The regional oceanic modeling system (ROMS): 
-      !!              a split-explicit, free-surface,
-      !!              topography-following-coordinate oceanic model. 
-      !!              Ocean Modelling, 9, 347-404. 
+      !! References : Shchepetkin and McWilliams, Ocean Modelling, 2005. 
       !!---------------------------------------------------------------------
-      !
       INTEGER, INTENT(in)  ::   kt   ! ocean time-step index
       !
       LOGICAL  ::   ll_fw_start			! if true, forward integration 
       LOGICAL  ::   ll_init			    ! if true, special startup of 2d equations
+      LOGICAL  ::   ll_tmp1, ll_tmp2            ! local logical variables used in W/D
       INTEGER  ::   ji, jj, jk, jn   		! dummy loop indices
       INTEGER  ::   ikbu, ikbv, noffset    	! local integers
+      INTEGER  ::   iktu, iktv             	! local integers
+      REAL(wp) ::   zmdi
       REAL(wp) ::   zraur, z1_2dt_b, z2dt_bf  	! local scalars
-      REAL(wp) ::   zx1, zy1, zx2, zy2         !   -      -
-      REAL(wp) ::   z1_12, z1_8, z1_4, z1_2 	  !   -      -
-      REAL(wp) ::   zu_spg, zv_spg             !   -      -
-      REAL(wp) ::   zhura, zhvra         	     !   -      -
-      REAL(wp) ::   za0, za1, za2, za3		       !   -      -
-      !
-      REAL(wp), POINTER, DIMENSION(:,:) :: zun_e, zvn_e, zsshp2_e
+      REAL(wp) ::   zx1, zy1, zx2, zy2          !   -      -
+      REAL(wp) ::   z1_12, z1_8, z1_4, z1_2 	!   -      -
+      REAL(wp) ::   zu_spg, zv_spg              !   -      -
+      REAL(wp) ::   zhura, zhvra         	!   -      -
+      REAL(wp) ::   za0, za1, za2, za3		!   -      -
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) :: zsshp2_e
       REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc
-      REAL(wp), POINTER, DIMENSION(:,:) :: zu_sum, zv_sum, zwx, zwy, zhdiv
+      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zhdiv
       REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e
       REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a
       REAL(wp), POINTER, DIMENSION(:,:) :: zhf
+      REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy                 ! Wetting/Dying gravity filter coef.
+      REAL(wp), POINTER, DIMENSION(:,:) :: wduflt1, wdvflt1           ! Wetting/Dying velocity filter coef.
       !!----------------------------------------------------------------------
       !
@@ -162,11 +162,13 @@
       !
       !                                         !* Allocate temporary arrays
-      CALL wrk_alloc( jpi, jpj, zsshp2_e, zhdiv )
-      CALL wrk_alloc( jpi, jpj, zu_trd, zv_trd, zun_e, zvn_e  )
-      CALL wrk_alloc( jpi, jpj, zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc)
-      CALL wrk_alloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e)
-      CALL wrk_alloc( jpi, jpj, zsshu_a, zsshv_a                                   )
-      CALL wrk_alloc( jpi, jpj, zhf )
-      !
+      CALL wrk_alloc( jpi,jpj,   zsshp2_e, zhdiv )
+      CALL wrk_alloc( jpi,jpj,   zu_trd, zv_trd)
+      CALL wrk_alloc( jpi,jpj,   zwx, zwy, zssh_frc, zu_frc, zv_frc)
+      CALL wrk_alloc( jpi,jpj,   zhup2_e, zhvp2_e, zhust_e, zhvst_e)
+      CALL wrk_alloc( jpi,jpj,   zsshu_a, zsshv_a                  )
+      CALL wrk_alloc( jpi,jpj,   zhf )
+      IF( ln_wd ) CALL wrk_alloc( jpi, jpj, zcpx, zcpy, wduflt1, wdvflt1 )
+      !
+      zmdi=1.e+20                               !  missing data indicator for masking
       !                                         !* Local constant initialization
       z1_12 = 1._wp / 12._wp 
@@ -175,17 +177,16 @@
       z1_2  = 0.5_wp     
       zraur = 1._wp / rau0
-      !
-      IF( kt == nit000 .AND. neuler == 0 ) THEN  	! reciprocal of baroclinic time step 
-        z2dt_bf = rdt
-      ELSE
-        z2dt_bf = 2.0_wp * rdt
+      !  	                                       ! reciprocal of baroclinic time step 
+      IF( kt == nit000 .AND. neuler == 0 ) THEN   ;   z2dt_bf =          rdt
+      ELSE                                        ;   z2dt_bf = 2.0_wp * rdt
       ENDIF
       z1_2dt_b = 1.0_wp / z2dt_bf 
       !
-      ll_init = ln_bt_av                       		! if no time averaging, then no specific restart 
+      ll_init     = ln_bt_av                       ! if no time averaging, then no specific restart 
       ll_fw_start = .FALSE.
-      !
-                                     	                ! time offset in steps for bdy data update
-      IF (.NOT.ln_bt_fw) THEN ; noffset=-2*nn_baro ; ELSE ;  noffset = 0 ; ENDIF
+      !                              	            ! time offset in steps for bdy data update
+      IF( .NOT.ln_bt_fw ) THEN   ;   noffset = - nn_baro
+      ELSE                       ;   noffset =   0 
+      ENDIF
       !
       IF( kt == nit000 ) THEN             	!* initialisation
@@ -196,16 +197,15 @@
          IF(lwp) WRITE(numout,*)
          !
-         IF (neuler==0) ll_init=.TRUE.
-         !
-         IF (ln_bt_fw.OR.(neuler==0)) THEN
-           ll_fw_start=.TRUE.
-           noffset = 0
+         IF( neuler == 0 )   ll_init=.TRUE.
+         !
+         IF( ln_bt_fw .OR. neuler == 0 ) THEN
+            ll_fw_start =.TRUE.
+            noffset     = 0
          ELSE
-           ll_fw_start=.FALSE.
+            ll_fw_start =.FALSE.
          ENDIF
          !
          ! Set averaging weights and cycle length:
-         CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2)
-         !
+         CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 )
          !
       ENDIF
@@ -218,19 +218,31 @@
       ! and update depths at T-F points (ht and zhf resp.) at each barotropic time step
       !
-      IF ( kt == nit000 .OR. lk_vvl ) THEN
-         IF ( ln_dynvor_een_old ) THEN
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                    &
-                        &          ht(ji  ,jj  ) + ht(ji+1,jj  )   ) / 4._wp  
-                  IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zwz(ji,jj)
-               END DO
-            END DO
+      IF( kt == nit000 .OR. .NOT.ln_linssh ) THEN
+         IF( ln_dynvor_een ) THEN               !==  EEN scheme  ==!
+            SELECT CASE( nn_een_e3f )              !* ff/e3 at F-point
+            CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    &
+                        &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp  
+                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj)
+                  END DO
+               END DO
+            CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                     &
+                        &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   )                   &
+                        &       / ( MAX( 1._wp, tmask(ji  ,jj+1, 1) + tmask(ji+1,jj+1, 1) +    &
+                        &                       tmask(ji  ,jj  , 1) + tmask(ji+1,jj  , 1) ) )
+                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj)
+                  END DO
+               END DO
+            END SELECT
             CALL lbc_lnk( zwz, 'F', 1._wp )
-            zwz(:,:) = ff(:,:) * zwz(:,:)
-
+            !
             ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
             DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
+               DO ji = 2, jpi
                   ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
                   ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
@@ -239,30 +251,12 @@
                END DO
             END DO
-         ELSE IF ( ln_dynvor_een ) THEN
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                     &
-                        &          ht(ji  ,jj  ) + ht(ji+1,jj  )   )                   &
-                        &      / ( MAX( 1.0_wp, tmask(ji  ,jj+1, 1) + tmask(ji+1,jj+1, 1) +    &
-                        &                       tmask(ji  ,jj  , 1) + tmask(ji+1,jj  , 1) ) )
-                  IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zwz(ji,jj)
-               END DO
-            END DO
-            CALL lbc_lnk( zwz, 'F', 1._wp )
-            zwz(:,:) = ff(:,:) * zwz(:,:)
-
-            ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
-                  ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
-                  ftse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1)
-                  ftsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  )
-               END DO
-            END DO
-         ELSE
+            !
+         ELSE                                !== all other schemes (ENE, ENS, MIX)
             zwz(:,:) = 0._wp
-            zhf(:,:) = 0.
+            zhf(:,:) = 0._wp
             IF ( .not. ln_sco ) THEN
+
+!!gm  agree the JC comment  : this should be done in a much clear way
+
 ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case
 !     Set it to zero for the time being 
@@ -276,10 +270,10 @@
 
             DO jj = 1, jpjm1
-               zhf(:,jj) = zhf(:,jj)*(1._wp- umask(:,jj,1) * umask(:,jj+1,1))
+               zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1))
             END DO
 
             DO jk = 1, jpkm1
                DO jj = 1, jpjm1
-                  zhf(:,jj) = zhf(:,jj) + fse3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)
+                  zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)
                END DO
             END DO
@@ -297,5 +291,5 @@
       ! If forward start at previous time step, and centered integration, 
       ! then update averaging weights:
-      IF ((.NOT.ln_bt_fw).AND.((neuler==0).AND.(kt==nit000+1))) THEN
+      IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN
          ll_fw_start=.FALSE.
          CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2)
@@ -313,10 +307,10 @@
       !
       DO jk = 1, jpkm1
-         zu_frc(:,:) = zu_frc(:,:) + fse3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)
-         zv_frc(:,:) = zv_frc(:,:) + fse3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)         
+         zu_frc(:,:) = zu_frc(:,:) + e3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)
+         zv_frc(:,:) = zv_frc(:,:) + e3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)         
       END DO
       !
-      zu_frc(:,:) = zu_frc(:,:) * hur(:,:)
-      zv_frc(:,:) = zv_frc(:,:) * hvr(:,:)
+      zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:)
+      zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:)
       !
       !
@@ -332,14 +326,14 @@
       !                                   !* barotropic Coriolis trends (vorticity scheme dependent)
       !                                   ! --------------------------------------------------------
-      zwx(:,:) = un_b(:,:) * hu(:,:) * e2u(:,:)        ! now fluxes 
-      zwy(:,:) = vn_b(:,:) * hv(:,:) * e1v(:,:)
+      zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes 
+      zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:)
       !
       IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN      ! energy conserving or mixed scheme
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj)
-               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
-               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj)
-               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+               zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj)
+               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
+               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj)
+               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
                ! energy conserving formulation for planetary vorticity term
                zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
@@ -352,7 +346,7 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
-                 &            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
+                 &            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
                zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
-                 &            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+                 &            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
                zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
                zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
@@ -360,15 +354,15 @@
          END DO
          !
-      ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old ) THEN  ! enstrophy and energy conserving scheme
+      ELSEIF ( ln_dynvor_een ) THEN  ! enstrophy and energy conserving scheme
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_trd(ji,jj) = + z1_12 / e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
-                &                                      + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
-                &                                      + ftse(ji,jj  ) * zwy(ji  ,jj-1) &
-                &                                      + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
-               zv_trd(ji,jj) = - z1_12 / e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &
-                &                                      + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
-                &                                      + ftnw(ji,jj  ) * zwx(ji-1,jj  ) &
-                &                                      + ftne(ji,jj  ) * zwx(ji  ,jj  ) )
+               zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
+                &                                         + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
+                &                                         + ftse(ji,jj  ) * zwy(ji  ,jj-1) &
+                &                                         + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
+               zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &
+                &                                         + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
+                &                                         + ftnw(ji,jj  ) * zwx(ji-1,jj  ) &
+                &                                         + ftne(ji,jj  ) * zwx(ji  ,jj  ) )
             END DO
          END DO
@@ -378,17 +372,72 @@
       !                                   !* Right-Hand-Side of the barotropic momentum equation
       !                                   ! ----------------------------------------------------
-      IF( lk_vvl ) THEN                         ! Variable volume : remove surface pressure gradient
-         DO jj = 2, jpjm1 
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) / e1u(ji,jj)
-               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) / e2v(ji,jj)
-            END DO
-         END DO
+      IF( .NOT.ln_linssh ) THEN                 ! Variable volume : remove surface pressure gradient
+        IF( ln_wd ) THEN                        ! Calculating and applying W/D gravity filters
+          wduflt1(:,:) = 1.0_wp
+          wdvflt1(:,:) = 1.0_wp
+          DO jj = 2, jpjm1
+             DO ji = 2, jpim1
+                ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj))   &
+                        & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj))   &
+                        &  > rn_wdmin1 + rn_wdmin2
+                ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj))   &
+                        &                                   + rn_wdmin1 + rn_wdmin2
+                IF(ll_tmp1) THEN
+                  zcpx(ji,jj)    = 1.0_wp
+                ELSEIF(ll_tmp2) THEN
+                   ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen here
+                  zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) &
+                        &          /(sshn(ji+1,jj) - sshn(ji,jj)))
+                ELSE
+                  zcpx(ji,jj)    = 0._wp
+                  wduflt1(ji,jj) = 0.0_wp
+                END IF
+
+                ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1))   &
+                        & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1))   &
+                        &  > rn_wdmin1 + rn_wdmin2
+                ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1))   &
+                        &                                   + rn_wdmin1 + rn_wdmin2
+                IF(ll_tmp1) THEN
+                   zcpy(ji,jj)    = 1.0_wp
+                ELSEIF(ll_tmp2) THEN
+                   ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen here
+                  zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) &
+                        &          /(sshn(ji,jj+1) - sshn(ji,jj)))
+                ELSE
+                  zcpy(ji,jj)    = 0._wp
+                  wdvflt1(ji,jj) = 0.0_wp
+                ENDIF
+
+             END DO
+           END DO
+
+           CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp )
+
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1
+                 zu_trd(ji,jj) = ( zu_trd(ji,jj) - grav * ( sshn(ji+1,jj  ) - sshn(ji  ,jj ) )   &
+                        &                        * r1_e1u(ji,jj) ) * zcpx(ji,jj) * wduflt1(ji,jj)
+                 zv_trd(ji,jj) = ( zv_trd(ji,jj) - grav * ( sshn(ji  ,jj+1) - sshn(ji  ,jj ) )   &
+                        &                        * r1_e2v(ji,jj) ) * zcpy(ji,jj) * wdvflt1(ji,jj)
+              END DO
+           END DO
+
+         ELSE
+
+           DO jj = 2, jpjm1
+              DO ji = fs_2, fs_jpim1   ! vector opt.
+                 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj)
+                 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj) 
+              END DO
+           END DO
+        ENDIF
+
       ENDIF
 
       DO jj = 2, jpjm1                          ! Remove coriolis term (and possibly spg) from barotropic trend
          DO ji = fs_2, fs_jpim1
-             zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * umask(ji,jj,1)
-             zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * vmask(ji,jj,1)
+             zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj)
+             zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj)
           END DO
       END DO 
@@ -416,13 +465,43 @@
       !
       ! Note that the "unclipped" bottom friction parameter is used even with explicit drag
-      zu_frc(:,:) = zu_frc(:,:) + hur(:,:) * bfrua(:,:) * zwx(:,:)
-      zv_frc(:,:) = zv_frc(:,:) + hvr(:,:) * bfrva(:,:) * zwy(:,:)
+      IF( ln_wd ) THEN
+        zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:)
+        zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:)
+      ELSE
+        zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:)
+        zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:)
+      END IF
+      !
+      !                                         ! Add top stress contribution from baroclinic velocities:      
+      IF (ln_bt_fw) THEN
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               iktu = miku(ji,jj)
+               iktv = mikv(ji,jj)
+               zwx(ji,jj) = un(ji,jj,iktu) - un_b(ji,jj) ! NOW top baroclinic velocities
+               zwy(ji,jj) = vn(ji,jj,iktv) - vn_b(ji,jj)
+            END DO
+         END DO
+      ELSE
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               iktu = miku(ji,jj)
+               iktv = mikv(ji,jj)
+               zwx(ji,jj) = ub(ji,jj,iktu) - ub_b(ji,jj) ! BEFORE top baroclinic velocities
+               zwy(ji,jj) = vb(ji,jj,iktv) - vb_b(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+      ! Note that the "unclipped" top friction parameter is used even with explicit drag
+      zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:)
+      zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:)
       !       
       IF (ln_bt_fw) THEN                        ! Add wind forcing
-         zu_frc(:,:) =  zu_frc(:,:) + zraur * utau(:,:) * hur(:,:)
-         zv_frc(:,:) =  zv_frc(:,:) + zraur * vtau(:,:) * hvr(:,:)
+         zu_frc(:,:) =  zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:)
+         zv_frc(:,:) =  zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:)
       ELSE
-         zu_frc(:,:) =  zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * hur(:,:)
-         zv_frc(:,:) =  zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * hvr(:,:)
+         zu_frc(:,:) =  zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:)
+         zv_frc(:,:) =  zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:)
       ENDIF  
       !
@@ -431,6 +510,6 @@
             DO jj = 2, jpjm1              
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_spg =  grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) /e1u(ji,jj)
-                  zv_spg =  grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) /e2v(ji,jj)
+                  zu_spg =  grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj)
+                  zv_spg =  grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj)
                   zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg
                   zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg
@@ -441,7 +520,7 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zu_spg =  grav * z1_2 * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)    &
-                      &                    + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) /e1u(ji,jj)
+                      &                    + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
                   zv_spg =  grav * z1_2 * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)    &
-                      &                    + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) /e2v(ji,jj)
+                      &                    + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
                   zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg
                   zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg
@@ -454,8 +533,8 @@
       !                                         ! Surface net water flux and rivers
       IF (ln_bt_fw) THEN
-         zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) )
+         zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) )
       ELSE
          zssh_frc(:,:) = zraur * z1_2 * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:)   &
-                &                        + rdivisf * ( fwfisf(:,:) + fwfisf_b(:,:) )       )
+                &                        + fwfisf(:,:) + fwfisf_b(:,:)                     )
       ENDIF
 #if defined key_asminc
@@ -465,6 +544,6 @@
       ENDIF
 #endif
-      !                                   !* Fill boundary data arrays with AGRIF
-      !                                   ! -------------------------------------
+      !                                   !* Fill boundary data arrays for AGRIF
+      !                                   ! ------------------------------------
 #if defined key_agrif
          IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt )
@@ -487,23 +566,29 @@
          vb_e   (:,:) = 0._wp
       ENDIF
+
+      IF( ln_wd ) THEN      !preserve the positivity of water depth
+                          !ssh[b,n,a] should have already been processed for this
+         sshbb_e(:,:) = MAX(sshbb_e(:,:), rn_wdmin1 - bathy(:,:))
+         sshb_e(:,:)  = MAX(sshb_e(:,:) , rn_wdmin1 - bathy(:,:))
+      ENDIF
       !
       IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                    
-         sshn_e(:,:) = sshn (:,:)            
-         zun_e (:,:) = un_b (:,:)            
-         zvn_e (:,:) = vn_b (:,:)
-         !
-         hu_e  (:,:) = hu   (:,:)       
-         hv_e  (:,:) = hv   (:,:) 
-         hur_e (:,:) = hur  (:,:)    
-         hvr_e (:,:) = hvr  (:,:)
+         sshn_e(:,:) =    sshn(:,:)            
+         un_e  (:,:) =    un_b(:,:)            
+         vn_e  (:,:) =    vn_b(:,:)
+         !
+         hu_e  (:,:) =    hu_n(:,:)       
+         hv_e  (:,:) =    hv_n(:,:) 
+         hur_e (:,:) = r1_hu_n(:,:)    
+         hvr_e (:,:) = r1_hv_n(:,:)
       ELSE                                ! CENTRED integration: start from BEFORE fields
-         sshn_e(:,:) = sshb (:,:)
-         zun_e (:,:) = ub_b (:,:)         
-         zvn_e (:,:) = vb_b (:,:)
-         !
-         hu_e  (:,:) = hu_b (:,:)       
-         hv_e  (:,:) = hv_b (:,:) 
-         hur_e (:,:) = hur_b(:,:)    
-         hvr_e (:,:) = hvr_b(:,:)
+         sshn_e(:,:) =    sshb(:,:)
+         un_e  (:,:) =    ub_b(:,:)         
+         vn_e  (:,:) =    vb_b(:,:)
+         !
+         hu_e  (:,:) =    hu_b(:,:)       
+         hv_e  (:,:) =    hv_b(:,:) 
+         hur_e (:,:) = r1_hu_b(:,:)    
+         hvr_e (:,:) = r1_hv_b(:,:)
       ENDIF
       !
@@ -514,6 +599,6 @@
       va_b  (:,:) = 0._wp
       ssha  (:,:) = 0._wp       ! Sum for after averaged sea level
-      zu_sum(:,:) = 0._wp       ! Sum for now transport issued from ts loop
-      zv_sum(:,:) = 0._wp
+      un_adv(:,:) = 0._wp       ! Sum for now transport issued from ts loop
+      vn_adv(:,:) = 0._wp
       !                                             ! ==================== !
       DO jn = 1, icycle                             !  sub-time-step loop  !
@@ -523,6 +608,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, koffset=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, time_offset= noffset   )
 #endif
          !
@@ -539,8 +624,8 @@
 
          ! Extrapolate barotropic velocities at step jit+0.5:
-         ua_e(:,:) = za1 * zun_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:)
-         va_e(:,:) = za1 * zvn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:)
-
-         IF( lk_vvl ) THEN                                !* Update ocean depth (variable volume case only)
+         ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:)
+         va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:)
+
+         IF( .NOT.ln_linssh ) THEN                        !* Update ocean depth (variable volume case only)
             !                                             !  ------------------
             ! Extrapolate Sea Level at step jit+0.5:
@@ -549,10 +634,10 @@
             DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points
                DO ji = 2, fs_jpim1   ! Vector opt.
-                  zwx(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e12u(ji,jj)     &
-                     &              * ( e12t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
-                     &              +   e12t(ji+1,jj) * zsshp2_e(ji+1,jj) )
-                  zwy(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e12v(ji,jj)     &
-                     &              * ( e12t(ji,jj  ) * zsshp2_e(ji,jj  )  &
-                     &              +   e12t(ji,jj+1) * zsshp2_e(ji,jj+1) )
+                  zwx(ji,jj) = z1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj)     &
+                     &              * ( e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
+                     &              +   e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) )
+                  zwy(ji,jj) = z1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj)     &
+                     &              * ( e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  &
+                     &              +   e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) )
                END DO
             END DO
@@ -561,7 +646,11 @@
             zhup2_e (:,:) = hu_0(:,:) + zwx(:,:)                ! Ocean depth at U- and V-points
             zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:)
+            IF( ln_wd ) THEN
+              zhup2_e(:,:) = MAX(zhup2_e (:,:), rn_wdmin1)
+              zhvp2_e(:,:) = MAX(zhvp2_e (:,:), rn_wdmin1)
+            END IF
          ELSE
-            zhup2_e (:,:) = hu(:,:)
-            zhvp2_e (:,:) = hv(:,:)
+            zhup2_e (:,:) = hu_n(:,:)
+            zhvp2_e (:,:) = hv_n(:,:)
          ENDIF
          !                                                !* after ssh
@@ -574,7 +663,6 @@
          !
 #if defined key_agrif
-         ! Set fluxes during predictor step to ensure 
-         ! volume conservation
-         IF( (.NOT.Agrif_Root()).AND.ln_bt_fw ) THEN
+         ! Set fluxes during predictor step to ensure volume conservation
+         IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN
             IF((nbondi == -1).OR.(nbondi == 2)) THEN
                DO jj=1,jpj
@@ -599,9 +687,10 @@
          ENDIF
 #endif
+         IF( ln_wd ) CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, rdtbt)
          !
          ! Sum over sub-time-steps to compute advective velocities
          za2 = wgtbtp2(jn)
-         zu_sum  (:,:) = zu_sum  (:,:) + za2 * zwx  (:,:) / e2u  (:,:)
-         zv_sum  (:,:) = zv_sum  (:,:) + za2 * zwy  (:,:) / e1v  (:,:)
+         un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:)
+         vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:)
          !
          ! Set next sea level:
@@ -609,28 +698,29 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zhdiv(ji,jj) = (   zwx(ji,jj) - zwx(ji-1,jj)   &
-                  &             + zwy(ji,jj) - zwy(ji,jj-1)   ) * r1_e12t(ji,jj)
+                  &             + zwy(ji,jj) - zwy(ji,jj-1)   ) * r1_e1e2t(ji,jj)
             END DO
          END DO
-         ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * tmask(:,:,1)
+         ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * ssmask(:,:)
+         IF( ln_wd ) ssha_e(:,:) = MAX(ssha_e(:,:), rn_wdmin1 - bathy(:,:)) 
          CALL lbc_lnk( ssha_e, 'T',  1._wp )
 
 #if defined key_bdy
-         ! Duplicate sea level across open boundaries (this is only cosmetic if lk_vvl=.false.)
-         IF (lk_bdy) CALL bdy_ssh( ssha_e )
+         ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T)
+         IF( lk_bdy )   CALL bdy_ssh( ssha_e )
 #endif
 #if defined key_agrif
-         IF( .NOT.Agrif_Root() ) CALL agrif_ssh_ts( jn )
+         IF( .NOT.Agrif_Root() )   CALL agrif_ssh_ts( jn )
 #endif
          !  
          ! Sea Surface Height at u-,v-points (vvl case only)
-         IF ( lk_vvl ) THEN                                
+         IF( .NOT.ln_linssh ) THEN                                
             DO jj = 2, jpjm1
                DO ji = 2, jpim1      ! NO Vector Opt.
-                  zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e12u(ji,jj)  &
-                     &              * ( e12t(ji  ,jj  ) * ssha_e(ji  ,jj  ) &
-                     &              +   e12t(ji+1,jj  ) * ssha_e(ji+1,jj  ) )
-                  zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e12v(ji,jj)  &
-                     &              * ( e12t(ji  ,jj  ) * ssha_e(ji  ,jj  ) &
-                     &              +   e12t(ji  ,jj+1) * ssha_e(ji  ,jj+1) )
+                  zsshu_a(ji,jj) = z1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    &
+                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
+                     &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) )
+                  zsshv_a(ji,jj) = z1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    &
+                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
+                     &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) )
                END DO
             END DO
@@ -656,28 +746,73 @@
            za3=0.013_wp                     ! za3 = eps
          ENDIF
-
+         !
          zsshp2_e(:,:) = za0 *  ssha_e(:,:) + za1 *  sshn_e (:,:) &
           &            + za2 *  sshb_e(:,:) + za3 *  sshbb_e(:,:)
-
+         IF( ln_wd ) THEN                   ! Calculating and applying W/D gravity filters
+           wduflt1(:,:) = 1._wp
+           wdvflt1(:,:) = 1._wp
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1
+                 ll_tmp1 = MIN( zsshp2_e(ji,jj), zsshp2_e(ji+1,jj) ) > MAX( -bathy(ji,jj), -bathy(ji+1,jj) ) &
+                        & .AND. MAX( zsshp2_e(ji,jj) + bathy(ji,jj), zsshp2_e(ji+1,jj) + bathy(ji+1,jj) )    &
+                        &                                  > rn_wdmin1 + rn_wdmin2
+                 ll_tmp2 = MAX( zsshp2_e(ji,jj), zsshp2_e(ji+1,jj) ) > MAX( -bathy(ji,jj), -bathy(ji+1,jj) ) &
+                        &                                  + rn_wdmin1 + rn_wdmin2
+                 IF(ll_tmp1) THEN
+                    zcpx(ji,jj) = 1._wp
+                 ELSE IF(ll_tmp2) THEN
+                    ! no worries about zsshp2_e(ji+1,jj)-zsshp2_e(ji,jj) = 0, it won't happen here
+                    zcpx(ji,jj) = ABS( (zsshp2_e(ji+1,jj) + bathy(ji+1,jj) - zsshp2_e(ji,jj) - bathy(ji,jj)) &
+                        &             / (zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj)) )
+                 ELSE
+                    zcpx(ji,jj)    = 0._wp
+                    wduflt1(ji,jj) = 0._wp
+                 END IF
+
+                 ll_tmp1 = MIN( zsshp2_e(ji,jj), zsshp2_e(ji,jj+1) ) > MAX( -bathy(ji,jj), -bathy(ji,jj+1) ) &
+                        & .AND. MAX( zsshp2_e(ji,jj) + bathy(ji,jj), zsshp2_e(ji,jj+1) + bathy(ji,jj+1) )    &
+                        &                                  > rn_wdmin1 + rn_wdmin2
+                 ll_tmp2 = MAX( zsshp2_e(ji,jj), zsshp2_e(ji,jj+1) ) > MAX( -bathy(ji,jj), -bathy(ji,jj+1) ) &
+                        &                                  + rn_wdmin1 + rn_wdmin2
+                 IF(ll_tmp1) THEN
+                    zcpy(ji,jj) = 1._wp
+                 ELSE IF(ll_tmp2) THEN
+                    ! no worries about zsshp2_e(ji,jj+1)-zsshp2_e(ji,jj) = 0, it won't happen here
+                    zcpy(ji,jj) = ABS( (zsshp2_e(ji,jj+1) + bathy(ji,jj+1) - zsshp2_e(ji,jj) - bathy(ji,jj)) &
+                        &             / (zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj)) )
+                 ELSE
+                    zcpy(ji,jj)    = 0._wp
+                    wdvflt1(ji,jj) = 0._wp
+                 END IF
+              END DO
+            END DO
+            CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp )
+         ENDIF
          !
          ! Compute associated depths at U and V points:
-         IF ( lk_vvl.AND.(.NOT.ln_dynadv_vec) ) THEN      
+         IF( .NOT.ln_linssh  .AND. .NOT.ln_dynadv_vec ) THEN 	!* Vector form
             !                                        
             DO jj = 2, jpjm1                            
                DO ji = 2, jpim1
-                  zx1 = z1_2 * umask(ji  ,jj,1) *  r1_e12u(ji  ,jj)    &
-                     &      * ( e12t(ji  ,jj  ) * zsshp2_e(ji  ,jj)    &
-                     &      +   e12t(ji+1,jj  ) * zsshp2_e(ji+1,jj  ) )
-                  zy1 = z1_2 * vmask(ji  ,jj,1) *  r1_e12v(ji  ,jj  )  &
-                     &       * ( e12t(ji ,jj  ) * zsshp2_e(ji  ,jj  )  &
-                     &       +   e12t(ji ,jj+1) * zsshp2_e(ji  ,jj+1) )
+                  zx1 = z1_2 * ssumask(ji  ,jj) *  r1_e1e2u(ji  ,jj)    &
+                     &      * ( e1e2t(ji  ,jj  ) * zsshp2_e(ji  ,jj)    &
+                     &      +   e1e2t(ji+1,jj  ) * zsshp2_e(ji+1,jj  ) )
+                  zy1 = z1_2 * ssvmask(ji  ,jj) *  r1_e1e2v(ji  ,jj  )  &
+                     &       * ( e1e2t(ji ,jj  ) * zsshp2_e(ji  ,jj  )  &
+                     &       +   e1e2t(ji ,jj+1) * zsshp2_e(ji  ,jj+1) )
                   zhust_e(ji,jj) = hu_0(ji,jj) + zx1 
                   zhvst_e(ji,jj) = hv_0(ji,jj) + zy1
                END DO
             END DO
+
+            IF( ln_wd ) THEN
+              zhust_e(:,:) = MAX(zhust_e (:,:), rn_wdmin1 )
+              zhvst_e(:,:) = MAX(zhvst_e (:,:), rn_wdmin1 )
+            END IF
+
          ENDIF
          !
          ! Add Coriolis trend:
-         ! zwz array below or triads normally depend on sea level with key_vvl and should be updated
+         ! zwz array below or triads normally depend on sea level with ln_linssh=F and should be updated
          ! at each time step. We however keep them constant here for optimization.
          ! Recall that zwx and zwy arrays hold fluxes at this stage:
@@ -685,11 +820,11 @@
          ! zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:)
          !
-         IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN      !==  energy conserving or mixed scheme  ==!
+         IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN     !==  energy conserving or mixed scheme  ==!
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zy1 = ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj)
-                  zy2 = ( zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
-                  zx1 = ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) ) / e2v(ji,jj)
-                  zx2 = ( zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+                  zy1 = ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj)
+                  zy2 = ( zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
+                  zx1 = ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj)
+                  zx2 = ( zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
                   zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
                   zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
@@ -697,11 +832,11 @@
             END DO
             !
-         ELSEIF ( ln_dynvor_ens ) THEN                    !==  enstrophy conserving scheme  ==!
+         ELSEIF ( ln_dynvor_ens ) THEN                   !==  enstrophy conserving scheme  ==!
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
-                   &             + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
+                   &             + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
                   zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
-                   &             + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+                   &             + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
                   zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
                   zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
@@ -709,15 +844,15 @@
             END DO
             !
-         ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old ) THEN !==  energy and enstrophy conserving scheme  ==!
+         ELSEIF ( ln_dynvor_een ) THEN                   !==  energy and enstrophy conserving scheme  ==!
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_trd(ji,jj) = + z1_12 / e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
-                     &                                    + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
-                     &                                    + ftse(ji,jj  ) * zwy(ji  ,jj-1) & 
-                     &                                    + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
-                  zv_trd(ji,jj) = - z1_12 / e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 
-                     &                                    + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
-                     &                                    + ftnw(ji,jj  ) * zwx(ji-1,jj  ) & 
-                     &                                    + ftne(ji,jj  ) * zwx(ji  ,jj  ) )
+                  zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
+                     &                                       + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
+                     &                                       + ftse(ji,jj  ) * zwy(ji  ,jj-1) & 
+                     &                                       + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
+                  zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 
+                     &                                       + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
+                     &                                       + ftnw(ji,jj  ) * zwx(ji-1,jj  ) & 
+                     &                                       + ftne(ji,jj  ) * zwx(ji  ,jj  ) )
                END DO
             END DO
@@ -729,6 +864,6 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj)
-                  zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj)
+                  zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
+                  zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
                   zu_trd(ji,jj) = zu_trd(ji,jj) + zu_spg
                   zv_trd(ji,jj) = zv_trd(ji,jj) + zv_spg
@@ -738,53 +873,78 @@
          !
          ! Add bottom stresses:
-         zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * zun_e(:,:) * hur_e(:,:)
-         zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * zvn_e(:,:) * hvr_e(:,:)
+         zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:)
+         zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:)
+         !
+         ! Add top stresses:
+         zu_trd(:,:) = zu_trd(:,:) + tfrua(:,:) * un_e(:,:) * hur_e(:,:)
+         zv_trd(:,:) = zv_trd(:,:) + tfrva(:,:) * vn_e(:,:) * hvr_e(:,:)
          !
          ! Surface pressure trend:
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! Add surface pressure gradient
-               zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) / e1u(ji,jj)
-               zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) / e2v(ji,jj)
-               zwx(ji,jj) = zu_spg
-               zwy(ji,jj) = zv_spg
-            END DO
-         END DO
+
+         IF( ln_wd ) THEN
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1 
+                 ! Add surface pressure gradient
+                 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
+                 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
+                 zwx(ji,jj) = zu_spg * zcpx(ji,jj) 
+                 zwy(ji,jj) = zv_spg * zcpy(ji,jj)
+              END DO
+           END DO
+         ELSE
+           DO jj = 2, jpjm1
+              DO ji = fs_2, fs_jpim1   ! vector opt.
+                 ! Add surface pressure gradient
+                 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
+                 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
+                 zwx(ji,jj) = zu_spg
+                 zwy(ji,jj) = zv_spg
+              END DO
+           END DO
+         END IF
+
          !
          ! Set next velocities:
-         IF( ln_dynadv_vec .OR. (.NOT. lk_vvl) ) THEN 	! Vector form
+         IF( ln_dynadv_vec .OR. ln_linssh ) THEN 	!* Vector form
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ua_e(ji,jj) = (                                zun_e(ji,jj)   & 
+                  ua_e(ji,jj) = (                                 un_e(ji,jj)   & 
                             &     + rdtbt * (                      zwx(ji,jj)   &
                             &                                 + zu_trd(ji,jj)   &
                             &                                 + zu_frc(ji,jj) ) & 
-                            &   ) * umask(ji,jj,1)
-
-                  va_e(ji,jj) = (                                zvn_e(ji,jj)   &
+                            &   ) * ssumask(ji,jj)
+
+                  va_e(ji,jj) = (                                 vn_e(ji,jj)   &
                             &     + rdtbt * (                      zwy(ji,jj)   &
                             &                                 + zv_trd(ji,jj)   &
                             &                                 + zv_frc(ji,jj) ) &
-                            &   ) * vmask(ji,jj,1)
-               END DO
-            END DO
-
-         ELSE					 	! Flux form
+                            &   ) * ssvmask(ji,jj)
+               END DO
+            END DO
+            !
+         ELSE					 	                     !* Flux form
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
 
-                  zhura = umask(ji,jj,1)/(hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - umask(ji,jj,1))
-                  zhvra = vmask(ji,jj,1)/(hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - vmask(ji,jj,1))
-
-                  ua_e(ji,jj) = (                hu_e(ji,jj)  *  zun_e(ji,jj)   & 
+                  IF( ln_wd ) THEN
+                    zhura = MAX(hu_0(ji,jj) + zsshu_a(ji,jj), rn_wdmin1)
+                    zhvra = MAX(hv_0(ji,jj) + zsshv_a(ji,jj), rn_wdmin1)
+                  ELSE
+                    zhura = hu_0(ji,jj) + zsshu_a(ji,jj)
+                    zhvra = hv_0(ji,jj) + zsshv_a(ji,jj)
+                  END IF
+                  zhura = ssumask(ji,jj)/(zhura + 1._wp - ssumask(ji,jj))
+                  zhvra = ssvmask(ji,jj)/(zhvra + 1._wp - ssvmask(ji,jj))
+
+                  ua_e(ji,jj) = (                hu_e(ji,jj)  *   un_e(ji,jj)   & 
                             &     + rdtbt * ( zhust_e(ji,jj)  *    zwx(ji,jj)   & 
                             &               + zhup2_e(ji,jj)  * zu_trd(ji,jj)   &
-                            &               +      hu(ji,jj)  * zu_frc(ji,jj) ) &
+                            &               +    hu_n(ji,jj)  * zu_frc(ji,jj) ) &
                             &   ) * zhura
 
-                  va_e(ji,jj) = (                hv_e(ji,jj)  *  zvn_e(ji,jj)   &
+                  va_e(ji,jj) = (                hv_e(ji,jj)  *   vn_e(ji,jj)   &
                             &     + rdtbt * ( zhvst_e(ji,jj)  *    zwy(ji,jj)   &
                             &               + zhvp2_e(ji,jj)  * zv_trd(ji,jj)   &
-                            &               +      hv(ji,jj)  * zv_frc(ji,jj) ) &
+                            &               +    hv_n(ji,jj)  * zv_frc(ji,jj) ) &
                             &   ) * zhvra
                END DO
@@ -792,20 +952,22 @@
          ENDIF
          !
-         IF( lk_vvl ) THEN                             !* Update ocean depth (variable volume case only)
-            !                                          !  ----------------------------------------------        
-            hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:)
-            hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:)
-            hur_e(:,:) = umask(:,:,1) / ( hu_e(:,:) + 1._wp - umask(:,:,1) )
-            hvr_e(:,:) = vmask(:,:,1) / ( hv_e(:,:) + 1._wp - vmask(:,:,1) )
+         IF( .NOT.ln_linssh ) THEN                     !* Update ocean depth (variable volume case only)
+            IF( ln_wd ) THEN
+              hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1)
+              hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1)
+            ELSE
+              hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:)
+              hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:)
+            END IF
+            hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) )
+            hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) )
             !
          ENDIF
-         !                                                 !* domain lateral boundary
-         !                                                 !  -----------------------
-         !
+         !                                             !* domain lateral boundary
          CALL lbc_lnk_multi( ua_e, 'U', -1._wp, va_e , 'V', -1._wp )
-
+         !
 #if defined key_bdy  
-                                                           ! open boundaries
-         IF( lk_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, zun_e, zvn_e, hur_e, hvr_e, ssha_e )
+         !                                                 ! open boundaries
+         IF( lk_bdy )   CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e )
 #endif
 #if defined key_agrif                                                           
@@ -815,10 +977,10 @@
          !                                             !  ----
          ubb_e  (:,:) = ub_e  (:,:)
-         ub_e   (:,:) = zun_e (:,:)
-         zun_e  (:,:) = ua_e  (:,:)
+         ub_e   (:,:) = un_e  (:,:)
+         un_e   (:,:) = ua_e  (:,:)
          !
          vbb_e  (:,:) = vb_e  (:,:)
-         vb_e   (:,:) = zvn_e (:,:)
-         zvn_e  (:,:) = va_e  (:,:)
+         vb_e   (:,:) = vn_e  (:,:)
+         vn_e   (:,:) = va_e  (:,:)
          !
          sshbb_e(:,:) = sshb_e(:,:)
@@ -829,8 +991,8 @@
          !                                             !  ----------------------
          za1 = wgtbtp1(jn)                                    
-         IF (( ln_dynadv_vec ).OR. (.NOT. lk_vvl)) THEN    ! Sum velocities
+         IF( ln_dynadv_vec .OR. ln_linssh ) THEN    ! Sum velocities
             ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) 
             va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) 
-         ELSE                     			   ! Sum transports
+         ELSE                                              ! Sum transports
             ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:)
             va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:)
@@ -845,36 +1007,22 @@
       ! -----------------------------------------------------------------------------
       !
-      ! At this stage ssha holds a time averaged value
-      !                                                ! Sea Surface Height at u-,v- and f-points
-      IF( lk_vvl ) THEN                                ! (required only in key_vvl case)
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1      ! NO Vector Opt.
-               zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e12u(ji,jj) &
-                  &              * ( e12t(ji  ,jj) * ssha(ji  ,jj)    &
-                  &              +   e12t(ji+1,jj) * ssha(ji+1,jj) )
-               zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e12v(ji,jj) &
-                  &              * ( e12t(ji,jj  ) * ssha(ji,jj  )    &
-                  &              +   e12t(ji,jj+1) * ssha(ji,jj+1) )
-            END DO
-         END DO
-         CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions
-      ENDIF
-      !
       ! Set advection velocity correction:
-      IF (((kt==nit000).AND.(neuler==0)).OR.(.NOT.ln_bt_fw)) THEN     
-         un_adv(:,:) = zu_sum(:,:)*hur(:,:)
-         vn_adv(:,:) = zv_sum(:,:)*hvr(:,:)
+      zwx(:,:) = un_adv(:,:)
+      zwy(:,:) = vn_adv(:,:)
+      IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN     
+         un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:)
+         vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:)
       ELSE
-         un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zu_sum(:,:)) * hur(:,:)
-         vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zv_sum(:,:)) * hvr(:,:)
+         un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:)
+         vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:)
       END IF
 
-      IF (ln_bt_fw) THEN ! Save integrated transport for next computation
-         ub2_b(:,:) = zu_sum(:,:)
-         vb2_b(:,:) = zv_sum(:,:)
+      IF( ln_bt_fw ) THEN ! Save integrated transport for next computation
+         ub2_b(:,:) = zwx(:,:)
+         vb2_b(:,:) = zwy(:,:)
       ENDIF
       !
       ! Update barotropic trend:
-      IF (( ln_dynadv_vec ).OR. (.NOT. lk_vvl)) THEN
+      IF( ln_dynadv_vec .OR. ln_linssh ) THEN
          DO jk=1,jpkm1
             ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b
@@ -882,29 +1030,44 @@
          END DO
       ELSE
+         ! At this stage, ssha has been corrected: compute new depths at velocity points
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1      ! NO Vector Opt.
+               zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj) &
+                  &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)    &
+                  &              +   e1e2t(ji+1,jj) * ssha(ji+1,jj) )
+               zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj) &
+                  &              * ( e1e2t(ji,jj  ) * ssha(ji,jj  )    &
+                  &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) )
+            END DO
+         END DO
+         CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions
+         !
          DO jk=1,jpkm1
-            ua(:,:,jk) = ua(:,:,jk) + hur(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b
-            va(:,:,jk) = va(:,:,jk) + hvr(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b
+            ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b
+            va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b
          END DO
          ! Save barotropic velocities not transport:
-         ua_b  (:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - umask(:,:,1) )
-         va_b  (:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - vmask(:,:,1) )
+         ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) )
+         va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) )
       ENDIF
       !
       DO jk = 1, jpkm1
          ! Correct velocities:
-         un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) )*umask(:,:,jk)
-         vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) )*vmask(:,:,jk)
+         un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) * umask(:,:,jk)
+         vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) * vmask(:,:,jk)
          !
       END DO
+      !
+      CALL iom_put(  "ubar", un_adv(:,:)      )    ! barotropic i-current
+      CALL iom_put(  "vbar", vn_adv(:,:)      )    ! barotropic i-current
       !
 #if defined key_agrif
       ! Save time integrated fluxes during child grid integration
-      ! (used to update coarse grid transports)
-      ! Useless with 2nd order momentum schemes
-      !
-      IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw) ) THEN
-         IF ( Agrif_NbStepint().EQ.0 ) THEN
-            ub2_i_b(:,:) = 0.e0
-            vb2_i_b(:,:) = 0.e0
+      ! (used to update coarse grid transports at next time step)
+      !
+      IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN
+         IF( Agrif_NbStepint() == 0 ) THEN
+            ub2_i_b(:,:) = 0._wp
+            vb2_i_b(:,:) = 0._wp
          END IF
          !
@@ -913,21 +1076,24 @@
          vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:)
       ENDIF
-      !
-      !
 #endif      
-      !
       !                                   !* write time-spliting arrays in the restart
-      IF(lrst_oce .AND.ln_bt_fw)   CALL ts_rst( kt, 'WRITE' )
-      !
-      CALL wrk_dealloc( jpi, jpj, zsshp2_e, zhdiv )
-      CALL wrk_dealloc( jpi, jpj, zu_trd, zv_trd, zun_e, zvn_e )
-      CALL wrk_dealloc( jpi, jpj, zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc )
-      CALL wrk_dealloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e )
-      CALL wrk_dealloc( jpi, jpj, zsshu_a, zsshv_a                                   )
-      CALL wrk_dealloc( jpi, jpj, zhf )
-      !
+      IF( lrst_oce .AND.ln_bt_fw )   CALL ts_rst( kt, 'WRITE' )
+      !
+      CALL wrk_dealloc( jpi,jpj,   zsshp2_e, zhdiv )
+      CALL wrk_dealloc( jpi,jpj,   zu_trd, zv_trd )
+      CALL wrk_dealloc( jpi,jpj,   zwx, zwy, zssh_frc, zu_frc, zv_frc )
+      CALL wrk_dealloc( jpi,jpj,   zhup2_e, zhvp2_e, zhust_e, zhvst_e )
+      CALL wrk_dealloc( jpi,jpj,   zsshu_a, zsshv_a                                   )
+      CALL wrk_dealloc( jpi,jpj,   zhf )
+      IF( ln_wd ) CALL wrk_dealloc( jpi, jpj, zcpx, zcpy, wduflt1, wdvflt1 )
+      !
+      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')
       !
    END SUBROUTINE dyn_spg_ts
+
 
    SUBROUTINE ts_wgt( ll_av, ll_fw, jpit, zwgt1, zwgt2)
@@ -1008,4 +1174,5 @@
    END SUBROUTINE ts_wgt
 
+
    SUBROUTINE ts_rst( kt, cdrw )
       !!---------------------------------------------------------------------
@@ -1061,5 +1228,6 @@
    END SUBROUTINE ts_rst
 
-   SUBROUTINE dyn_spg_ts_init( kt )
+
+   SUBROUTINE dyn_spg_ts_init
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE dyn_spg_ts_init  ***
@@ -1067,53 +1235,28 @@
       !! ** Purpose : Set time splitting options
       !!----------------------------------------------------------------------
-      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
-      !
-      INTEGER  :: ji ,jj
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      REAL(wp) :: zxr2, zyr2, zcmax
-      REAL(wp), POINTER, DIMENSION(:,:) :: zcu
-      !!
-      NAMELIST/namsplit/ ln_bt_fw, ln_bt_av, ln_bt_nn_auto, &
-      &                  nn_baro, rn_bt_cmax, nn_bt_flt
+      INTEGER  ::   ji ,jj              ! dummy loop indices
+      REAL(wp) ::   zxr2, zyr2, zcmax   ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zcu
       !!----------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namsplit in reference namelist : time splitting parameters
-      READ  ( numnam_ref, namsplit, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namsplit in configuration namelist : time splitting parameters
-      READ  ( numnam_cfg, namsplit, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namsplit )
-      !
-      !         ! Max courant number for ext. grav. waves
-      !
-      CALL wrk_alloc( jpi, jpj, zcu )
-      !
-      IF (lk_vvl) THEN 
-         DO jj = 1, jpj
-            DO ji =1, jpi
-               zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj))
-               zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj))
-               zcu(ji,jj) = sqrt(grav*ht_0(ji,jj)*(zxr2 + zyr2) )
-            END DO
+      ! Max courant number for ext. grav. waves
+      !
+      CALL wrk_alloc( jpi,jpj,   zcu )
+      !
+      DO jj = 1, jpj
+         DO ji =1, jpi
+            zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj)
+            zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj)
+            zcu(ji,jj) = SQRT( grav * ht_0(ji,jj) * (zxr2 + zyr2) )
          END DO
-      ELSE
-         DO jj = 1, jpj
-            DO ji =1, jpi
-               zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj))
-               zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj))
-               zcu(ji,jj) = sqrt(grav*ht(ji,jj)*(zxr2 + zyr2) )
-            END DO
-         END DO
-      ENDIF
-
-      zcmax = MAXVAL(zcu(:,:))
+      END DO
+      !
+      zcmax = MAXVAL( zcu(:,:) )
       IF( lk_mpp )   CALL mpp_max( zcmax )
 
       ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax
-      IF (ln_bt_nn_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax)
+      IF( ln_bt_auto )   nn_baro = CEILING( rdt / rn_bt_cmax * zcmax)
       
-      rdtbt = rdt / FLOAT(nn_baro)
+      rdtbt = rdt / REAL( nn_baro , wp )
       zcmax = zcmax * rdtbt
 							! Print results
@@ -1121,9 +1264,9 @@
       IF(lwp) WRITE(numout,*) 'dyn_spg_ts : split-explicit free surface'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-      IF( ln_bt_nn_auto ) THEN
-         IF(lwp) WRITE(numout,*) '     ln_ts_nn_auto=.true. Automatically set nn_baro '
+      IF( ln_bt_auto ) THEN
+         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.true. Automatically set nn_baro '
          IF(lwp) WRITE(numout,*) '     Max. courant number allowed: ', rn_bt_cmax
       ELSE
-         IF(lwp) WRITE(numout,*) '     ln_ts_nn_auto=.false.: Use nn_baro in namelist '
+         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.false.: Use nn_baro in namelist '
       ENDIF
 
@@ -1143,13 +1286,13 @@
 #if defined key_agrif
       ! Restrict the use of Agrif to the forward case only
-      IF ((.NOT.ln_bt_fw ).AND.(.NOT.Agrif_Root())) CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' )
+      IF( .NOT.ln_bt_fw .AND. .NOT.Agrif_Root() )   CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' )
 #endif
       !
       IF(lwp) WRITE(numout,*)    '     Time filter choice, nn_bt_flt: ', nn_bt_flt
       SELECT CASE ( nn_bt_flt )
-           CASE( 0 )  ;   IF(lwp) WRITE(numout,*) '           Dirac'
-           CASE( 1 )  ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = nn_baro'
-           CASE( 2 )  ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = 2*nn_baro' 
-           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1,2' )
+         CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '           Dirac'
+         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = nn_baro'
+         CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = 2*nn_baro' 
+         CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1,2' )
       END SELECT
       !
@@ -1159,41 +1302,15 @@
       IF(lwp) WRITE(numout,*) '     Maximum Courant number is   :', zcmax
       !
-      IF ((.NOT.ln_bt_av).AND.(.NOT.ln_bt_fw)) THEN
+      IF( .NOT.ln_bt_av .AND. .NOT.ln_bt_fw ) THEN
          CALL ctl_stop( 'dynspg_ts ERROR: No time averaging => only forward integration is possible' )
       ENDIF
-      IF ( zcmax>0.9_wp ) THEN
+      IF( zcmax>0.9_wp ) THEN
          CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_baro !' )          
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, zcu )
+      CALL wrk_dealloc( jpi,jpj,   zcu )
       !
    END SUBROUTINE dyn_spg_ts_init
 
-#else
-   !!---------------------------------------------------------------------------
-   !!   Default case :   Empty module   No split explicit free surface
-   !!---------------------------------------------------------------------------
-CONTAINS
-   INTEGER FUNCTION dyn_spg_ts_alloc()    ! Dummy function
-      dyn_spg_ts_alloc = 0
-   END FUNCTION dyn_spg_ts_alloc
-   SUBROUTINE dyn_spg_ts( kt )            ! Empty routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'dyn_spg_ts: You should not have seen this print! error?', kt
-   END SUBROUTINE dyn_spg_ts
-   SUBROUTINE ts_rst( kt, cdrw )          ! Empty routine
-      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
-      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
-      WRITE(*,*) 'ts_rst    : You should not have seen this print! error?', kt, cdrw
-   END SUBROUTINE ts_rst  
-   SUBROUTINE dyn_spg_ts_init( kt )       ! Empty routine
-      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
-      WRITE(*,*) 'dyn_spg_ts_init   : You should not have seen this print! error?', kt
-   END SUBROUTINE dyn_spg_ts_init
-#endif
-   
    !!======================================================================
 END MODULE dynspg_ts
-
-
-
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 6808)
@@ -16,4 +16,5 @@
    !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!            3.7  ! 2014-04  (G. Madec) trend simplification: suppress jpdyn_trd_dat vorticity 
+   !!             -   ! 2014-06  (G. Madec) suppression of velocity curl from in-core memory
    !!----------------------------------------------------------------------
 
@@ -22,5 +23,4 @@
    !!       vor_ens  : enstrophy conserving scheme       (ln_dynvor_ens=T)
    !!       vor_ene  : energy conserving scheme          (ln_dynvor_ene=T)
-   !!       vor_mix  : mixed enstrophy/energy conserving (ln_dynvor_mix=T)
    !!       vor_een  : energy and enstrophy conserving   (ln_dynvor_een=T)
    !!   dyn_vor_init : set and control of the different vorticity option
@@ -32,4 +32,5 @@
    USE trd_oce        ! trends: ocean variables
    USE trddyn         ! trend manager: dynamics
+   !
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE prtctl         ! Print control
@@ -44,23 +45,37 @@
 
    PUBLIC   dyn_vor        ! routine called by step.F90
-   PUBLIC   dyn_vor_init   ! routine called by opa.F90
+   PUBLIC   dyn_vor_init   ! routine called by nemogcm.F90
 
    !                                   !!* Namelist namdyn_vor: vorticity term
-   LOGICAL, PUBLIC ::   ln_dynvor_ene   !: energy conserving scheme
-   LOGICAL, PUBLIC ::   ln_dynvor_ens   !: enstrophy conserving scheme
-   LOGICAL, PUBLIC ::   ln_dynvor_mix   !: mixed scheme
-   LOGICAL, PUBLIC ::   ln_dynvor_een   !: energy and enstrophy conserving scheme
-   LOGICAL, PUBLIC ::   ln_dynvor_een_old !: energy and enstrophy conserving scheme (original formulation)
-
-   INTEGER ::   nvor = 0   ! type of vorticity trend used
-   INTEGER ::   ncor = 1   ! coriolis
-   INTEGER ::   nrvm = 2   ! =2 relative vorticity ; =3 metric term
-   INTEGER ::   ntot = 4   ! =4 total vorticity (relative + planetary) ; =5 coriolis + metric term
-
+   LOGICAL, PUBLIC ::   ln_dynvor_ene   !: energy conserving scheme    (ENE)
+   LOGICAL, PUBLIC ::   ln_dynvor_ens   !: enstrophy conserving scheme (ENS)
+   LOGICAL, PUBLIC ::   ln_dynvor_mix   !: mixed scheme                (MIX)
+   LOGICAL, PUBLIC ::   ln_dynvor_een   !: energy and enstrophy conserving scheme (EEN)
+   INTEGER, PUBLIC ::      nn_een_e3f      !: e3f=masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+   LOGICAL, PUBLIC ::   ln_dynvor_msk   !: vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes)
+
+   INTEGER ::   nvor_scheme        ! choice of the type of advection scheme
+   !                               ! associated indices:
+   INTEGER, PUBLIC, PARAMETER ::   np_ENE = 1   ! ENE scheme
+   INTEGER, PUBLIC, PARAMETER ::   np_ENS = 2   ! ENS scheme
+   INTEGER, PUBLIC, PARAMETER ::   np_MIX = 3   ! MIX scheme
+   INTEGER, PUBLIC, PARAMETER ::   np_EEN = 4   ! EEN scheme
+
+   INTEGER ::   ncor, nrvm, ntot   ! choice of calculated vorticity 
+   !                               ! associated indices:
+   INTEGER, PARAMETER ::   np_COR = 1         ! Coriolis (planetary)
+   INTEGER, PARAMETER ::   np_RVO = 2         ! relative vorticity
+   INTEGER, PARAMETER ::   np_MET = 3         ! metric term
+   INTEGER, PARAMETER ::   np_CRV = 4         ! relative + planetary (total vorticity)
+   INTEGER, PARAMETER ::   np_CME = 5         ! Coriolis + metric term
+   
+   REAL(wp) ::   r1_4  = 0.250_wp         ! =1/4
+   REAL(wp) ::   r1_8  = 0.125_wp         ! =1/8
+   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! 1/12
+   
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -87,26 +102,11 @@
       IF( l_trddyn )   CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )
       !
-      !                                          ! vorticity term 
-      SELECT CASE ( nvor )                       ! compute the vorticity trend and add it to the general trend
-      !
-      CASE ( -1 )                                      ! esopa: test all possibility with control print
-         CALL vor_ene( kt, ntot, ua, va )
-         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor0 - Ua: ', mask1=umask, &
-            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-         CALL vor_ens( kt, ntot, ua, va )
-         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor1 - Ua: ', mask1=umask, &
-            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-         CALL vor_mix( kt )
-         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor2 - Ua: ', mask1=umask, &
-            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-         CALL vor_een( kt, ntot, ua, va )
-         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor3 - Ua: ', mask1=umask, &
-            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-         !
-      CASE ( 0 )                                       ! energy conserving scheme
-         IF( l_trddyn )   THEN
-            ztrdu(:,:,:) = ua(:,:,:)
-            ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_ene( kt, nrvm, ua, va )                ! relative vorticity or metric trend
+      SELECT CASE ( nvor_scheme )               !==  vorticity trend added to the general trend  ==!
+      !
+      CASE ( np_ENE )                                 !* energy conserving scheme
+         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ene( kt, nrvm, ua, va )                      ! relative vorticity or metric trend
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
@@ -114,17 +114,17 @@
             ztrdu(:,:,:) = ua(:,:,:)
             ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_ene( kt, ncor, ua, va )                ! planetary vorticity trend
+            CALL vor_ene( kt, ncor, ua, va )                      ! planetary vorticity trend
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
          ELSE
-            CALL vor_ene( kt, ntot, ua, va )                ! total vorticity
-         ENDIF
-         !
-      CASE ( 1 )                                       ! enstrophy conserving scheme
-         IF( l_trddyn )   THEN    
-            ztrdu(:,:,:) = ua(:,:,:)
-            ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_ens( kt, nrvm, ua, va )                ! relative vorticity or metric trend
+            CALL vor_ene( kt, ntot, ua, va )                ! total vorticity trend
+         ENDIF
+         !
+      CASE ( np_ENS )                                 !* enstrophy conserving scheme
+         IF( l_trddyn ) THEN                                ! trend diagnostics: splitthe trend in two    
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ens( kt, nrvm, ua, va )                      ! relative vorticity or metric trend
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
@@ -132,17 +132,17 @@
             ztrdu(:,:,:) = ua(:,:,:)
             ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_ens( kt, ncor, ua, va )                ! planetary vorticity trend
+            CALL vor_ens( kt, ncor, ua, va )                      ! planetary vorticity trend
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
          ELSE
-            CALL vor_ens( kt, ntot, ua, va )                ! total vorticity
-         ENDIF
-         !
-      CASE ( 2 )                                       ! mixed ene-ens scheme
-         IF( l_trddyn )   THEN
-            ztrdu(:,:,:) = ua(:,:,:)
-            ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_ens( kt, nrvm, ua, va )                ! relative vorticity or metric trend (ens)
+            CALL vor_ens( kt, ntot, ua, va )                ! total vorticity trend
+         ENDIF
+         !
+      CASE ( np_MIX )                                 !* mixed ene-ens scheme
+         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ens( kt, nrvm, ua, va )                      ! relative vorticity or metric trend (ens)
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
@@ -150,17 +150,18 @@
             ztrdu(:,:,:) = ua(:,:,:)
             ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_ene( kt, ncor, ua, va )                ! planetary vorticity trend (ene)
+            CALL vor_ene( kt, ncor, ua, va )                      ! planetary vorticity trend (ene)
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
          ELSE
-            CALL vor_mix( kt )                               ! total vorticity (mix=ens-ene)
-         ENDIF
-         !
-      CASE ( 3 )                                       ! energy and enstrophy conserving scheme
-         IF( l_trddyn )   THEN
-            ztrdu(:,:,:) = ua(:,:,:)
-            ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_een( kt, nrvm, ua, va )                ! relative vorticity or metric trend
+            CALL vor_ens( kt, nrvm, ua, va )                ! relative vorticity or metric trend (ens)
+            CALL vor_ene( kt, ncor, ua, va )                ! planetary vorticity trend (ene)
+        ENDIF
+         !
+      CASE ( np_EEN )                                 !* energy and enstrophy conserving scheme
+         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_een( kt, nrvm, ua, va )                      ! relative vorticity or metric trend
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
@@ -168,10 +169,10 @@
             ztrdu(:,:,:) = ua(:,:,:)
             ztrdv(:,:,:) = va(:,:,:)
-            CALL vor_een( kt, ncor, ua, va )                ! planetary vorticity trend
+            CALL vor_een( kt, ncor, ua, va )                      ! planetary vorticity trend
             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
          ELSE
-            CALL vor_een( kt, ntot, ua, va )                ! total vorticity
+            CALL vor_een( kt, ntot, ua, va )                ! total vorticity trend
          ENDIF
          !
@@ -197,15 +198,11 @@
       !!
       !! ** Method  :   Trend evaluated using now fields (centered in time) 
-      !!      and the Sadourny (1975) flux form formulation : conserves the
-      !!      horizontal kinetic energy.
-      !!      The trend of the vorticity term is given by:
-      !!       * s-coordinate (ln_sco=T), the e3. are inside the derivatives:
-      !!          voru = 1/e1u  mj-1[ (rotn+f)/e3f  mi(e1v*e3v vn) ]
-      !!          vorv = 1/e2v  mi-1[ (rotn+f)/e3f  mj(e2u*e3u un) ]
-      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
-      !!          voru = 1/e1u  mj-1[ (rotn+f)  mi(e1v vn) ]
-      !!          vorv = 1/e2v  mi-1[ (rotn+f)  mj(e2u un) ]
-      !!      Add this trend to the general momentum trend (ua,va):
-      !!          (ua,va) = (ua,va) + ( voru , vorv )
+      !!       and the Sadourny (1975) flux form formulation : conserves the
+      !!       horizontal kinetic energy.
+      !!         The general trend of momentum is increased due to the vorticity 
+      !!       term which is given by:
+      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v vn) ]
+      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f  mj(e2u*e3u un) ]
+      !!       where rvor is the relative vorticity
       !!
       !! ** Action : - Update (ua,va) with the now vorticity term trend
@@ -213,5 +210,4 @@
       !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
       !!----------------------------------------------------------------------
-      !
       INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index
       INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ;
@@ -220,7 +216,7 @@
       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
       !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zx1, zy1, zfact2, zx2, zy2   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, zwy, zwz   ! 2D workspace
       !!----------------------------------------------------------------------
       !
@@ -234,49 +230,65 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
       ENDIF
-
-      zfact2 = 0.5 * 0.5      ! Local constant initialization
-
-!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz )
+      !
       !                                                ! ===============
       DO jk = 1, jpkm1                                 ! Horizontal slab
          !                                             ! ===============
          !
-         ! Potential vorticity and horizontal fluxes
-         ! -----------------------------------------
-         SELECT CASE( kvor )      ! vorticity considered
-         CASE ( 1 )   ;   zwz(:,:) =                  ff(:,:)      ! planetary vorticity (Coriolis)
-         CASE ( 2 )   ;   zwz(:,:) =   rotn(:,:,jk)                ! relative  vorticity
-         CASE ( 3 )                                                ! metric term
+         SELECT CASE( kvor )                 !==  vorticity considered  ==!
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            zwz(:,:) = ff(:,:) 
+         CASE ( np_RVO )                           !* relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                     &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_MET )                           !* metric term
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
                   zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
                        &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )
-               END DO
-            END DO
-         CASE ( 4 )   ;   zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) )    ! total (relative + planetary vorticity)
-         CASE ( 5 )                                                ! total (coriolis + metric)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ( ff (ji,jj)                                                                       &
-                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
-                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                               &
-                       &       )
-               END DO
-            END DO
+                       &     * 0.5 * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                     &                      - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) &
+                     &                   * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff(ji,jj)                                                                        &
+                       &     + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &     * 0.5 * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
          END SELECT
+         !
+         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
 
          IF( ln_sco ) THEN
-            zwz(:,:) = zwz(:,:) / fse3f(:,:,jk)
-            zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
-            zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+            zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk)
+            zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
+            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
          ELSE
             zwx(:,:) = e2u(:,:) * un(:,:,jk)
             zwy(:,:) = e1v(:,:) * vn(:,:,jk)
          ENDIF
-
-         ! Compute and add the vorticity term trend
-         ! ----------------------------------------
+         !                                   !==  compute and add the vorticity term trend  =!
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -285,6 +297,6 @@
                zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1)
                zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1)
-               pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2 / e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
-               pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 / e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
+               pua(ji,jj,jk) = pua(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+               pva(ji,jj,jk) = pva(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
             END DO  
          END DO  
@@ -299,123 +311,4 @@
 
 
-   SUBROUTINE vor_mix( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE vor_mix  ***
-      !!
-      !! ** Purpose :   Compute the now total vorticity trend and add it to
-      !!      the general trend of the momentum equation.
-      !!
-      !! ** Method  :   Trend evaluated using now fields (centered in time)
-      !!      Mixte formulation : conserves the potential enstrophy of a hori-
-      !!      zontally non-divergent flow for (rotzu x uh), the relative vor-
-      !!      ticity term and the horizontal kinetic energy for (f x uh), the
-      !!      coriolis term. the now trend of the vorticity term is given by:
-      !!       * s-coordinate (ln_sco=T), the e3. are inside the derivatives:
-      !!          voru = 1/e1u  mj-1(rotn/e3f) mj-1[ mi(e1v*e3v vn) ]
-      !!              +1/e1u  mj-1[ f/e3f          mi(e1v*e3v vn) ]
-      !!          vorv = 1/e2v  mi-1(rotn/e3f) mi-1[ mj(e2u*e3u un) ]
-      !!              +1/e2v  mi-1[ f/e3f          mj(e2u*e3u un) ]
-      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
-      !!          voru = 1/e1u  mj-1(rotn) mj-1[ mi(e1v vn) ]
-      !!              +1/e1u  mj-1[ f          mi(e1v vn) ]
-      !!          vorv = 1/e2v  mi-1(rotn) mi-1[ mj(e2u un) ]
-      !!              +1/e2v  mi-1[ f          mj(e2u un) ]
-      !!      Add this now trend to the general momentum trend (ua,va):
-      !!          (ua,va) = (ua,va) + ( voru , vorv )
-      !!
-      !! ** Action : - Update (ua,va) arrays with the now vorticity term trend
-      !!
-      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
-      !!----------------------------------------------------------------------
-      !
-      INTEGER, INTENT(in) ::   kt   ! ocean timestep index
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zfact1, zua, zcua, zx1, zy1   ! local scalars
-      REAL(wp) ::   zfact2, zva, zcva, zx2, zy2   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('vor_mix')
-      !
-      CALL wrk_alloc( jpi, jpj, zwx, zwy, zwz, zww ) 
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn:vor_mix : vorticity term: mixed energy/enstrophy conserving scheme'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-
-      zfact1 = 0.5 * 0.25      ! Local constant initialization
-      zfact2 = 0.5 * 0.5
-
-!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, zww )
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !
-         ! Relative and planetary potential vorticity and horizontal fluxes
-         ! ----------------------------------------------------------------
-         IF( ln_sco ) THEN        
-            IF( ln_dynadv_vec ) THEN
-               zww(:,:) = rotn(:,:,jk) / fse3f(:,:,jk)
-            ELSE                       
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     zww(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
-                        &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                        &       * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) * fse3f(ji,jj,jk) )
-                  END DO
-               END DO
-            ENDIF
-            zwz(:,:) = ff  (:,:)    / fse3f(:,:,jk)
-            zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
-            zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
-         ELSE
-            IF( ln_dynadv_vec ) THEN
-               zww(:,:) = rotn(:,:,jk)
-            ELSE                       
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     zww(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
-                        &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                        &       * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) )
-                  END DO
-               END DO
-            ENDIF
-            zwz(:,:) = ff (:,:)
-            zwx(:,:) = e2u(:,:) * un(:,:,jk)
-            zwy(:,:) = e1v(:,:) * vn(:,:,jk)
-         ENDIF
-
-         ! Compute and add the vorticity term trend
-         ! ----------------------------------------
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj)
-               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
-               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj)
-               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
-               ! enstrophy conserving formulation for relative vorticity term
-               zua = zfact1 * ( zww(ji  ,jj-1) + zww(ji,jj) ) * ( zy1 + zy2 )
-               zva =-zfact1 * ( zww(ji-1,jj  ) + zww(ji,jj) ) * ( zx1 + zx2 )
-               ! energy conserving formulation for planetary vorticity term
-               zcua = zfact2 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
-               zcva =-zfact2 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
-               ! mixed vorticity trend added to the momentum trends
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zcua + zua
-               va(ji,jj,jk) = va(ji,jj,jk) + zcva + zva
-            END DO  
-         END DO  
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-      CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz, zww ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('vor_mix')
-      !
-   END SUBROUTINE vor_mix
-
-
    SUBROUTINE vor_ens( kt, kvor, pua, pva )
       !!----------------------------------------------------------------------
@@ -429,10 +322,6 @@
       !!      potential enstrophy of a horizontally non-divergent flow. the
       !!      trend of the vorticity term is given by:
-      !!       * s-coordinate (ln_sco=T), the e3. are inside the derivative:
-      !!          voru = 1/e1u  mj-1[ (rotn+f)/e3f ]  mj-1[ mi(e1v*e3v vn) ]
-      !!          vorv = 1/e2v  mi-1[ (rotn+f)/e3f ]  mi-1[ mj(e2u*e3u un) ]
-      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
-      !!          voru = 1/e1u  mj-1[ rotn+f ]  mj-1[ mi(e1v vn) ]
-      !!          vorv = 1/e2v  mi-1[ rotn+f ]  mi-1[ mj(e2u un) ]
+      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f ]  mj-1[ mi(e1v*e3v vn) ]
+      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f ]  mi-1[ mj(e2u*e3u un) ]
       !!      Add this trend to the general momentum trend (ua,va):
       !!          (ua,va) = (ua,va) + ( voru , vorv )
@@ -442,5 +331,4 @@
       !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
       !!----------------------------------------------------------------------
-      !
       INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index
       INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ;
@@ -449,7 +337,7 @@
       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
       !
-      INTEGER  ::   ji, jj, jk           ! dummy loop indices
-      REAL(wp) ::   zfact1, zuav, zvau   ! temporary scalars
-      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zuav, zvau   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, zwy, zwz, zww   ! 2D workspace
       !!----------------------------------------------------------------------
       !
@@ -463,63 +351,70 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
       ENDIF
-
-      zfact1 = 0.5 * 0.25      ! Local constant initialization
-
-!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz )
       !                                                ! ===============
       DO jk = 1, jpkm1                                 ! Horizontal slab
          !                                             ! ===============
          !
-         ! Potential vorticity and horizontal fluxes
-         ! -----------------------------------------
-         SELECT CASE( kvor )      ! vorticity considered
-         CASE ( 1 )   ;   zwz(:,:) =                  ff(:,:)      ! planetary vorticity (Coriolis)
-         CASE ( 2 )   ;   zwz(:,:) =   rotn(:,:,jk)                ! relative  vorticity
-         CASE ( 3 )                                                ! metric term
+         SELECT CASE( kvor )                 !==  vorticity considered  ==!
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            zwz(:,:) = ff(:,:) 
+         CASE ( np_RVO )                           !* relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                     &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_MET )                           !* metric term
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
                   zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
                        &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )
-               END DO
-            END DO
-         CASE ( 4 )   ;   zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) )    ! total (relative + planetary vorticity)
-         CASE ( 5 )                                                ! total (coriolis + metric)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ( ff (ji,jj)                                                                       &
-                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
-                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                                &
-                       &       )
-               END DO
-            END DO
+                       &     * 0.5 * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                     &                      - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) &
+                     &                   * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff(ji,jj)                                                                       &
+                       &     + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &     * 0.5 * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
          END SELECT
          !
-         IF( ln_sco ) THEN
-            DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop 
-               DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking
-                  zwz(ji,jj) = zwz(ji,jj) / fse3f(ji,jj,jk)
-                  zwx(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk)
-                  zwy(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk)
-               END DO
-            END DO
+         IF( ln_dynvor_msk ) THEN           !==  mask/unmask vorticity ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+         !
+         IF( ln_sco ) THEN                   !==  horizontal fluxes  ==!
+            zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk)
+            zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
+            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
          ELSE
-            DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop 
-               DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking
-                  zwx(ji,jj) = e2u(ji,jj) * un(ji,jj,jk)
-                  zwy(ji,jj) = e1v(ji,jj) * vn(ji,jj,jk)
-               END DO
-            END DO
-         ENDIF
-         !
-         ! Compute and add the vorticity term trend
-         ! ----------------------------------------
+            zwx(:,:) = e2u(:,:) * un(:,:,jk)
+            zwy(:,:) = e1v(:,:) * vn(:,:,jk)
+         ENDIF
+         !                                   !==  compute and add the vorticity term trend  =!
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zuav = zfact1 / e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   &
-                  &                         + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) )
-               zvau =-zfact1 / e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   &
-                  &                         + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) )
+               zuav = r1_8 * r1_e1u(ji,jj) * (  zwy(ji  ,jj-1) + zwy(ji+1,jj-1)  &
+                  &                           + zwy(ji  ,jj  ) + zwy(ji+1,jj  )  )
+               zvau =-r1_8 * r1_e2v(ji,jj) * (  zwx(ji-1,jj  ) + zwx(ji-1,jj+1)  &
+                  &                           + zwx(ji  ,jj  ) + zwx(ji  ,jj+1)  )
                pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
                pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
@@ -553,32 +448,22 @@
       !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36
       !!----------------------------------------------------------------------
-      !
       INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index
-      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ;
-      !                                                           ! =nrvm (relative vorticity or metric)
+      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; =nrvm (relative or metric)
       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua    ! total u-trend
       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
-      !!
-      INTEGER  ::   ji, jj, jk                                    ! dummy loop indices
-      INTEGER  ::   ierr                                          ! local integer
-      REAL(wp) ::   zfac12, zua, zva                              ! local scalars
-      REAL(wp) ::   zmsk, ze3                                     ! local scalars
-      !                                                           !  3D workspace 
-      REAL(wp), POINTER    , DIMENSION(:,:  )         :: zwx, zwy, zwz
-      REAL(wp), POINTER    , DIMENSION(:,:  )         :: ztnw, ztne, ztsw, ztse
-#if defined key_vvl
-      REAL(wp), POINTER    , DIMENSION(:,:,:)         :: ze3f     !  3D workspace (lk_vvl=T)
-#else
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE   :: ze3f     ! lk_vvl=F, ze3f=1/e3f saved one for all
-#endif
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ierr         ! local integer
+      REAL(wp) ::   zua, zva     ! local scalars
+      REAL(wp) ::   zmsk, ze3    ! local scalars
+      !
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zwx, zwy, zwz, z1_e3f
+      REAL(wp), POINTER, DIMENSION(:,:)   :: ztnw, ztne, ztsw, ztse
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('vor_een')
       !
-      CALL wrk_alloc( jpi, jpj,      zwx , zwy , zwz        ) 
-      CALL wrk_alloc( jpi, jpj,      ztnw, ztne, ztsw, ztse ) 
-#if defined key_vvl
-      CALL wrk_alloc( jpi, jpj, jpk, ze3f                   )
-#endif
+      CALL wrk_alloc( jpi,jpj,   zwx , zwy , zwz , z1_e3f ) 
+      CALL wrk_alloc( jpi,jpj,   ztnw, ztne, ztsw, ztse   ) 
       !
       IF( kt == nit000 ) THEN
@@ -586,90 +471,97 @@
          IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme'
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-#if ! defined key_vvl
-         IF( .NOT.ALLOCATED(ze3f) ) THEN
-            ALLOCATE( ze3f(jpi,jpj,jpk) , STAT=ierr )
-            IF( lk_mpp    )   CALL mpp_sum ( ierr )
-            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dyn:vor_een : unable to allocate arrays' )
-         ENDIF
-         ze3f(:,:,:) = 0._wp
-#endif
       ENDIF
-
-      IF( kt == nit000 .OR. lk_vvl ) THEN      ! reciprocal of e3 at F-point (masked averaging of e3t over ocean points)
-
-         IF( ln_dynvor_een_old ) THEN ! original formulation
-            DO jk = 1, jpk
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
-                        &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) )
-                     IF( ze3 /= 0._wp )   ze3f(ji,jj,jk) = 4.0_wp / ze3
-                  END DO
-               END DO
-            END DO
-         ELSE ! new formulation from NEMO 3.6
-            DO jk = 1, jpk
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
-                        &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) )
-                     zmsk = (                   tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   &
-                        &                     + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk) )
-                     IF( ze3 /= 0._wp )   ze3f(ji,jj,jk) = zmsk / ze3
-                  END DO
-               END DO
-            END DO
-         ENDIF
-
-         CALL lbc_lnk( ze3f, 'F', 1. )
-      ENDIF
-
-      zfac12 = 1._wp / 12._wp    ! Local constant initialization
-
-      
-!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse )
+      !
       !                                                ! ===============
       DO jk = 1, jpkm1                                 ! Horizontal slab
          !                                             ! ===============
-         
-         ! Potential vorticity and horizontal fluxes
-         ! -----------------------------------------
-         SELECT CASE( kvor )      ! vorticity considered
-         CASE ( 1 )                                                ! planetary vorticity (Coriolis)
-            zwz(:,:) = ff(:,:)      * ze3f(:,:,jk)
-         CASE ( 2 )                                                ! relative  vorticity
-            zwz(:,:) = rotn(:,:,jk) * ze3f(:,:,jk)
-         CASE ( 3 )                                                ! metric term
+         !
+         SELECT CASE( nn_een_e3f )           ! == reciprocal of e3 at F-point
+         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ze3  = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
+                     &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)  )
+                  IF( ze3 /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4._wp / ze3
+                  ELSE                      ;   z1_e3f(ji,jj) = 0._wp
+                  ENDIF
+               END DO
+            END DO
+         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ze3  = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
+                     &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)  )
+                  zmsk = (                    tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   &
+                     &                      + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk)  )
+                  IF( ze3 /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = zmsk / ze3
+                  ELSE                      ;   z1_e3f(ji,jj) = 0._wp
+                  ENDIF
+               END DO
+            END DO
+         END SELECT
+         !
+         SELECT CASE( kvor )                 !==  vorticity considered  ==!
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff(ji,jj) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_RVO )                           !* relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                     &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) &
+                     &       * r1_e1e2f(ji,jj) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_MET )                           !* metric term
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
                   zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
                        &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk)
-               END DO
-            END DO
-            CALL lbc_lnk( zwz, 'F', 1. )
-        CASE ( 4 )                                                ! total (relative + planetary vorticity)
-            zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk)
-         CASE ( 5 )                                                ! total (coriolis + metric)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwz(ji,jj) = ( ff (ji,jj)                                                                       &
-                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
-                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
-                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                                &
-                       &       ) * ze3f(ji,jj,jk)
-               END DO
-            END DO
-            CALL lbc_lnk( zwz, 'F', 1. )
+                       &     * 0.5 * r1_e1e2f(ji,jj) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                     &                         - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) &
+                     &                      * r1_e1e2f(ji,jj)    ) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  ff(ji,jj)                                                                        &
+                       &        + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &            - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &        * 0.5 * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
          END SELECT
-
-         zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
-         zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
-
-         ! Compute and add the vorticity term trend
-         ! ----------------------------------------
+         !
+         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+         !
+         CALL lbc_lnk( zwz, 'F', 1. )
+         !
+         !                                   !==  horizontal fluxes  ==!
+         zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
+         zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
+
+         !                                   !==  compute and add the vorticity term trend  =!
          jj = 2
          ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0
-         DO ji = 2, jpi   
+         DO ji = 2, jpi          ! split in 2 parts due to vector opt.
                ztne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
                ztnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
@@ -687,8 +579,8 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zua = + zfac12 / e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
-                  &                           + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
-               zva = - zfac12 / e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
-                  &                           + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
+               zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
+                  &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
+               zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
+                  &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
                pua(ji,jj,jk) = pua(ji,jj,jk) + zua
                pva(ji,jj,jk) = pva(ji,jj,jk) + zva
@@ -698,9 +590,7 @@
       END DO                                           !   End of slab
       !                                                ! ===============
-      CALL wrk_dealloc( jpi, jpj,      zwx , zwy , zwz        ) 
-      CALL wrk_dealloc( jpi, jpj,      ztnw, ztne, ztsw, ztse ) 
-#if defined key_vvl
-      CALL wrk_dealloc( jpi, jpj, jpk, ze3f                   )
-#endif
+      !
+      CALL wrk_dealloc( jpi,jpj,   zwx , zwy , zwz , z1_e3f ) 
+      CALL wrk_dealloc( jpi,jpj,   ztnw, ztne, ztsw, ztse   ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('vor_een')
@@ -720,5 +610,5 @@
       INTEGER ::   ios             ! Local integer output status for namelist read
       !!
-      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een, ln_dynvor_een_old
+      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een, nn_een_e3f, ln_dynvor_msk
       !!----------------------------------------------------------------------
 
@@ -737,13 +627,17 @@
          WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) '        Namelist namdyn_vor : choice of the vorticity term scheme'
-         WRITE(numout,*) '           energy    conserving scheme                ln_dynvor_ene = ', ln_dynvor_ene
-         WRITE(numout,*) '           enstrophy conserving scheme                ln_dynvor_ens = ', ln_dynvor_ens
-         WRITE(numout,*) '           mixed enstrophy/energy conserving scheme   ln_dynvor_mix = ', ln_dynvor_mix
-         WRITE(numout,*) '           enstrophy and energy conserving scheme     ln_dynvor_een = ', ln_dynvor_een
-         WRITE(numout,*) '           enstrophy and energy conserving scheme (old) ln_dynvor_een_old= ', ln_dynvor_een_old
+         WRITE(numout,*) '           energy    conserving scheme                    ln_dynvor_ene = ', ln_dynvor_ene
+         WRITE(numout,*) '           enstrophy conserving scheme                    ln_dynvor_ens = ', ln_dynvor_ens
+         WRITE(numout,*) '           mixed enstrophy/energy conserving scheme       ln_dynvor_mix = ', ln_dynvor_mix
+         WRITE(numout,*) '           enstrophy and energy conserving scheme         ln_dynvor_een = ', ln_dynvor_een
+         WRITE(numout,*) '              e3f = averaging /4 (=0) or /sum(tmask) (=1)    nn_een_e3f = ', nn_een_e3f
+         WRITE(numout,*) '           masked (=T) or unmasked(=F) vorticity          ln_dynvor_msk = ', ln_dynvor_msk
       ENDIF
 
+!!gm  this should be removed when choosing a unique strategy for fmask at the coast
       ! If energy, enstrophy or mixed advection of momentum in vector form change the value for masks
       ! at angles with three ocean points and one land point
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '           namlbc: change fmask value in the angles (T)   ln_vorlat = ', ln_vorlat
       IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN
          DO jk = 1, jpk
@@ -759,42 +653,32 @@
           !
       ENDIF
-
-      ioptio = 0                     ! Control of vorticity scheme options
-      IF( ln_dynvor_ene )   ioptio = ioptio + 1
-      IF( ln_dynvor_ens )   ioptio = ioptio + 1
-      IF( ln_dynvor_mix )   ioptio = ioptio + 1
-      IF( ln_dynvor_een )   ioptio = ioptio + 1
-      IF( ln_dynvor_een_old )   ioptio = ioptio + 1
-      IF( lk_esopa      )   ioptio =          1
-
+!!gm end
+
+      ioptio = 0                     ! type of scheme for vorticity (set nvor_scheme)
+      IF( ln_dynvor_ene ) THEN   ;   ioptio = ioptio + 1   ;    nvor_scheme = np_ENE   ;   ENDIF
+      IF( ln_dynvor_ens ) THEN   ;   ioptio = ioptio + 1   ;    nvor_scheme = np_ENS   ;   ENDIF
+      IF( ln_dynvor_mix ) THEN   ;   ioptio = ioptio + 1   ;    nvor_scheme = np_MIX   ;   ENDIF
+      IF( ln_dynvor_een ) THEN   ;   ioptio = ioptio + 1   ;    nvor_scheme = np_EEN   ;   ENDIF
+      !
       IF( ioptio /= 1 ) CALL ctl_stop( ' use ONE and ONLY one vorticity scheme' )
-
-      !                              ! Set nvor (type of scheme for vorticity)
-      IF( ln_dynvor_ene )   nvor =  0
-      IF( ln_dynvor_ens )   nvor =  1
-      IF( ln_dynvor_mix )   nvor =  2
-      IF( ln_dynvor_een .or. ln_dynvor_een_old )   nvor =  3
-      IF( lk_esopa      )   nvor = -1
-      
-      !                              ! Set ncor, nrvm, ntot (type of vorticity)
-      IF(lwp) WRITE(numout,*)
-      ncor = 1
+      !                      
+      IF(lwp) WRITE(numout,*)        ! type of calculated vorticity (set ncor, nrvm, ntot)
+      ncor = np_COR
       IF( ln_dynadv_vec ) THEN     
          IF(lwp) WRITE(numout,*) '         Vector form advection : vorticity = Coriolis + relative vorticity'
-         nrvm = 2
-         ntot = 4
+         nrvm = np_RVO        ! relative vorticity
+         ntot = np_CRV        ! relative + planetary vorticity
       ELSE                        
          IF(lwp) WRITE(numout,*) '         Flux form advection   : vorticity = Coriolis + metric term'
-         nrvm = 3
-         ntot = 5
+         nrvm = np_MET        ! metric term
+         ntot = np_CME        ! Coriolis + metric term
       ENDIF
       
       IF(lwp) THEN                   ! Print the choice
          WRITE(numout,*)
-         IF( nvor ==  0 )   WRITE(numout,*) '         vorticity scheme : energy conserving scheme'
-         IF( nvor ==  1 )   WRITE(numout,*) '         vorticity scheme : enstrophy conserving scheme'
-         IF( nvor ==  2 )   WRITE(numout,*) '         vorticity scheme : mixed enstrophy/energy conserving scheme'
-         IF( nvor ==  3 )   WRITE(numout,*) '         vorticity scheme : energy and enstrophy conserving scheme'
-         IF( nvor == -1 )   WRITE(numout,*) '         esopa test: use all lateral physics options'
+         IF( nvor_scheme ==  np_ENE )   WRITE(numout,*) '         vorticity scheme ==>> energy conserving scheme'
+         IF( nvor_scheme ==  np_ENS )   WRITE(numout,*) '         vorticity scheme ==>> enstrophy conserving scheme'
+         IF( nvor_scheme ==  np_MIX )   WRITE(numout,*) '         vorticity scheme ==>> mixed enstrophy/energy conserving scheme'
+         IF( nvor_scheme ==  np_EEN )   WRITE(numout,*) '         vorticity scheme ==>> energy and enstrophy conserving scheme'
       ENDIF
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 6808)
@@ -32,5 +32,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -49,6 +48,6 @@
       !!
       !! ** Method  :   The now vertical advection of momentum is given by:
-      !!         w dz(u) = ua + 1/(e1u*e2u*e3u) mk+1[ mi(e1t*e2t*wn) dk(un) ]
-      !!         w dz(v) = va + 1/(e1v*e2v*e3v) mk+1[ mj(e1t*e2t*wn) dk(vn) ]
+      !!         w dz(u) = ua + 1/(e1e2u*e3u) mk+1[ mi(e1e2t*wn) dk(un) ]
+      !!         w dz(v) = va + 1/(e1e2v*e3v) mk+1[ mj(e1e2t*wn) dk(vn) ]
       !!      Add this trend to the general trend (ua,va):
       !!         (ua,va) = (ua,va) + w dz(u,v)
@@ -85,11 +84,11 @@
          DO jj = 2, jpj                   ! vertical fluxes 
             DO ji = fs_2, jpi             ! vector opt.
-               zww(ji,jj) = 0.25_wp * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk)
+               zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
             END DO
          END DO
          DO jj = 2, jpjm1                 ! vertical momentum advection at w-point
             DO ji = fs_2, fs_jpim1        ! vector opt.
-               zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( un(ji,jj,jk-1)-un(ji,jj,jk) )
-               zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( vn(ji,jj,jk-1)-vn(ji,jj,jk) )
+               zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )
+               zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )
             END DO  
          END DO   
@@ -121,6 +120,6 @@
             DO ji = fs_2, fs_jpim1       ! vector opt.
                !                         ! vertical momentum advective trends
-               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
-               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
                !                         ! add the trends to the general momentum trends
                ua(ji,jj,jk) = ua(ji,jj,jk) + zua
@@ -146,4 +145,5 @@
       !
    END SUBROUTINE dyn_zad
+
 
    SUBROUTINE dyn_zad_zts ( kt )
@@ -182,6 +182,6 @@
       IF( nn_timing == 1 )  CALL timing_start('dyn_zad_zts')
       !
-      CALL wrk_alloc( jpi,jpj,jpk, zwuw , zwvw, zww ) 
-      CALL wrk_alloc( jpi,jpj,jpk,3, zus, zvs ) 
+      CALL wrk_alloc( jpi,jpj,jpk,     zwuw, zwvw, zww ) 
+      CALL wrk_alloc( jpi,jpj,jpk,3,   zus , zvs ) 
       !
       IF( kt == nit000 ) THEN
@@ -205,12 +205,12 @@
          DO jj = 2, jpj                   
             DO ji = fs_2, jpi             ! vector opt.
-               zww(ji,jj,jk) = 0.25_wp * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk)
+               zww(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
             END DO
          END DO
       END DO
-      !
-      ! Surface and bottom advective fluxes set to zero
-      DO jj = 2, jpjm1        
+
+      DO jj = 2, jpjm1                    ! Surface and bottom advective fluxes set to zero
          DO ji = fs_2, fs_jpim1           ! vector opt.
+ !!gm missing ISF boundary condition
             zwuw(ji,jj, 1 ) = 0._wp
             zwvw(ji,jj, 1 ) = 0._wp
@@ -251,6 +251,6 @@
                DO ji = fs_2, fs_jpim1       ! vector opt.
                   !                         ! vertical momentum advective trends
-                  zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
-                  zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+                  zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+                  zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
                   zus(ji,jj,jk,jta) = zus(ji,jj,jk,jtb) + zua * zts
                   zvs(ji,jj,jk,jta) = zvs(ji,jj,jk,jtb) + zva * zts
@@ -283,6 +283,6 @@
          &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
-      CALL wrk_dealloc( jpi,jpj,jpk, zwuw , zwvw, zww ) 
-      CALL wrk_dealloc( jpi,jpj,jpk,3, zus, zvs ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,     zwuw, zwvw, zww ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,3,   zus , zvs ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('dyn_zad_zts')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 6808)
@@ -9,22 +9,21 @@
 
    !!----------------------------------------------------------------------
-   !!   dyn_zdf      : Update the momentum trend with the vertical diffusion
-   !!   dyn_zdf_init : initializations of the vertical diffusion scheme
+   !!   dyn_zdf       : Update the momentum trend with the vertical diffusion
+   !!   dyn_zdf_init  : initializations of the vertical diffusion scheme
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE zdf_oce         ! ocean vertical physics variables
-
-   USE dynzdf_exp      ! vertical diffusion: explicit (dyn_zdf_exp     routine)
-   USE dynzdf_imp      ! vertical diffusion: implicit (dyn_zdf_imp     routine)
-
-   USE ldfdyn_oce      ! ocean dynamics: lateral physics
-   USE trd_oce         ! trends: ocean variables
-   USE trddyn          ! trend manager: dynamics
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE prtctl          ! Print control
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables 
+   USE zdf_oce        ! ocean vertical physics variables
+   USE dynzdf_exp     ! vertical diffusion: explicit (dyn_zdf_exp     routine)
+   USE dynzdf_imp     ! vertical diffusion: implicit (dyn_zdf_imp     routine)
+   USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -35,9 +34,6 @@
 
    INTEGER  ::   nzdf = 0   ! type vertical diffusion algorithm used, defined from ln_zdf... namlist logicals
-   REAL(wp) ::   r2dt       ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -61,9 +57,9 @@
       !!---------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('dyn_zdf')
+      IF( nn_timing == 1 )   CALL timing_start('dyn_zdf')
       !
       !                                          ! set time step
-      IF( neuler == 0 .AND. kt == nit000     ) THEN   ;   r2dt =      rdt   ! = rdtra (restart with Euler time stepping)
-      ELSEIF(               kt <= nit000 + 1 ) THEN   ;   r2dt = 2. * rdt   ! = 2 rdttra (leapfrog)
+      IF( neuler == 0 .AND. kt == nit000     ) THEN   ;   r2dt =      rdt   ! = rdt (restart with Euler time stepping)
+      ELSEIF(               kt <= nit000 + 1 ) THEN   ;   r2dt = 2. * rdt   ! = 2 rdt (leapfrog)
       ENDIF
 
@@ -79,16 +75,9 @@
       CASE ( 1 )   ;   CALL dyn_zdf_imp( kt, r2dt )      ! implicit scheme
       !
-      CASE ( -1 )                                        ! esopa: test all possibility with control print
-                       CALL dyn_zdf_exp( kt, r2dt )
-                       CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf0 - Ua: ', mask1=umask,               &
-                          &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-                       CALL dyn_zdf_imp( kt, r2dt )
-                       CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf1 - Ua: ', mask1=umask,               &
-                          &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       END SELECT
 
       IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+         ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:)
+         ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:)
          CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt )
          CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
@@ -96,7 +85,7 @@
       !                                          ! print mean trends (used for debugging)
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf  - Ua: ', mask1=umask,               &
-            &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dyn_zdf')
+         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+         !
+      IF( nn_timing == 1 )   CALL timing_stop('dyn_zdf')
       !
    END SUBROUTINE dyn_zdf
@@ -114,5 +103,4 @@
       USE zdftke
       USE zdfgls
-      USE zdfkpp
       !!----------------------------------------------------------------------
       !
@@ -123,9 +111,7 @@
       !
       ! Force implicit schemes
-      IF( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp )   nzdf = 1   ! TKE, GLS or KPP physics
-      IF( ln_dynldf_iso                           )   nzdf = 1   ! iso-neutral lateral physics
-      IF( ln_dynldf_hor .AND. ln_sco              )   nzdf = 1   ! horizontal lateral physics in s-coordinate
-      !
-      IF( lk_esopa )    nzdf = -1                   ! Esopa key: All schemes used
+      IF( lk_zdftke .OR. lk_zdfgls   )   nzdf = 1   ! TKE or GLS physics
+      IF( ln_dynldf_iso              )   nzdf = 1   ! iso-neutral lateral physics
+      IF( ln_dynldf_hor .AND. ln_sco )   nzdf = 1   ! horizontal lateral physics in s-coordinate
       !
       IF(lwp) THEN                                  ! Print the choice
@@ -133,5 +119,4 @@
          WRITE(numout,*) 'dyn_zdf_init : vertical dynamics physics scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
-         IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
          IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme'
          IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 6808)
@@ -8,21 +8,22 @@
    !!   NEMO     0.5  !  2002-08  (G. Madec)  F90: Free form and module
    !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
+   !!            3.7  !  2015-11  (J. Chanut) output velocities instead of trends
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   dyn_zdf_exp  : update the momentum trend with the vertical diffu-
-   !!                  sion using an explicit time-stepping scheme.
+   !!   dyn_zdf_exp   : update the momentum trend with the vertical diffusion using a split-explicit scheme
+   !!                   and perform the Leap-Frog time integration.
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE zdf_oce         ! ocean vertical physics
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE lib_mpp         ! MPP library
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE zdf_oce        ! ocean vertical physics
+   USE dynadv   , ONLY: ln_dynadv_vec ! Momentum advection form
+   USE sbc_oce        ! surface boundary condition: ocean
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -32,8 +33,7 @@
    
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -46,7 +46,8 @@
       !!                   
       !! ** Purpose :   Compute the trend due to the vert. momentum diffusion
+      !!              and perform the Leap-Frog time stepping.
       !!
-      !! ** Method  :   Explicit forward time stepping with a time splitting
-      !!      technique. The vertical diffusion of momentum is given by:
+      !! ** Method  : - Split-explicit forward time stepping.
+      !!      The vertical mixing of momentum is given by:
       !!         diffu = dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ub) )
       !!      Surface boundary conditions: wind stress input (averaged over kt-1/2 & kt+1/2)
@@ -54,18 +55,21 @@
       !!      Add this trend to the general trend ua :
       !!         ua = ua + dz( avmu dz(u) )
+      !!              - Leap-Frog time stepping (Asselin filter will be applied in dyn_nxt) 
+      !!         ua =         ub + 2*dt *       ua             vector form or linear free surf.
+      !!         ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a   otherwise
       !!
-      !! ** Action : - Update (ua,va) with the vertical diffusive trend
+      !! ** Action : - (ua,va) after velocity
       !!---------------------------------------------------------------------
       INTEGER , INTENT(in) ::   kt     ! ocean time-step index
       REAL(wp), INTENT(in) ::   p2dt   ! time-step 
       !
-      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      INTEGER  ::   ji, jj, jk, jl     ! dummy loop indices
       REAL(wp) ::   zlavmr, zua, zva   ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwx, zwy, zwz, zww
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('dyn_zdf_exp')
+      IF( nn_timing == 1 )   CALL timing_start('dyn_zdf_exp')
       !
-      CALL wrk_alloc( jpi,jpj,jpk, zwx, zwy, zwz, zww ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   zwx, zwy, zwz, zww ) 
       !
       IF( kt == nit000 .AND. lwp ) THEN
@@ -74,9 +78,10 @@
          WRITE(numout,*) '~~~~~~~~~~~ '
       ENDIF
-
+      !
+      !                 !==  vertical mixing trend  ==!
+      !
       zlavmr = 1. / REAL( nn_zdfexp )
-
-
-      DO jj = 2, jpjm1                 ! Surface boundary condition
+      !
+      DO jj = 2, jpjm1           ! Surface boundary condition
          DO ji = 2, jpim1
             zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * r1_rau0
@@ -84,5 +89,5 @@
          END DO  
       END DO  
-      DO jk = 1, jpk                   ! Initialization of x, z and contingently trends array
+      DO jk = 1, jpk             ! Initialization of x, z and contingently trends array
          DO jj = 2, jpjm1 
             DO ji = 2, jpim1
@@ -93,19 +98,19 @@
       END DO  
       !
-      DO jl = 1, nn_zdfexp             ! Time splitting loop
+      DO jl = 1, nn_zdfexp       ! Time splitting loop
          !
-         DO jk = 2, jpk                      ! First vertical derivative
+         DO jk = 2, jpk                ! First vertical derivative
             DO jj = 2, jpjm1 
                DO ji = 2, jpim1
-                  zwy(ji,jj,jk) = avmu(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) / fse3uw(ji,jj,jk) 
-                  zww(ji,jj,jk) = avmv(ji,jj,jk) * ( zwz(ji,jj,jk-1) - zwz(ji,jj,jk) ) / fse3vw(ji,jj,jk)
+                  zwy(ji,jj,jk) = avmu(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) / e3uw_n(ji,jj,jk) 
+                  zww(ji,jj,jk) = avmv(ji,jj,jk) * ( zwz(ji,jj,jk-1) - zwz(ji,jj,jk) ) / e3vw_n(ji,jj,jk)
                END DO  
             END DO  
          END DO  
-         DO jk = 1, jpkm1                    ! Second vertical derivative and trend estimation at kt+l*rdt/nn_zdfexp
+         DO jk = 1, jpkm1              ! Second vertical derivative and trend estimation at kt+l*rdt/nn_zdfexp
             DO jj = 2, jpjm1 
                DO ji = 2, jpim1
-                  zua = zlavmr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) / fse3u(ji,jj,jk)
-                  zva = zlavmr * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) ) / fse3v(ji,jj,jk)
+                  zua = zlavmr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) / e3u_n(ji,jj,jk)
+                  zva = zlavmr * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) ) / e3v_n(ji,jj,jk)
                   ua(ji,jj,jk) = ua(ji,jj,jk) + zua
                   va(ji,jj,jk) = va(ji,jj,jk) + zva
@@ -116,10 +121,26 @@
             END DO  
          END DO  
-         !
-      END DO                           ! End of time splitting
+      END DO                     ! End of time splitting
       !
-      CALL wrk_dealloc( jpi,jpj,jpk, zwx, zwy, zwz, zww ) 
       !
-      IF( nn_timing == 1 )  CALL timing_stop('dyn_zdf_exp')
+      !                 !==  Leap-Frog time integration  ==!
+      !
+      IF( ln_dynadv_vec .OR. ln_linssh ) THEN   ! applied on velocity
+         DO jk = 1, jpkm1
+            ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk)
+            va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk)
+         END DO
+      ELSE                                      ! applied on thickness weighted velocity
+         DO jk = 1, jpkm1
+            ua(:,:,jk) = (          e3u_b(:,:,jk) * ub(:,:,jk)    &
+               &           + p2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk)
+            va(:,:,jk) = (          e3v_b(:,:,jk) * vb(:,:,jk)    &
+               &           + p2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk)
+         END DO
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwx, zwy, zwz, zww ) 
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dyn_zdf_exp')
       !
    END SUBROUTINE dyn_zdf_exp
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 6808)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                    ***  MODULE  dynzdf_imp  ***
-   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend
+   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend, implicit scheme
    !!======================================================================
    !! History :  OPA  !  1990-10  (B. Blanke)  Original code
@@ -12,19 +12,20 @@
 
    !!----------------------------------------------------------------------
-   !!   dyn_zdf_imp  : update the momentum trend with the vertical diffusion using a implicit time-stepping
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE domvvl          ! variable volume
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE zdf_oce         ! ocean vertical physics
-   USE phycst          ! physical constants
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE zdfbfr          ! Bottom friction setup
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-   USE dynadv          ! dynamics: vector invariant versus flux form
-   USE dynspg_oce, ONLY: lk_dynspg_ts
+   !!   dyn_zdf_imp   : compute the vertical diffusion using a implicit scheme
+   !!                   together with the Leap-Frog time integration.
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean space and time domain
+   USE domvvl         ! variable volume
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE dynadv   , ONLY: ln_dynadv_vec ! Momentum advection form
+   USE zdf_oce        ! ocean vertical physics
+   USE zdfbfr         ! Bottom friction setup
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -33,8 +34,7 @@
    PUBLIC   dyn_zdf_imp   ! called by step.F90
 
-   REAL(wp) ::  r_vvl     ! variable volume indicator, =1 if lk_vvl=T, =0 otherwise 
+   REAL(wp) ::  r_vvl     ! non-linear free surface indicator: =0 if ln_linssh=T, =1 otherwise 
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -50,24 +50,26 @@
       !!                   
       !! ** Purpose :   Compute the trend due to the vert. momentum diffusion
-      !!      and the surface forcing, and add it to the general trend of 
-      !!      the momentum equations.
+      !!              together with the Leap-Frog time stepping using an 
+      !!              implicit scheme.
       !!
-      !! ** Method  :   The vertical momentum mixing trend is given by :
-      !!             dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ua) )
-      !!      backward time stepping
-      !!      Surface boundary conditions: wind stress input (averaged over kt-1/2 & kt+1/2)
-      !!      Bottom boundary conditions : bottom stress (cf zdfbfr.F)
-      !!      Add this trend to the general trend ua :
-      !!         ua = ua + dz( avmu dz(u) )
+      !! ** Method  :  - Leap-Frog time stepping on all trends but the vertical mixing
+      !!         ua =         ub + 2*dt *       ua             vector form or linear free surf.
+      !!         ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a   otherwise
+      !!               - update the after velocity with the implicit vertical mixing.
+      !!      This requires to solver the following system: 
+      !!         ua = ua + 1/e3u_a dk+1[ avmu / e3uw_a dk[ua] ]
+      !!      with the following surface/top/bottom boundary condition:
+      !!      surface: wind stress input (averaged over kt-1/2 & kt+1/2)
+      !!      top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdfbfr.F)
       !!
-      !! ** Action : - Update (ua,va) arrays with the after vertical diffusive mixing trend.
+      !! ** Action :   (ua,va) after velocity 
       !!---------------------------------------------------------------------
       INTEGER , INTENT(in) ::  kt     ! ocean time-step index
       REAL(wp), INTENT(in) ::  p2dt   ! vertical profile of tracer time-step
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   ikbu, ikbv   ! local integers
-      REAL(wp) ::   z1_p2dt, zcoef, zzwi, zzws, zrhs   ! local scalars
-      REAL(wp) ::   ze3ua, ze3va
+      !
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      INTEGER  ::   ikbu, ikbv    ! local integers
+      REAL(wp) ::   zzwi, ze3ua   ! local scalars
+      REAL(wp) ::   zzws, ze3va   !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwd, zws
       !!----------------------------------------------------------------------
@@ -82,20 +84,31 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
          !
-         IF( lk_vvl ) THEN   ;    r_vvl = 1._wp       ! Variable volume indicator
-         ELSE                ;    r_vvl = 0._wp       
+         If( ln_linssh ) THEN   ;    r_vvl = 0._wp    ! non-linear free surface indicator
+         ELSE                   ;    r_vvl = 1._wp
          ENDIF
       ENDIF
-
-      ! 0. Local constant initialization
-      ! --------------------------------
-      z1_p2dt = 1._wp / p2dt      ! inverse of the timestep
-
-      ! 1. Apply semi-implicit bottom friction
-      ! --------------------------------------
+      !
+      !              !==  Time step dynamics  ==!
+      !
+      IF( ln_dynadv_vec .OR. ln_linssh ) THEN      ! applied on velocity
+         DO jk = 1, jpkm1
+            ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk)
+            va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk)
+         END DO
+      ELSE                                         ! applied on thickness weighted velocity
+         DO jk = 1, jpkm1
+            ua(:,:,jk) = (         e3u_b(:,:,jk) * ub(:,:,jk)  &
+               &          + p2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk)
+            va(:,:,jk) = (         e3v_b(:,:,jk) * vb(:,:,jk)  &
+               &          + p2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk)
+         END DO
+      ENDIF
+      !
+      !              !==  Apply semi-implicit bottom friction  ==!
+      !
       ! Only needed for semi-implicit bottom friction setup. The explicit
       ! bottom friction has been included in "u(v)a" which act as the R.H.S
       ! column vector of the tri-diagonal matrix equation
       !
-
       IF( ln_bfrimp ) THEN
          DO jj = 2, jpjm1
@@ -103,6 +116,6 @@
                ikbu = mbku(ji,jj)       ! ocean bottom level at u- and v-points 
                ikbv = mbkv(ji,jj)       ! (deepest ocean u- and v-points)
-               avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1)
-               avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1)
+               avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * e3uw_n(ji,jj,ikbu+1)
+               avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * e3vw_n(ji,jj,ikbv+1)
             END DO
          END DO
@@ -112,52 +125,38 @@
                   ikbu = miku(ji,jj)       ! ocean top level at u- and v-points 
                   ikbv = mikv(ji,jj)       ! (first wet ocean u- and v-points)
-                  IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * fse3uw(ji,jj,ikbu)
-                  IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * fse3vw(ji,jj,ikbv)
+                  IF( ikbu >= 2 )   avmu(ji,jj,ikbu) = -tfrua(ji,jj) * e3uw_n(ji,jj,ikbu)
+                  IF( ikbv >= 2 )   avmv(ji,jj,ikbv) = -tfrva(ji,jj) * e3vw_n(ji,jj,ikbv)
                END DO
             END DO
          END IF
       ENDIF
-
-#if defined key_dynspg_ts
-      IF( ln_dynadv_vec .OR. .NOT. lk_vvl ) THEN      ! applied on velocity
-         DO jk = 1, jpkm1
-            ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk)
-            va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk)
-         END DO
-      ELSE                                            ! applied on thickness weighted velocity
-         DO jk = 1, jpkm1
-            ua(:,:,jk) = (          ub(:,:,jk) * fse3u_b(:,:,jk)      &
-               &           + p2dt * ua(:,:,jk) * fse3u_n(:,:,jk)  )   &
-               &                               / fse3u_a(:,:,jk) * umask(:,:,jk)
-            va(:,:,jk) = (          vb(:,:,jk) * fse3v_b(:,:,jk)      &
-               &           + p2dt * va(:,:,jk) * fse3v_n(:,:,jk)  )   &
-               &                               / fse3v_a(:,:,jk) * vmask(:,:,jk)
-         END DO
-      ENDIF
-
-      IF ( ln_bfrimp .AND.lk_dynspg_ts ) THEN
-         ! remove barotropic velocities:
-         DO jk = 1, jpkm1
-            ua(:,:,jk) = (ua(:,:,jk) - ua_b(:,:)) * umask(:,:,jk)
-            va(:,:,jk) = (va(:,:,jk) - va_b(:,:)) * vmask(:,:,jk)
-         END DO
-         ! Add bottom/top stress due to barotropic component only:
-         DO jj = 2, jpjm1        
+      !
+      ! With split-explicit free surface, barotropic stress is treated explicitly
+      ! Update velocities at the bottom.
+      ! J. Chanut: The bottom stress is computed considering after barotropic velocities, which does 
+      !            not lead to the effective stress seen over the whole barotropic loop. 
+      ! G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a
+      IF( ln_bfrimp .AND. ln_dynspg_ts ) THEN
+         DO jk = 1, jpkm1        ! remove barotropic velocities
+            ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk)
+            va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk)
+         END DO
+         DO jj = 2, jpjm1        ! Add bottom/top stress due to barotropic component only
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
                ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
-               ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,ikbu) + r_vvl   * fse3u_a(ji,jj,ikbu)
-               ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,ikbv) + r_vvl   * fse3v_a(ji,jj,ikbv)
+               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl * e3u_a(ji,jj,ikbu)
+               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl * e3v_a(ji,jj,ikbv)
                ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * bfrua(ji,jj) * ua_b(ji,jj) / ze3ua
                va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * bfrva(ji,jj) * va_b(ji,jj) / ze3va
             END DO
          END DO
-         IF ( ln_isfcav ) THEN
+         IF( ln_isfcav ) THEN    ! Ocean cavities (ISF)
             DO jj = 2, jpjm1        
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   ikbu = miku(ji,jj)         ! top ocean level at u- and v-points 
                   ikbv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
-                  ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,ikbu) + r_vvl   * fse3u_a(ji,jj,ikbu)
-                  ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,ikbv) + r_vvl   * fse3v_a(ji,jj,ikbv)
+                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl * e3u_a(ji,jj,ikbu)
+                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl * e3v_a(ji,jj,ikbv)
                   ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua
                   va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va
@@ -166,8 +165,7 @@
          END IF
       ENDIF
-#endif
-
-      ! 2. Vertical diffusion on u
-      ! ---------------------------
+      !
+      !              !==  Vertical diffusion on u  ==!
+      !
       ! Matrix and second member construction
       ! bottom boundary condition: both zwi and zws must be masked as avmu can take
@@ -177,10 +175,9 @@
          DO jj = 2, jpjm1 
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,jk) + r_vvl   * fse3u_a(ji,jj,jk)   ! after scale factor at T-point
-               zcoef = - p2dt / ze3ua      
-               zzwi          = zcoef * avmu  (ji,jj,jk  ) / fse3uw(ji,jj,jk  )
-               zwi(ji,jj,jk) = zzwi  * wumask(ji,jj,jk  )
-               zzws          = zcoef * avmu  (ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 
-               zws(ji,jj,jk) = zzws  * wumask(ji,jj,jk+1)
+               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at T-point
+               zzwi = - p2dt * avmu(ji,jj,jk  ) / ( ze3ua * e3uw_n(ji,jj,jk  ) )
+               zzws = - p2dt * avmu(ji,jj,jk+1) / ( ze3ua * e3uw_n(ji,jj,jk+1) )
+               zwi(ji,jj,jk) = zzwi * wumask(ji,jj,jk  )
+               zws(ji,jj,jk) = zzws * wumask(ji,jj,jk+1)
                zwd(ji,jj,jk) = 1._wp - zzwi - zzws
             END DO
@@ -209,6 +206,5 @@
       !-----------------------------------------------------------------------
       !
-      !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-      DO jk = 2, jpkm1
+      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -218,15 +214,9 @@
       END DO
       !
-      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_dynspg_ts
-            ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,1) + r_vvl   * fse3u_a(ji,jj,1) 
+      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==!
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1) 
             ua(ji,jj,1) = ua(ji,jj,1) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
                &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1) 
-#else
-            ua(ji,jj,1) = ub(ji,jj,1) &
-               &                   + p2dt *(ua(ji,jj,1) +  0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
-               &                                      / ( fse3u(ji,jj,1) * rau0     ) * umask(ji,jj,1) ) 
-#endif
          END DO
       END DO
@@ -234,15 +224,10 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
-#if defined key_dynspg_ts
-               zrhs = ua(ji,jj,jk)   ! zrhs=right hand side
-#else
-               zrhs = ub(ji,jj,jk) + p2dt * ua(ji,jj,jk)
-#endif
-               ua(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==
+               ua(ji,jj,jk) = ua(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==!
          DO ji = fs_2, fs_jpim1   ! vector opt.
             ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
@@ -256,18 +241,7 @@
          END DO
       END DO
-
-#if ! defined key_dynspg_ts
-      ! Normalization to obtain the general momentum trend ua
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1   
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_p2dt
-            END DO
-         END DO
-      END DO
-#endif
-
-      ! 3. Vertical diffusion on v
-      ! ---------------------------
+      !
+      !              !==  Vertical diffusion on v  ==!
+      !
       ! Matrix and second member construction
       ! bottom boundary condition: both zwi and zws must be masked as avmv can take
@@ -277,10 +251,9 @@
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,jk)  + r_vvl * fse3v_a(ji,jj,jk)   ! after scale factor at T-point
-               zcoef = - p2dt / ze3va
-               zzwi          = zcoef * avmv (ji,jj,jk  ) / fse3vw(ji,jj,jk  )
-               zwi(ji,jj,jk) =  zzwi * wvmask(ji,jj,jk)
-               zzws          = zcoef * avmv (ji,jj,jk+1) / fse3vw(ji,jj,jk+1)
-               zws(ji,jj,jk) =  zzws * wvmask(ji,jj,jk+1)
+               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at T-point
+               zzwi = - p2dt * avmv (ji,jj,jk  ) / ( ze3va * e3vw_n(ji,jj,jk  ) )
+               zzws = - p2dt * avmv (ji,jj,jk+1) / ( ze3va * e3vw_n(ji,jj,jk+1) )
+               zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk  )
+               zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1)
                zwd(ji,jj,jk) = 1._wp - zzwi - zzws
             END DO
@@ -309,6 +282,5 @@
       !-----------------------------------------------------------------------
       !
-      !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-      DO jk = 2, jpkm1        
+      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -318,15 +290,9 @@
       END DO
       !
-      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_dynspg_ts            
-            ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl   * fse3v_a(ji,jj,1) 
+      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==!
+         DO ji = fs_2, fs_jpim1   ! vector opt.          
+            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 
             va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
                &                                      / ( ze3va * rau0 ) 
-#else
-            va(ji,jj,1) = vb(ji,jj,1) &
-               &                   + p2dt *(va(ji,jj,1) +  0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
-               &                                                       / ( fse3v(ji,jj,1) * rau0     )  )
-#endif
          END DO
       END DO
@@ -334,15 +300,10 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_dynspg_ts
-               zrhs = va(ji,jj,jk)   ! zrhs=right hand side
-#else
-               zrhs = vb(ji,jj,jk) + p2dt * va(ji,jj,jk)
-#endif
-               va(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==
+               va(ji,jj,jk) = va(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==!
          DO ji = fs_2, fs_jpim1   ! vector opt.
             va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
@@ -356,18 +317,8 @@
          END DO
       END DO
-
-      ! Normalization to obtain the general momentum trend va
-#if ! defined key_dynspg_ts
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1   
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               va(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_p2dt
-            END DO
-         END DO
-      END DO
-#endif
-
+      
       ! J. Chanut: Lines below are useless ?
       !! restore bottom layer avmu(v) 
+      !!gm  I almost sure it is !!!!
       IF( ln_bfrimp ) THEN
         DO jj = 2, jpjm1
@@ -375,6 +326,6 @@
               ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
               ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
-              avmu(ji,jj,ikbu+1) = 0.e0
-              avmv(ji,jj,ikbv+1) = 0.e0
+              avmu(ji,jj,ikbu+1) = 0._wp
+              avmv(ji,jj,ikbv+1) = 0._wp
            END DO
         END DO
@@ -384,14 +335,14 @@
                  ikbu = miku(ji,jj)         ! ocean top level at u- and v-points 
                  ikbv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
-                 IF (ikbu > 1) avmu(ji,jj,ikbu) = 0.e0
-                 IF (ikbv > 1) avmv(ji,jj,ikbv) = 0.e0
+                 IF( ikbu > 1 )   avmu(ji,jj,ikbu) = 0._wp
+                 IF( ikbv > 1 )   avmv(ji,jj,ikbv) = 0._wp
               END DO
            END DO
-        END IF
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dyn_zdf_imp')
+        ENDIF
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwi, zwd, zws) 
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dyn_zdf_imp')
       !
    END SUBROUTINE dyn_zdf_imp
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 6808)
@@ -12,31 +12,32 @@
 
    !!----------------------------------------------------------------------
-   !!   ssh_nxt        : after ssh
-   !!   ssh_swp        : filter ans swap the ssh arrays
-   !!   wzv            : compute now vertical velocity
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE domvvl          ! Variable volume
-   USE divcur          ! hor. divergence and curl      (div & cur routines)
-   USE restart         ! only for lrst_oce
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
-   USE phycst
-   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
-   USE lib_mpp         ! MPP library
-   USE bdy_oce
-   USE bdy_par         
-   USE bdydyn2d        ! bdy_ssh routine
+   !!   ssh_nxt       : after ssh
+   !!   ssh_swp       : filter ans swap the ssh arrays
+   !!   wzv           : compute now vertical velocity
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables 
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE domvvl         ! Variable volume
+   USE divhor         ! horizontal divergence
+   USE phycst         ! physical constants
+   USE bdy_oce        ! 
+   USE bdy_par        !
+   USE bdydyn2d       ! bdy_ssh routine
 #if defined key_agrif
-   USE agrif_opa_update
    USE agrif_opa_interp
 #endif
 #if defined key_asminc   
-   USE asminc          ! Assimilation increment
-#endif
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   USE   asminc       ! Assimilation increment
+#endif
+   !
+   USE in_out_manager ! I/O manager
+   USE restart        ! only for lrst_oce
+   USE prtctl         ! Print control
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+   USE wet_dry         ! Wetting/Drying flux limting
 
    IMPLICIT NONE
@@ -48,5 +49,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -67,29 +67,26 @@
       !!      by the time step.
       !!
-      !! ** action  :   ssha    : after sea surface height
+      !! ** action  :   ssha, after sea surface height
       !!
       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
       !!----------------------------------------------------------------------
-      !
-      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zhdiv
-      INTEGER, INTENT(in) ::   kt                      ! time step
+      INTEGER, INTENT(in) ::   kt   ! time step
       ! 
-      INTEGER             ::   jk                      ! dummy loop indice
-      REAL(wp)            ::   z2dt, z1_rau0           ! local scalars
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ssh_nxt')
-      !
-      CALL wrk_alloc( jpi, jpj, zhdiv ) 
+      INTEGER  ::   jk            ! dummy loop indice
+      REAL(wp) ::   z2dt, zcoef   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhdiv   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('ssh_nxt')
+      !
+      CALL wrk_alloc( jpi,jpj,   zhdiv ) 
       !
       IF( kt == nit000 ) THEN
-         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'ssh_nxt : after sea surface height'
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
-         !
-      ENDIF
-      !
-      CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity
+      ENDIF
+      !
+      CALL div_hor( kt )                              ! Horizontal divergence
       !
       z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
@@ -101,5 +98,5 @@
       zhdiv(:,:) = 0._wp
       DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports
-        zhdiv(:,:) = zhdiv(:,:) + fse3t_n(:,:,jk) * hdivn(:,:,jk)
+        zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk)
       END DO
       !                                                ! Sea surface elevation time stepping
@@ -107,29 +104,30 @@
       ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations.
       ! 
-      z1_rau0 = 0.5_wp * r1_rau0
-      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:)
-
-#if ! defined key_dynspg_ts
-      ! These lines are not necessary with time splitting since
-      ! boundary condition on sea level is set during ts loop
-#if defined key_agrif
-      CALL agrif_ssh( kt )
-#endif
-#if defined key_bdy
-      IF (lk_bdy) THEN
-         CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary
-         CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries
-      ENDIF
-#endif
-#endif
+      zcoef = 0.5_wp * r1_rau0
+
+      IF(ln_wd) CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt)
+
+      ssha(:,:) = (  sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:)
+
+      IF ( .NOT.ln_dynspg_ts ) THEN
+         ! These lines are not necessary with time splitting since
+         ! boundary condition on sea level is set during ts loop
+# if defined key_agrif
+         CALL agrif_ssh( kt )
+# endif
+# if defined key_bdy
+         IF( lk_bdy ) THEN
+            CALL lbc_lnk( ssha, 'T', 1. )    ! Not sure that's necessary
+            CALL bdy_ssh( ssha )             ! Duplicate sea level across open boundaries
+         ENDIF
+# endif
+      ENDIF
 
 #if defined key_asminc
-      !                                                ! Include the IAU weighted SSH increment
-      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
+      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN     ! Include the IAU weighted SSH increment
          CALL ssh_asm_inc( kt )
          ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:)
       ENDIF
 #endif
-
       !                                           !------------------------------!
       !                                           !           outputs            !
@@ -160,17 +158,15 @@
       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
       !!----------------------------------------------------------------------
-      !
-      INTEGER, INTENT(in) ::   kt           ! time step
+      INTEGER, INTENT(in) ::   kt   ! time step
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   z1_2dt       ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  z3d, zhdiv
-      !
-      INTEGER             ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp)            ::   z1_2dt       ! local scalars
-      !!----------------------------------------------------------------------
-      
-      IF( nn_timing == 1 )  CALL timing_start('wzv')
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('wzv')
       !
       IF( kt == nit000 ) THEN
-         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'wzv : now vertical velocity '
@@ -178,5 +174,4 @@
          !
          wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all)
-         !
       ENDIF
       !                                           !------------------------------!
@@ -194,5 +189,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zhdiv(ji,jj,jk) = r1_e12t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) )
+                  zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) )
                END DO
             END DO
@@ -203,6 +198,6 @@
          DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence
             ! computation of w
-            wn(:,:,jk) = wn(:,:,jk+1) - (   fse3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)                    &
-               &                          + z1_2dt * ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) ) * tmask(:,:,jk)
+            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)    &
+               &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )     ) * tmask(:,:,jk)
          END DO
          !          IF( ln_vvl_layer ) wn(:,:,:) = 0.e0
@@ -211,11 +206,11 @@
          DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence
             ! computation of w
-            wn(:,:,jk) = wn(:,:,jk+1) - (   fse3t_n(:,:,jk) * hdivn(:,:,jk)                                   &
-               &                          + z1_2dt * ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) ) * tmask(:,:,jk)
+            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk)                 &
+               &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )  ) * tmask(:,:,jk)
          END DO
       ENDIF
 
 #if defined key_bdy
-      IF (lk_bdy) THEN
+      IF( lk_bdy ) THEN
          DO jk = 1, jpkm1
             wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
@@ -225,7 +220,7 @@
       !
       IF( nn_timing == 1 )  CALL timing_stop('wzv')
-
-
+      !
    END SUBROUTINE wzv
+
 
    SUBROUTINE ssh_swp( kt )
@@ -249,4 +244,6 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      REAL(wp) ::   zcoef   ! local scalar
       !!----------------------------------------------------------------------
       !
@@ -258,26 +255,25 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
       ENDIF
-
-# if defined key_dynspg_ts
-      IF( ( neuler == 0 .AND. kt == nit000 ) .OR. ln_bt_fw ) THEN    !** Euler time-stepping: no filter
-# else
-      IF ( neuler == 0 .AND. kt == nit000 ) THEN   !** Euler time-stepping at first time-step : no filter
-#endif
-         sshb(:,:) = sshn(:,:)                           ! before <-- now
-         sshn(:,:) = ssha(:,:)                           ! now    <-- after  (before already = now)
-      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(:,:) ) * 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
+      !              !==  Euler time-stepping: no filter, just swap  ==!
+      IF(  ( neuler == 0 .AND. kt == nit000 ) .OR.    &
+         & ( ln_bt_fw    .AND. ln_dynspg_ts )      ) THEN 
+         sshb(:,:) = sshn(:,:)                              ! before <-- now
+         sshn(:,:) = ssha(:,:)                              ! now    <-- after  (before already = now)
+         !
+      ELSE           !==  Leap-Frog time-stepping: Asselin filter + swap  ==!
+         !                                                  ! before <-- now filtered
+         sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) )
+         IF( .NOT.ln_linssh ) THEN                          ! before <-- with forcing removed
+            zcoef = atfp * rdt * r1_rau0
+            sshb(:,:) = sshb(:,:) - zcoef * (     emp_b(:,:) - emp   (:,:)   &
+               &                             -    rnf_b(:,:) + rnf   (:,:)   &
+               &                             + fwfisf_b(:,:) - fwfisf(:,:)   ) * ssmask(:,:)
+         ENDIF
+         sshn(:,:) = ssha(:,:)                              ! now <-- after
+      ENDIF
       !
       IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask, ovlap=1 )
       !
-      IF( nn_timing == 1 )  CALL timing_stop('ssh_swp')
+      IF( nn_timing == 1 )   CALL timing_stop('ssh_swp')
       !
    END SUBROUTINE ssh_swp
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90	(revision 6808)
@@ -0,0 +1,392 @@
+
+MODULE wet_dry
+   !!==============================================================================
+   !!                       ***  MODULE  wet_dry  ***
+   !! Wetting and drying includes initialisation routine and routines to
+   !! compute and apply flux limiters and preserve water depth positivity
+   !! only effects if wetting/drying is on (ln_wd == .true.)
+   !!==============================================================================
+   !! History :   
+   !!  NEMO      3.6  ! 2014-09  ((H.Liu)  Original code
+   !!                 ! will add the runoff and periodic BC case later
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   wad_lmt    : Compute the horizontal flux limiter and the limited velocity
+   !!                when wetting and drying happens 
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce, ONLY : ln_rnf   ! surface boundary condition: ocean
+   USE sbcrnf          ! river runoff 
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !!----------------------------------------------------------------------
+   !! critical depths,filters, limiters,and masks for  Wetting and Drying
+   !! ---------------------------------------------------------------------
+
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   wduflt, wdvflt !: u- and v- filter
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   wdmask         !: u- and v- limiter 
+
+   LOGICAL,  PUBLIC  ::   ln_wd       !: Wetting/drying activation switch (T:on,F:off)
+   REAL(wp), PUBLIC  ::   rn_wdmin1   !: minimum water depth on dried cells
+   REAL(wp), PUBLIC  ::   rn_wdmin2   !: tolerrance of minimum water depth on dried cells
+   REAL(wp), PUBLIC  ::   rn_wdld     !: land elevation below which wetting/drying 
+                                           !: will be considered
+   INTEGER , PUBLIC  ::   nn_wdit     !: maximum number of iteration for W/D limiter
+
+   PUBLIC   wad_init                  ! initialisation routine called by step.F90
+   PUBLIC   wad_lmt                   ! routine called by sshwzv.F90
+   PUBLIC   wad_lmt_bt                ! routine called by dynspg_ts.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+CONTAINS
+
+   SUBROUTINE wad_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE wad_init  ***
+      !!                    
+      !! ** Purpose :   read wetting and drying namelist and print the variables.
+      !!
+      !! ** input   : - namwad namelist
+      !!----------------------------------------------------------------------
+      NAMELIST/namwad/ ln_wd, rn_wdmin1, rn_wdmin2, rn_wdld, nn_wdit
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      INTEGER  ::   ierr                ! Local integer status array allocation 
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namwad in reference namelist 
+                                        ! : Parameters for Wetting/Drying
+      READ  ( numnam_ref, namwad, IOSTAT = ios, ERR = 905)
+905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in reference namelist', .TRUE.) 
+      REWIND( numnam_cfg )              ! Namelist namwad in configuration namelist 
+                                        ! : Parameters for Wetting/Drying
+      READ  ( numnam_cfg, namwad, IOSTAT = ios, ERR = 906)
+906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in configuration namelist', .TRUE. )
+      IF(lwm) WRITE ( numond, namwad )
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'wad_init : Wetting and drying initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namwad'
+         WRITE(numout,*) '      Logical activation                 ln_wd      = ', ln_wd
+         WRITE(numout,*) '      Minimum wet depth on dried cells rn_wdmin1    = ', rn_wdmin1
+         WRITE(numout,*) '      Tolerance of min wet depth     rn_wdmin2      = ', rn_wdmin2
+         WRITE(numout,*) '      land elevation threshold         rn_wdld      = ', rn_wdld
+         WRITE(numout,*) '      Max iteration for W/D limiter    nn_wdit      = ', nn_wdit
+       ENDIF
+
+      IF(ln_wd) THEN
+         ALLOCATE( wduflt(jpi,jpj), wdvflt(jpi,jpj), wdmask(jpi,jpj), STAT=ierr )
+         IF( ierr /= 0 ) CALL ctl_stop('STOP', 'wad_init : Array allocation error')
+      ENDIF
+   END SUBROUTINE wad_init
+
+   SUBROUTINE wad_lmt( sshb1, sshemp, z2dt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE wad_lmt  ***
+      !!                    
+      !! ** Purpose :   generate flux limiters for wetting/drying
+      !!
+      !! ** Method  : - Prevent negative depth occurring (Not ready for Agrif) 
+      !!
+      !! ** Action  : - calculate flux limiter and W/D flag
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   sshb1
+      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   sshemp
+      REAL(wp), INTENT(in) :: z2dt
+      !
+      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices
+      INTEGER  ::   zflag               ! local scalar
+      REAL(wp) ::   zcoef, zdep1, zdep2 ! local scalars
+      REAL(wp) ::   zzflxp, zzflxn      ! local scalars
+      REAL(wp) ::   zdepwd              ! local scalar, always wet cell depth
+      REAL(wp) ::   ztmp                ! local scalars
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! local 2D workspace
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu,  zflxv            ! local 2D workspace
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace
+
+      !!----------------------------------------------------------------------
+      !
+
+      IF( nn_timing == 1 )  CALL timing_start('wad_lmt')
+
+      IF(ln_wd) THEN
+
+        CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 )
+        CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv)
+        !
+       
+        !IF(lwp) WRITE(numout,*)
+        !IF(lwp) WRITE(numout,*) 'wad_lmt : wetting/drying limiters and velocity limiting'
+       
+        zflag  = 0
+        zdepwd = 50._wp   !maximum depth on which that W/D could possibly happen
+
+       
+        zflxp(:,:)   = 0._wp
+        zflxn(:,:)   = 0._wp
+        zflxu(:,:)   = 0._wp
+        zflxv(:,:)   = 0._wp
+
+        zwdlmtu(:,:)  = 1._wp
+        zwdlmtv(:,:)  = 1._wp
+       
+        ! Horizontal Flux in u and v direction
+        DO jk = 1, jpkm1  
+           DO jj = 1, jpjm1
+              DO ji = 1, jpim1
+                 zflxu(ji,jj) = zflxu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)
+                 zflxv(ji,jj) = zflxv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)
+              END DO  
+           END DO  
+        END DO
+       
+        zflxu(:,:) = zflxu(:,:) * e2u(:,:)
+        zflxv(:,:) = zflxv(:,:) * e1v(:,:)
+       
+        DO jj = 2, jpjm1
+           DO ji = 2, jpim1 
+
+             IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE   ! we don't care about land cells
+             IF(bathy(ji,jj) > zdepwd) CYCLE       ! and cells which will unlikely go dried out
+
+              zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + &
+                           & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp) 
+              zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + &
+                           & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp) 
+
+              zdep2 = bathy(ji,jj) + sshb1(ji,jj) - rn_wdmin1
+              IF(zdep2 < 0._wp) THEN  !add more safty, but not necessary
+                !zdep2 = 0._wp
+                sshb1(ji,jj) = rn_wdmin1 - bathy(ji,jj)
+              END IF
+           ENDDO
+        END DO
+
+      
+        !! start limiter iterations 
+        DO jk1 = 1, nn_wdit + 1
+       
+          
+           zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:)
+           zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:)
+          
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1 
+        
+                 wdmask(ji,jj) = 0
+                 IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE 
+                 IF(bathy(ji,jj) > zdepwd) CYCLE
+        
+                 ztmp = e1e2t(ji,jj)
+
+                 zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + &
+                        & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp) 
+                 zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + &
+                        & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp) 
+          
+                 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
+                 zdep2 = bathy(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj)  ! this one can be moved out of the loop
+          
+                 IF(zdep1 > zdep2) THEN
+                   zflag = 1
+                   wdmask(ji, jj) = 1
+                   zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
+                   zcoef = max(zcoef, 0._wp)
+                   IF(jk1 > nn_wdit) zcoef = 0._wp
+                   IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef
+                   IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef
+                   IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef
+                   IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji-1,jj) = zcoef
+                 END IF
+              END DO ! ji loop
+           END DO  ! jj loop
+
+           CALL lbc_lnk( zwdlmtu, 'U', 1. )
+           CALL lbc_lnk( zwdlmtv, 'V', 1. )
+
+           IF(lk_mpp) CALL mpp_max(zflag)   !max over the global domain
+
+           IF(zflag == 0) EXIT
+          
+           zflag = 0     ! flag indicating if any further iteration is needed?
+        END DO  ! jk1 loop
+       
+        DO jk = 1, jpkm1
+          un(:,:,jk) = un(:,:,jk) * zwdlmtu(:, :) 
+          vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:, :) 
+        END DO
+
+        CALL lbc_lnk( un, 'U', -1. )
+        CALL lbc_lnk( vn, 'V', -1. )
+       
+        IF(zflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!'
+       
+        !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
+        !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field)
+        !
+        !
+        CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 )
+        CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv)
+      !
+      END IF
+
+      IF( nn_timing == 1 )  CALL timing_stop('wad_lmt')
+   END SUBROUTINE wad_lmt
+
+   SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rdtbt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE wad_lmt  ***
+      !!                    
+      !! ** Purpose :   limiting flux in the barotropic stepping (dynspg_ts)
+      !!
+      !! ** Method  : - Prevent negative depth occurring (Not ready for Agrif) 
+      !!
+      !! ** Action  : - calculate flux limiter and W/D flag
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in)    ::   rdtbt    ! ocean time-step index
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zflxu,  zflxv, sshn_e, zssh_frc  
+      !
+      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices
+      INTEGER  ::   zflag         ! local scalar
+      REAL(wp) ::   z2dt
+      REAL(wp) ::   zcoef, zdep1, zdep2 ! local scalars
+      REAL(wp) ::   zzflxp, zzflxn      ! local scalars
+      REAL(wp) ::   zdepwd              ! local scalar, always wet cell depth
+      REAL(wp) ::   ztmp                ! local scalars
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! local 2D workspace
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace
+
+      !!----------------------------------------------------------------------
+      !
+
+      IF( nn_timing == 1 )  CALL timing_start('wad_lmt_bt')
+
+      IF(ln_wd) THEN
+
+        CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 )
+        CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv)
+        !
+       
+        !IF(lwp) WRITE(numout,*)
+        !IF(lwp) WRITE(numout,*) 'wad_lmt_bt : wetting/drying limiters and velocity limiting'
+       
+        zflag  = 0
+        zdepwd = 50._wp   !maximum depth that ocean cells can have W/D processes
+
+        z2dt = rdtbt   
+       
+        zflxp(:,:)   = 0._wp
+        zflxn(:,:)   = 0._wp
+        !zflxu(:,:)   = 0._wp
+        !zflxv(:,:)   = 0._wp
+
+        zwdlmtu(:,:)  = 1._wp
+        zwdlmtv(:,:)  = 1._wp
+       
+        ! Horizontal Flux in u and v direction
+       
+        !zflxu(:,:) = zflxu(:,:) * e2u(:,:)
+        !zflxv(:,:) = zflxv(:,:) * e1v(:,:)
+       
+        DO jj = 2, jpjm1
+           DO ji = 2, jpim1 
+
+             IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE   ! we don't care about land cells
+             IF(bathy(ji,jj) > zdepwd) CYCLE       ! and cells which will unlikely go dried out
+
+              zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + &
+                           & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp) 
+              zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + &
+                           & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp) 
+
+              zdep2 = bathy(ji,jj) + sshn_e(ji,jj) - rn_wdmin1
+              IF(zdep2 < 0._wp) THEN  !add more safty, but not necessary
+                !zdep2 = 0._wp
+               sshn_e(ji,jj) = rn_wdmin1 - bathy(ji,jj)
+              END IF
+           ENDDO
+        END DO
+
+      
+        !! start limiter iterations 
+        DO jk1 = 1, nn_wdit + 1
+       
+          
+           zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:)
+           zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:)
+          
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1 
+        
+                 wdmask(ji,jj) = 0
+                 IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE 
+                 IF(bathy(ji,jj) > zdepwd) CYCLE
+        
+                 ztmp = e1e2t(ji,jj)
+
+                 zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + &
+                        & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp) 
+                 zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + &
+                        & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp) 
+          
+                 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
+                 zdep2 = bathy(ji,jj) + sshn_e(ji,jj) - rn_wdmin1   ! this one can be moved out of the loop
+                 zdep2 = zdep2 - z2dt * zssh_frc(ji,jj)
+          
+                 IF(zdep1 > zdep2) THEN
+                   zflag = 1
+                   !wdmask(ji, jj) = 1
+                   zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
+                   zcoef = max(zcoef, 0._wp)
+                   IF(jk1 > nn_wdit) zcoef = 0._wp
+                   IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef
+                   IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef
+                   IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef
+                   IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji-1,jj) = zcoef
+                 END IF
+              END DO ! ji loop
+           END DO  ! jj loop
+
+           CALL lbc_lnk( zwdlmtu, 'U', 1. )
+           CALL lbc_lnk( zwdlmtv, 'V', 1. )
+
+           IF(lk_mpp) CALL mpp_max(zflag)   !max over the global domain
+
+           IF(zflag == 0) EXIT
+          
+           zflag = 0     ! flag indicating if any further iteration is needed?
+        END DO  ! jk1 loop
+       
+        zflxu(:,:) = zflxu(:,:) * zwdlmtu(:, :) 
+        zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :) 
+
+        CALL lbc_lnk( zflxu, 'U', -1. )
+        CALL lbc_lnk( zflxv, 'V', -1. )
+       
+        IF(zflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!'
+       
+        !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
+        !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field)
+        !
+        !
+        CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 )
+        CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv)
+      !
+      END IF
+
+      IF( nn_timing == 1 )  CALL timing_stop('wad_lmt')
+   END SUBROUTINE wad_lmt_bt
+END MODULE wet_dry
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 6808)
@@ -4,5 +4,5 @@
    !! Ocean floats :   trajectory computation using a 4th order Runge-Kutta
    !!======================================================================
-#if   defined key_floats   ||   defined key_esopa
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                     float trajectories
@@ -29,6 +29,4 @@
    REAL(wp), DIMENSION (3) ::   scoef1 = (/  0.5  ,  0.5  ,  1.0  /)           !
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -436,5 +434,5 @@
                      &   ( tcoef1(ki) * wb(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))+   &
                      &     tcoef2(ki) * wn(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) )  &
-                     &   / fse3w(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))
+                     &   / e3w_n(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))
                END DO
             END DO
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 6808)
@@ -7,5 +7,5 @@
    !!   NEMO      1.0  ! 2002-11  (G. Madec, A. Bozec)  F90: Free form and module
    !!----------------------------------------------------------------------
-#if   defined key_floats   ||   defined key_esopa
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                        drifting floats
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90	(revision 6808)
@@ -7,5 +7,5 @@
    !!   NEMO     1.0  ! 2002-06  (A. Bozec)  F90, Free form and module
    !!----------------------------------------------------------------------
-#if   defined key_floats   ||   defined key_esopa
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                     float trajectories
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90	(revision 6808)
@@ -4,5 +4,5 @@
    !! Ocean floats :   trajectory computation
    !!======================================================================
-#if   defined key_floats   ||   defined key_esopa
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                     float trajectories
@@ -23,6 +23,4 @@
    PUBLIC   flo_blk    ! routine called by floats.F90
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -118,13 +116,13 @@
             
             ! compute the transport across the mesh where the float is.            
-!!bug (gm) change e3t into fse3. but never checked 
-            zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl)  ) * fse3u(iiloc(jfl)-1,ijloc(jfl)  ,-ikl(jfl))
-            zsurfx(2) = e2u(iiloc(jfl)  ,ijloc(jfl)  ) * fse3u(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl))
-            zsurfy(1) = e1v(iiloc(jfl)  ,ijloc(jfl)-1) * fse3v(iiloc(jfl)  ,ijloc(jfl)-1,-ikl(jfl))
-            zsurfy(2) = e1v(iiloc(jfl)  ,ijloc(jfl)  ) * fse3v(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl))
+!!bug (gm) change e3t into e3. but never checked 
+            zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl)  ) * e3u_n(iiloc(jfl)-1,ijloc(jfl)  ,-ikl(jfl))
+            zsurfx(2) = e2u(iiloc(jfl)  ,ijloc(jfl)  ) * e3u_n(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl))
+            zsurfy(1) = e1v(iiloc(jfl)  ,ijloc(jfl)-1) * e3v_n(iiloc(jfl)  ,ijloc(jfl)-1,-ikl(jfl))
+            zsurfy(2) = e1v(iiloc(jfl)  ,ijloc(jfl)  ) * e3v_n(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl))
 
             ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too.
-            zsurfz = e1t(iiloc(jfl),ijloc(jfl)) * e2t(iiloc(jfl),ijloc(jfl))
-            zvol   = zsurfz * fse3t(iiloc(jfl),ijloc(jfl),-ikl(jfl))
+            zsurfz =          e1e2t(iiloc(jfl),ijloc(jfl))
+            zvol   = zsurfz * e3t_n(iiloc(jfl),ijloc(jfl),-ikl(jfl))
 
             !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90	(revision 6808)
@@ -4,9 +4,8 @@
    !! Ocean floats :   domain
    !!======================================================================
-   !! History :  OPA          ! 1998-07 (Y.Drillet, CLIPPER)  Original code
-   !!            NEMO_3.3.1   ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): 
-                              ! add Ariane convention, Comsecitc changes
-   !!----------------------------------------------------------------------
-#if   defined key_floats   ||   defined key_esopa
+   !! History :  OPA  ! 1998-07 (Y.Drillet, CLIPPER)  Original code
+   !!  NEMO      3.3  ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): add ARIANE convention + comsecitc changes
+   !!----------------------------------------------------------------------
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                     float trajectories
@@ -38,6 +37,4 @@
    REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zgifl, zgjfl,  zgkfl      ! distances in indexes
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -177,5 +174,5 @@
                   ihtest(jfl) = ihtest(jfl)+1
                   DO jk = 1, jpk-1
-                     IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) > flzz(jfl)) ) THEN
+                     IF( (gdepw_n(ji,jj,jk) <= flzz(jfl)) .AND. (gdepw_n(ji,jj,jk+1) > flzz(jfl)) ) THEN
                         ikmfl(jfl) = jk
                         ivtest(jfl) = ivtest(jfl) + 1
@@ -239,10 +236,10 @@
             zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom)
             zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom)
-            zgkfl(jfl) = (( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))   &
-               &                 / (  fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              &
-               &                    - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) )                             &
-               &                 + (( flzz(jfl)-fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1))   &
-               &                 / (  fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              &
-               &                    - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) )
+            zgkfl(jfl) = (( gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))   &
+               &                 / (  gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              &
+               &                    - gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) )                             &
+               &                 + (( flzz(jfl)-gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1))   &
+               &                 / (  gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              &
+               &                    - gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) )
          ELSE
             zgifl(jfl) = 0.e0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90	(revision 6808)
@@ -2,21 +2,15 @@
    !!======================================================================
    !!                       ***  MODULE  florst  ***
-   !!
-   !!
-   !! write floats restart files
-   !!
+   !! Ocean floats : write floats restart files
    !!======================================================================
-   !!  History :
-   !!    8.0  !  99-09  (Y. Drillet)    : Original code
-   !!         !  00-06  (J.-M. Molines) : Profiling floats for CLS 
-   !!    8.5  !  02-10  (A. Bozec)  F90 : Free form and module
-   !!    3.2  !  10-08  (slaw, cbricaud): netcdf outputs and others 
+   !!  History :  OPA  !  1999-09  (Y. Drillet)    : Original code
+   !!              -   !  2000-06  (J.-M. Molines) : Profiling floats for CLS 
+   !!   NEMO      1.0  !  2002-10  (A. Bozec)  F90 : Free form and module
+   !!             3.2  !  2010-08  (slaw, cbricaud): netcdf outputs and others 
    !!----------------------------------------------------------------------
-#if   defined key_floats   ||   defined key_esopa
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                     float trajectories
    !!----------------------------------------------------------------------
-
-   !! * Modules used
    USE flo_oce         ! ocean drifting floats
    USE dom_oce         ! ocean space and time domain
@@ -32,12 +26,9 @@
    INTEGER, ALLOCATABLE, DIMENSION(:) :: iperproc   ! 1D workspace
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -59,13 +50,10 @@
       !! ** Purpose :  
       !!             
-      !!    
       !!      
       !! ** Method  :   The frequency of  ??? is nwritefl
       !!      
       !!----------------------------------------------------------------------
-      !! * Arguments
       INTEGER  :: kt                            ! time step
-
-      !! * Local declarations
+      !
       CHARACTER (len=80)       :: clname             ! restart filename
       INTEGER                  :: ic , jc , jpn ,jfl ! temporary integer
@@ -132,9 +120,8 @@
             ENDIF
          ENDIF
-
+         !
       ENDIF
-
+      !
    END SUBROUTINE flo_rst
-
 
 #  else
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 6808)
@@ -3,21 +3,16 @@
    !!                       ***  MODULE  flowri  ***
    !!
-   !! write floats trajectory in ascii                    ln_flo_ascii = T
-   !!                      or in netcdf ( IOM or IOSPSL ) ln_flo_ascii = F           
-   !! 
-   !!
+   !! Ocean floats: write floats trajectory in ascii                    ln_flo_ascii = T
+   !!                                    or in netcdf ( IOM or IOSPSL ) ln_flo_ascii = F           
    !!======================================================================
-   !!  History :
-   !!    8.0  !  99-09  (Y. Drillet)    : Original code
-   !!         !  00-06  (J.-M. Molines) : Profiling floats for CLS 
-   !!    8.5  !  02-10  (A. Bozec)  F90 : Free form and module
-   !!    3.2  !  10-08  (slaw, cbricaud): netcdf outputs and others 
-   !!----------------------------------------------------------------------
-#if   defined key_floats   ||   defined key_esopa
+   !!  History :  OPA  !  1999-09  (Y. Drillet)    : Original code
+   !!              -   !  2000-06  (J.-M. Molines) : Profiling floats for CLS 
+   !!   NEMO      1.0  !  2002-10  (A. Bozec)  F90 : Free form and module
+   !!             3.2  !  2010-08  (slaw, cbricaud): netcdf outputs and others 
+   !!----------------------------------------------------------------------
+#if   defined key_floats
    !!----------------------------------------------------------------------
    !!   'key_floats'                                     float trajectories
    !!----------------------------------------------------------------------
-
-   !! * Modules used
    USE flo_oce         ! ocean drifting floats
    USE oce             ! ocean dynamics and tracers
@@ -30,5 +25,4 @@
    USE iom             ! I/O library
 
-
    IMPLICIT NONE
    PRIVATE
@@ -46,12 +40,9 @@
    REAL(wp), ALLOCATABLE, DIMENSION(:) ::   ztem , zsal, zrho   ! 2D workspace
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -132,5 +123,5 @@
                zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   &
                      +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc)
-               zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl)     
+               zdep(jfl) = (1.-zcfl)*gdepw_n(iafloc,ibfloc,icfl ) + zcfl * gdepw_n(iafloc,ibfloc,ic1fl)     
 
                !save temperature, salinity and density at this position
@@ -153,5 +144,5 @@
             zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   &
                       +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc)
-            zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl)
+            zdep(jfl) = (1.-zcfl)*gdepw_n(iafloc,ibfloc,icfl ) + zcfl * gdepw_n(iafloc,ibfloc,ic1fl)
 
             ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90	(revision 6808)
@@ -43,5 +43,5 @@
    PUBLIC   icb_alloc   ! routine called by icb_init in icbini.F90 module
 
-INTEGER, PUBLIC, PARAMETER ::   nclasses = 10   !: Number of icebergs classes   
+   INTEGER, PUBLIC, PARAMETER ::   nclasses = 10   !: Number of icebergs classes   
    INTEGER, PUBLIC, PARAMETER ::   nkounts  =  3   !: Number of integers combined for unique naming
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90	(revision 6808)
@@ -191,5 +191,5 @@
 
          nbergs_end        = icb_utl_count()
-         zgrdd_berg_mass   = SUM( berg_mass (:,:)*e1e2t(:,:)*tmask_i(:,:) )
+         zgrdd_berg_mass   = SUM( berg_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) )
          zgrdd_bits_mass   = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) )
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90	(revision 6808)
@@ -12,4 +12,6 @@
    !!            -    !                            Currently needs a fixed processor
    !!            -    !                            layout between restarts
+   !!            -    !  2015-11  Dave Storkey     Convert icb_rst_read to use IOM so can
+   !!                                              read single restart files
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
@@ -22,4 +24,5 @@
    USE lib_mpp        ! NEMO MPI library, lk_mpp in particular
    USE netcdf         ! netcdf routines for IO
+   USE iom
    USE icb_oce        ! define iceberg arrays
    USE icbutl         ! iceberg utility routines
@@ -57,10 +60,6 @@
       INTEGER                      ::   idim, ivar, iatt
       INTEGER                      ::   jn, iunlim_dim, ibergs_in_file
-      INTEGER                      ::   iclass
-      INTEGER, DIMENSION(1)        ::   istrt, ilngth, idata
-      INTEGER, DIMENSION(2)        ::   istrt2, ilngth2
-      INTEGER, DIMENSION(nkounts)  ::   idata2
-      REAL(wp), DIMENSION(1)       ::   zdata                                         ! need 1d array to read in with
-                                                                                            ! start and count arrays
+      INTEGER                      ::   ii,ij,iclass
+      REAL(wp), DIMENSION(nkounts) ::   zdata      
       LOGICAL                      ::   ll_found_restart
       CHARACTER(len=256)           ::   cl_path
@@ -71,138 +70,62 @@
       !!----------------------------------------------------------------------
 
-      ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts. 
+      ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts
+      ! and are called TRIM(cn_ocerst)//'_icebergs'
       cl_path = TRIM(cn_ocerst_indir)
       IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/'
-      cl_filename = ' '
-      IF ( lk_mpp ) THEN
-         cl_filename = ' '
-         WRITE( cl_filename, '("restart_icebergs_",I4.4,".nc")' ) narea-1
-         INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart )
-      ELSE
-         cl_filename = 'restart_icebergs.nc'
-         INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart )
-      ENDIF
-
-      IF ( .NOT. ll_found_restart) THEN                     ! only do the following if a file was found
-         CALL ctl_stop('icebergs: no restart file found')
-      ENDIF
-
-      IF (nn_verbose_level >= 0 .AND. lwp)  &
-         WRITE(numout,'(2a)') 'icebergs, read_restart_bergs: found restart file = ',TRIM(cl_path)//TRIM(cl_filename)
-
-      nret = NF90_OPEN(TRIM(cl_path)//TRIM(cl_filename), NF90_NOWRITE, ncid)
-      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_open failed')
-
-      nret = nf90_inquire(ncid, idim, ivar, iatt, iunlim_dim)
-      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_inquire failed')
-
-      IF( iunlim_dim .NE. -1) THEN
-
-         nret = nf90_inquire_dimension(ncid, iunlim_dim, cl_dname, ibergs_in_file)
-         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_inq_dimlen failed')
-
-         nret = NF90_INQ_VARID(ncid, 'number', numberid)
-         nret = NF90_INQ_VARID(ncid, 'mass_scaling', nscaling_id)
-         nret = NF90_INQ_VARID(ncid, 'xi', nxid)
-         nret = NF90_INQ_VARID(ncid, 'yj', nyid)
-         nret = NF90_INQ_VARID(ncid, 'lon', nlonid)
-         nret = NF90_INQ_VARID(ncid, 'lat', nlatid)
-         nret = NF90_INQ_VARID(ncid, 'uvel', nuvelid)
-         nret = NF90_INQ_VARID(ncid, 'vvel', nvvelid)
-         nret = NF90_INQ_VARID(ncid, 'mass', nmassid)
-         nret = NF90_INQ_VARID(ncid, 'thickness', nthicknessid)
-         nret = NF90_INQ_VARID(ncid, 'width', nwidthid)
-         nret = NF90_INQ_VARID(ncid, 'length', nlengthid)
-         nret = NF90_INQ_VARID(ncid, 'year', nyearid)
-         nret = NF90_INQ_VARID(ncid, 'day', ndayid)
-         nret = NF90_INQ_VARID(ncid, 'mass_of_bits', nmass_of_bits_id)
-         nret = NF90_INQ_VARID(ncid, 'heat_density', nheat_density_id)
-
-         ilngth(1) = 1
-         istrt2(1) = 1
-         ilngth2(1) = nkounts
-         ilngth2(2) = 1
-         DO jn=1, ibergs_in_file
-
-            istrt(1) = jn
-            istrt2(2) = jn
-
-            nret = NF90_GET_VAR(ncid, numberid, idata2, istrt2, ilngth2 )
-            localberg%number(:) = idata2(:)
-
-            nret = NF90_GET_VAR(ncid, nscaling_id, zdata, istrt, ilngth )
-            localberg%mass_scaling = zdata(1)
-
-            nret = NF90_GET_VAR(ncid, nlonid, zdata, istrt, ilngth)
-            localpt%lon = zdata(1)
-            nret = NF90_GET_VAR(ncid, nlatid, zdata, istrt, ilngth)
-            localpt%lat = zdata(1)
-            IF (nn_verbose_level >= 2 .AND. lwp) THEN
-               WRITE(numout,'(a,i5,a,2f10.4,a,i5)') 'icebergs, read_restart_bergs: berg ',jn,' is at ', &
-                                              localpt%lon,localpt%lat,' on PE ',narea-1
+      cl_filename = TRIM(cn_ocerst_in)//'_icebergs'
+      CALL iom_open( TRIM(cl_path)//cl_filename, ncid )
+
+      IF( iom_file(ncid)%iduld .GE. 0) THEN
+
+         ibergs_in_file = iom_file(ncid)%lenuld
+         DO jn = 1,ibergs_in_file
+
+            ! iom_get treats the unlimited dimension as time. Here the unlimited dimension 
+            ! is the iceberg index, but we can still use the ktime keyword to get the iceberg we want. 
+
+            CALL iom_get( ncid, 'xi'     ,localpt%xi  , ktime=jn )
+            CALL iom_get( ncid, 'yj'     ,localpt%yj  , ktime=jn )
+
+            ii = INT( localpt%xi + 0.5 )
+            ij = INT( localpt%yj + 0.5 )
+            ! Only proceed if this iceberg is on the local processor (excluding halos).
+            IF ( ii .GE. nldi+nimpp-1 .AND. ii .LE. nlei+nimpp-1 .AND. &
+           &     ij .GE. nldj+njmpp-1 .AND. ij .LE. nlej+njmpp-1 ) THEN           
+
+               CALL iom_get( ncid, jpdom_unknown, 'number'       , zdata(:) , ktime=jn, kstart=(/1/), kcount=(/nkounts/) )
+               localberg%number(:) = INT(zdata(:))
+               CALL iom_get( ncid, 'mass_scaling' , localberg%mass_scaling, ktime=jn )
+               CALL iom_get( ncid, 'lon'          , localpt%lon           , ktime=jn )
+               CALL iom_get( ncid, 'lat'          , localpt%lat           , ktime=jn )
+               CALL iom_get( ncid, 'uvel'         , localpt%uvel          , ktime=jn )
+               CALL iom_get( ncid, 'vvel'         , localpt%vvel          , ktime=jn )
+               CALL iom_get( ncid, 'mass'         , localpt%mass          , ktime=jn )
+               CALL iom_get( ncid, 'thickness'    , localpt%thickness     , ktime=jn )
+               CALL iom_get( ncid, 'width'        , localpt%width         , ktime=jn )
+               CALL iom_get( ncid, 'length'       , localpt%length        , ktime=jn )
+               CALL iom_get( ncid, 'year'         , zdata(1)              , ktime=jn )
+               localpt%year = INT(zdata(1))
+               CALL iom_get( ncid, 'day'          , localpt%day           , ktime=jn )
+               CALL iom_get( ncid, 'mass_of_bits' , localpt%mass_of_bits  , ktime=jn )
+               CALL iom_get( ncid, 'heat_density' , localpt%heat_density  , ktime=jn )
+
+               !
+               CALL icb_utl_add( localberg, localpt )
+
             ENDIF
-            nret = NF90_GET_VAR(ncid, nxid, zdata, istrt, ilngth)
-            localpt%xi = zdata(1)
-            nret = NF90_GET_VAR(ncid, nyid, zdata, istrt, ilngth)
-            localpt%yj = zdata(1)
-            nret = NF90_GET_VAR(ncid, nuvelid, zdata, istrt, ilngth )
-            localpt%uvel = zdata(1)
-            nret = NF90_GET_VAR(ncid, nvvelid, zdata, istrt, ilngth )
-            localpt%vvel = zdata(1)
-            nret = NF90_GET_VAR(ncid, nmassid, zdata, istrt, ilngth )
-            localpt%mass = zdata(1)
-            nret = NF90_GET_VAR(ncid, nthicknessid, zdata, istrt, ilngth )
-            localpt%thickness = zdata(1)
-            nret = NF90_GET_VAR(ncid, nwidthid, zdata, istrt, ilngth )
-            localpt%width = zdata(1)
-            nret = NF90_GET_VAR(ncid, nlengthid, zdata, istrt, ilngth )
-            localpt%length = zdata(1)
-            nret = NF90_GET_VAR(ncid, nyearid, idata, istrt, ilngth )
-            localpt%year = idata(1)
-            nret = NF90_GET_VAR(ncid, ndayid, zdata, istrt, ilngth )
-            localpt%day = zdata(1)
-            nret = NF90_GET_VAR(ncid, nmass_of_bits_id, zdata, istrt, ilngth )
-            localpt%mass_of_bits = zdata(1)
-            nret = NF90_GET_VAR(ncid, nheat_density_id, zdata, istrt, ilngth )
-            localpt%heat_density = zdata(1)
-            !
-            CALL icb_utl_add( localberg, localpt )
+
          END DO
-         !
-      ENDIF
-
-      nret = NF90_INQ_DIMID( ncid, 'c', nc_dim )
-      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart: nf_inq_dimid c failed')
-
-      nret = NF90_INQUIRE_DIMENSION( ncid, nc_dim, cl_dname, iclass )
-      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart: nf_inquire_dimension failed')
-
-      nret = NF90_INQ_VARID(ncid, 'kount'       , nkountid)
-      nret = NF90_INQ_VARID(ncid, 'calving'     , ncalvid)
-      nret = NF90_INQ_VARID(ncid, 'calving_hflx', ncalvhid)
-      nret = NF90_INQ_VARID(ncid, 'stored_ice'  , nsiceid)
-      nret = NF90_INQ_VARID(ncid, 'stored_heat' , nsheatid)
-
-      nstrt3(1) = 1
-      nstrt3(2) = 1
-      nlngth3(1) = jpi
-      nlngth3(2) = jpj
-      nlngth3(3) = 1
-
-      DO jn = 1, iclass
-         nstrt3(3) = jn
-         nret      = NF90_GET_VAR( ncid, nsiceid , griddata, nstrt3, nlngth3 )
-         berg_grid%stored_ice(:,:,jn) = griddata(:,:,1)
-      END DO
-
-      nret = NF90_GET_VAR( ncid, ncalvid , src_calving          (:,:) )
-      nret = NF90_GET_VAR( ncid, ncalvhid, src_calving_hflx     (:,:) )
-      nret = NF90_GET_VAR( ncid, nsheatid, berg_grid%stored_heat(:,:) )
-      nret = NF90_GET_VAR( ncid, nkountid, idata2(:) )
-      num_bergs(:) = idata2(:)
-
-      ! Finish up
-      nret = NF90_CLOSE(ncid)
-      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart: nf_close failed')
+
+      ENDIF 
+
+      ! Gridded variables
+      CALL iom_get( ncid, jpdom_autoglo,    'calving'     , src_calving  )
+      CALL iom_get( ncid, jpdom_autoglo,    'calving_hflx', src_calving_hflx  )
+      CALL iom_get( ncid, jpdom_autoglo,    'stored_heat' , berg_grid%stored_heat  )
+      CALL iom_get( ncid, jpdom_autoglo_xy, 'stored_ice'  , berg_grid%stored_ice, kstart=(/1,1,1/), kcount=(/1,1,nclasses/) )
+      
+      CALL iom_get( ncid, jpdom_unknown, 'kount' , zdata(:) )
+      num_bergs(:) = INT(zdata(:))
 
       ! Sanity check
@@ -211,9 +134,13 @@
          WRITE(numout,'(2(a,i5))') 'icebergs, read_restart_bergs: # bergs =',jn,' on PE',narea-1
       IF( lk_mpp ) THEN
-         CALL mpp_sum(ibergs_in_file)
+         ! Only mpp_sum ibergs_in_file if we are reading from multiple restart files. 
+         IF( INDEX(iom_file(ncid)%name,'icebergs.nc' ) .EQ. 0 ) CALL mpp_sum(ibergs_in_file)
          CALL mpp_sum(jn)
       ENDIF
       IF(lwp)   WRITE(numout,'(a,i5,a,i5,a)') 'icebergs, read_restart_bergs: there were',ibergs_in_file,   &
          &                                    ' bergs in the restart file and', jn,' bergs have been read'
+      !
+      ! Finish up
+      CALL iom_close( ncid )
       !
       IF( lwp .and. nn_verbose_level >= 0)  WRITE(numout,'(a)') 'icebergs, read_restart_bergs: completed'
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90	(revision 6808)
@@ -156,5 +156,5 @@
          ! use tmask rather than tmask_i when dealing with icebergs
          IF( tmask(ii,ij,1) /= 0._wp ) THEN    ! Add melting to the grid and field diagnostics
-            z1_e1e2    = 1._wp / e1e2t(ii,ij) * this%mass_scaling
+            z1_e1e2    = r1_e1e2t(ii,ij) * this%mass_scaling
             z1_dt_e1e2 = z1_dt * z1_e1e2
             zmelt    = ( zdM - ( zdMbitsE - zdMbitsM ) ) * z1_dt   ! kg/s
@@ -195,5 +195,5 @@
             !
          ELSE                            ! Diagnose mass distribution on grid
-            z1_e1e2 = 1._wp / e1e2t(ii,ij) * this%mass_scaling
+            z1_e1e2 = r1_e1e2t(ii,ij) * this%mass_scaling
             CALL icb_dia_size( ii, ij, zWn, zLn, zAbits,   &
             &                  this%mass_scaling, zMnew, znMbits, z1_e1e2)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 6808)
@@ -13,5 +13,4 @@
    !!----------------------------------------------------------------------
    USE par_oce       ! ocean parameter
-   USE lib_print     ! formated print library
    USE nc4interface  ! NetCDF4 interface
 
@@ -37,4 +36,5 @@
    INTEGER       ::   nn_itend         !: index of the last time step
    INTEGER       ::   nn_date0         !: initial calendar date aammjj
+   INTEGER       ::   nn_time0         !: initial time of day in hhmm
    INTEGER       ::   nn_leapy         !: Leap year calendar flag (0/1 or 30)
    INTEGER       ::   nn_istate        !: initial state output flag (0/1)
@@ -42,6 +42,4 @@
    INTEGER       ::   nn_stock         !: restart file frequency
    INTEGER, DIMENSION(10) :: nn_stocklist  !: restart dump times
-   LOGICAL       ::   ln_dimgnnn       !: type of dimgout. (F): 1 file for all proc
-                                                       !:                  (T): 1 file per proc
    LOGICAL       ::   ln_mskland       !: mask land points in NetCDF outputs (costly: + ~15%)
    LOGICAL       ::   ln_cfmeta        !: output additional data to netCDF files required for compliance with the CF metadata standard
@@ -99,4 +97,5 @@
    LOGICAL ::   ln_ctl       !: run control for debugging
    INTEGER ::   nn_timing    !: run control for timing
+   INTEGER ::   nn_diacfl    !: flag whether to create CFL diagnostics
    INTEGER ::   nn_print     !: level of print (0 no print)
    INTEGER ::   nn_ictls     !: Start i indice for the SUM control
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 6808)
@@ -8,4 +8,5 @@
    !!            3.0  ! 2007-07  (D. Storkey) Changes to iom_gettime
    !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case  
+   !!            3.6  ! 2014-15  DIMG format removed
    !!--------------------------------------------------------------------
 
@@ -23,7 +24,5 @@
    USE lbclnk          ! lateal boundary condition / mpp exchanges
    USE iom_def         ! iom variables definitions
-   USE iom_ioipsl      ! NetCDF format with IOIPSL library
    USE iom_nf90        ! NetCDF format with native NetCDF library
-   USE iom_rstdimg     ! restarts access direct format "dimg" style...
    USE in_out_manager  ! I/O manager
    USE lib_mpp           ! MPP library
@@ -129,8 +128,8 @@
          !
          IF( ln_cfmeta ) THEN   ! Add additional grid metadata
-            CALL iom_set_domain_attr("grid_T", area = e12t(nldi:nlei, nldj:nlej))
-            CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej))
-            CALL iom_set_domain_attr("grid_V", area = e12v(nldi:nlei, nldj:nlej))
-            CALL iom_set_domain_attr("grid_W", area = e12t(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej))
             CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
             CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
@@ -246,5 +245,5 @@
       CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
       CHARACTER(LEN=256)    ::   cltmpn    ! tempory name to store clname (in writting mode)
-      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" or ".dimg"
+      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" 
       CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits)
       CHARACTER(LEN=256)    ::   clinfo    ! info character
@@ -309,9 +308,7 @@
       ! which suffix should we use?
       SELECT CASE (iolib)
-      CASE (jpioipsl ) ;   clsuffix = '.nc'
       CASE (jpnf90   ) ;   clsuffix = '.nc'
-      CASE (jprstdimg) ;   clsuffix = '.dimg'
       CASE DEFAULT     ;   clsuffix = ''
-         CALL ctl_stop( TRIM(clinfo), 'accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+         CALL ctl_stop( TRIM(clinfo), 'accepted IO library is only jpnf90 (jpioipsl option has been removed) ' )
       END SELECT
       ! Add the suffix if needed
@@ -326,7 +323,6 @@
       IF( .NOT.llok ) THEN
          ! we try to add the cpu number to the name
-         IF( iolib == jprstdimg ) THEN   ;   WRITE(clcpu,*) narea
-         ELSE                            ;   WRITE(clcpu,*) narea-1
-         ENDIF
+         WRITE(clcpu,*) narea-1
+
          clcpu  = TRIM(ADJUSTL(clcpu))
          iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
@@ -375,5 +371,5 @@
          END SELECT
       ENDIF
-      ! Open the NetCDF or RSTDIMG file
+      ! Open the NetCDF file
       ! =============
       ! do we have some free file identifier?
@@ -399,9 +395,7 @@
       IF( istop == nstop ) THEN   ! no error within this routine
          SELECT CASE (iolib)
-         CASE (jpioipsl )   ;   CALL iom_ioipsl_open(  clname, kiomid, llwrt, llok, idompar )
          CASE (jpnf90   )   ;   CALL iom_nf90_open(    clname, kiomid, llwrt, llok, idompar )
-         CASE (jprstdimg)   ;   CALL iom_rstdimg_open( clname, kiomid, llwrt, llok, idompar )
          CASE DEFAULT
-            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed) ' )
          END SELECT
       ENDIF
@@ -438,9 +432,7 @@
             IF( iom_file(jf)%nfid > 0 ) THEN
                SELECT CASE (iom_file(jf)%iolib)
-               CASE (jpioipsl )   ;   CALL iom_ioipsl_close(  jf )
                CASE (jpnf90   )   ;   CALL iom_nf90_close(    jf )
-               CASE (jprstdimg)   ;   CALL iom_rstdimg_close( jf )
                CASE DEFAULT
-                  CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+                  CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
                END SELECT
                iom_file(jf)%nfid       = 0          ! free the id 
@@ -497,9 +489,7 @@
                IF( iiv <= jpmax_vars ) THEN
                   SELECT CASE (iom_file(kiomid)%iolib)
-                  CASE (jpioipsl )   ;   iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz )
                   CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz, kndims )
-                  CASE (jprstdimg)   ;   iom_varid = -1   ! all variables are listed in iom_file
-                  CASE DEFAULT   
-                     CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+                  CASE DEFAULT
+                     CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
                   END SELECT
                ELSE
@@ -559,9 +549,7 @@
                                  &                         'Use ncwa -a to suppress the unnecessary dimensions' )
             SELECT CASE (iom_file(kiomid)%iolib)
-            CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, pvar, itime )
             CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, pvar, itime )
-            CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idvar, pvar )
-            CASE DEFAULT    
-               CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_g0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
             END SELECT
          ENDIF
@@ -673,4 +661,5 @@
       CHARACTER(LEN=256)             ::   clname      ! file name
       CHARACTER(LEN=1)               ::   clrankpv, cldmspc      ! 
+      LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension.
       !---------------------------------------------------------------------
       !
@@ -685,5 +674,6 @@
       IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
       IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
-      IF( PRESENT(kstart) .AND. idom /= jpdom_unknown   ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown')
+      IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND.  idom /= jpdom_autoglo_xy  ) &
+     &           CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy')
 
       luse_jattr = .false.
@@ -694,11 +684,8 @@
       IF( luse_jattr ) THEN
          SELECT CASE (iom_file(kiomid)%iolib)
-         CASE (jpioipsl, jprstdimg )
-             CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)')
-             luse_jattr = .false.
          CASE (jpnf90   )   
              ! Ok
          CASE DEFAULT    
-            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
          END SELECT
       ENDIF
@@ -718,4 +705,10 @@
          ! update idom definition...
          ! Identify the domain in case of jpdom_auto(glo/dta) definition
+         IF( idom == jpdom_autoglo_xy ) THEN
+            ll_depth_spec = .TRUE.
+            idom = jpdom_autoglo
+         ELSE
+            ll_depth_spec = .FALSE.
+         ENDIF
          IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN            
             IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global 
@@ -771,7 +764,7 @@
          istart(idmspc+1) = itime
 
-         IF(              PRESENT(kstart)       ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)
+         IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)
          ELSE
-            IF(           idom == jpdom_unknown ) THEN                                       ; icnt(1:idmspc) = idimsz(1:idmspc)
+            IF(           idom == jpdom_unknown ) THEN                                                ; icnt(1:idmspc) = idimsz(1:idmspc)
             ELSE 
                IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array
@@ -796,6 +789,7 @@
                   ENDIF
                   IF( PRESENT(pv_r3d) ) THEN
-                     IF( idom == jpdom_data ) THEN   ; icnt(3) = jpkdta
-                     ELSE                            ; icnt(3) = jpk
+                     IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkdta
+                     ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN            ; istart(3) = kstart(3); icnt(3) = kcount(3)
+                     ELSE                                                           ; icnt(3) = jpk
                      ENDIF
                   ENDIF
@@ -866,12 +860,8 @@
       
          SELECT CASE (iom_file(kiomid)%iolib)
-         CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
-            &                                         pv_r1d, pv_r2d, pv_r3d )
          CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
             &                                         pv_r1d, pv_r2d, pv_r3d )
-         CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2,   &
-            &                                         pv_r1d, pv_r2d, pv_r3d )
-         CASE DEFAULT    
-            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+         CASE DEFAULT
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
          END SELECT
 
@@ -903,12 +893,8 @@
                IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs
             ELSEIF( PRESENT(pv_r2d) ) THEN
-!CDIR COLLAPSE
                IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf
-!CDIR COLLAPSE
                IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs
             ELSEIF( PRESENT(pv_r3d) ) THEN
-!CDIR COLLAPSE
                IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
-!CDIR COLLAPSE
                IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
             ENDIF
@@ -960,9 +946,7 @@
                   IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN
                      SELECT CASE (iom_file(kiomid)%iolib)
-                     CASE (jpioipsl )   ;   CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
                      CASE (jpnf90   )   ;   CALL iom_nf90_gettime(   kiomid, idvar, ptime, cdunits, cdcalendar )
-                     CASE (jprstdimg)   ;   CALL ctl_stop( TRIM(clinfo)//' case IO library == jprstdimg not coded...' )
-                     CASE DEFAULT    
-                        CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+                     CASE DEFAULT
+                        CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
                      END SELECT
                   ELSE
@@ -995,9 +979,7 @@
          IF( iom_file(kiomid)%nfid > 0 ) THEN
             SELECT CASE (iom_file(kiomid)%iolib)
-            CASE (jpioipsl )   ;   CALL ctl_stop('iom_getatt: only nf90 available')
             CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pvar )
-            CASE (jprstdimg)   ;   CALL ctl_stop('iom_getatt: only nf90 available')
-            CASE DEFAULT    
-               CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_g0d_att: accepted IO library is only jpnf90' )
             END SELECT
          ENDIF
@@ -1021,9 +1003,7 @@
             ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
             SELECT CASE (iom_file(kiomid)%iolib)
-            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
             CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
-            CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar )
-            CASE DEFAULT     
-               CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
             END SELECT
          ENDIF
@@ -1043,9 +1023,7 @@
             ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
             SELECT CASE (iom_file(kiomid)%iolib)
-            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
             CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
-            CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar )
-            CASE DEFAULT     
-               CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
             END SELECT
          ENDIF
@@ -1065,9 +1043,7 @@
             ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
             SELECT CASE (iom_file(kiomid)%iolib)
-            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
             CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
-            CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar ) 
-            CASE DEFAULT     
-               CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
             END SELECT
          ENDIF
@@ -1087,9 +1063,7 @@
             ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
             SELECT CASE (iom_file(kiomid)%iolib)
-            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
             CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
-            CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar )
-            CASE DEFAULT     
-               CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
             END SELECT
          ENDIF
@@ -1196,6 +1170,8 @@
       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 )
+      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
@@ -1647,5 +1623,5 @@
             idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
             DO WHILE ( idx /= 0 ) 
-               cldate = iom_sdate( fjulday - rdttra(1) / rday )
+               cldate = iom_sdate( fjulday - rdt / rday )
                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname))
                idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
@@ -1654,5 +1630,5 @@
             idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
             DO WHILE ( idx /= 0 ) 
-               cldate = iom_sdate( fjulday - rdttra(1) / rday, ldfull = .TRUE. )
+               cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. )
                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname))
                idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
@@ -1661,5 +1637,5 @@
             idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
             DO WHILE ( idx /= 0 ) 
-               cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
+               cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname))
                idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
@@ -1668,9 +1644,10 @@
             idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
             DO WHILE ( idx /= 0 ) 
-               cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
+               cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname))
                idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
             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 )
@@ -1720,4 +1697,6 @@
       ENDIF
       
+!$AGRIF_DO_NOT_TREAT      
+! Should be fixed in the conv
       IF( llfull ) THEN 
          clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
@@ -1730,4 +1709,5 @@
          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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 6808)
@@ -9,5 +9,5 @@
    !!---------------------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!---------------------------------------------------------------------------------
@@ -26,14 +26,10 @@
    INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 7   !: No dimension checking
    INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo       = 8   !: 
-   INTEGER, PARAMETER, PUBLIC ::   jpdom_autodta       = 9   !: 
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo_xy    = 9   !: Automatically set horizontal dimensions only
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autodta       = 10  !: 
 
-   INTEGER, PARAMETER, PUBLIC ::   jpioipsl    = 100      !: Use ioipsl (fliocom only) library
    INTEGER, PARAMETER, PUBLIC ::   jpnf90      = 101      !: Use nf90 library
-   INTEGER, PARAMETER, PUBLIC ::   jprstdimg   = 102      !: Use restart dimgs (fortran direct acces) library
-#if defined key_dimgout
-   INTEGER, PARAMETER, PUBLIC ::   jprstlib  = jprstdimg  !: restarts io library
-#else
+
    INTEGER, PARAMETER, PUBLIC ::   jprstlib  = jpnf90     !: restarts io library
-#endif
 
    INTEGER, PARAMETER, PUBLIC ::   jp_r8    = 200      !: write REAL(8)
@@ -54,7 +50,9 @@
       CHARACTER(LEN=240)                        ::   name     !: name of the file
       INTEGER                                   ::   nfid     !: identifier of the file (0 if closed)
-      INTEGER                                   ::   iolib    !: library used to read the file (jpioipsl, jpnf90 or jprstdimg)
+      INTEGER                                   ::   iolib    !: library used to read the file (jpnf90 or new formats,
+                                                              !: jpioipsl option has been removed)
       INTEGER                                   ::   nvars    !: number of identified varibles in the file
       INTEGER                                   ::   iduld    !: id of the unlimited dimension
+      INTEGER                                   ::   lenuld   !: length of the unlimited dimension (number of records in file)
       INTEGER                                   ::   irec     !: writing record position  
       CHARACTER(LEN=32)                         ::   uldname  !: name of the unlimited dimension
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90	(revision 6807)
+++ 	(revision )
@@ -1,439 +1,0 @@
-MODULE iom_ioipsl
-   !!=====================================================================
-   !!                    ***  MODULE  iom_ioipsl ***
-   !! Input/Output manager :  Library to read input files with IOIPSL (only fliocom module)
-   !!====================================================================
-   !! History :  9.0  ! 05 12  (J. Belier) Original code
-   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO
-   !!             "   ! 07 07  (D. Storkey) Changes to iom_ioipsl_gettime
-   !!--------------------------------------------------------------------
-   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes
-
-   !!--------------------------------------------------------------------
-   !!   iom_open       : open a file read only
-   !!   iom_close      : close a file or all files opened by iom
-   !!   iom_get        : read a field (interfaced to several routines)
-   !!   iom_gettime    : read the time axis kvid in the file
-   !!   iom_varid      : get the id of a variable in a file
-   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
-   !!--------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE iom_def         ! iom variables definitions
-   USE ioipsl          ! IOIPSL library
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC iom_ioipsl_open, iom_ioipsl_close, iom_ioipsl_varid, iom_ioipsl_get, iom_ioipsl_gettime, iom_ioipsl_rstput
-
-   INTERFACE iom_ioipsl_get
-      MODULE PROCEDURE iom_ioipsl_g0d, iom_ioipsl_g123d
-   END INTERFACE
-   INTERFACE iom_ioipsl_rstput
-      MODULE PROCEDURE iom_ioipsl_rp0123d
-   END INTERFACE
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE iom_ioipsl_open( cdname, kiomid, ldwrt, ldok, kdompar )
-      !!---------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  iom_open  ***
-      !!
-      !! ** Purpose :  open an input file with IOIPSL (only fliocom module)
-      !!---------------------------------------------------------------------
-      CHARACTER(len=*)       , INTENT(inout)           ::   cdname      ! File name
-      INTEGER                , INTENT(  out)           ::   kiomid      ! ioipsl identifier of the opened file
-      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file?
-      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence 
-      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters: 
-
-      CHARACTER(LEN=100) ::   clinfo      ! info character
-      CHARACTER(LEN=10 ) ::   clstatus    ! status of opened file (REPLACE or NEW)
-      INTEGER            ::   iln         ! lengths of character
-      INTEGER            ::   istop       ! temporary storage of nstop
-      INTEGER            ::   ifliodom    ! model domain identifier (see flio_dom_set)
-      INTEGER            ::   ioipslid    ! ioipsl identifier of the opened file
-      INTEGER            ::   jl          ! loop variable
-      LOGICAL            ::   llclobber   ! local definition of ln_clobber
-      !---------------------------------------------------------------------
-
-      clinfo = '                    iom_ioipsl_open ~~~  '
-      istop = nstop
-      !
-      llclobber = ldwrt .AND. ln_clobber
-      IF( ldok .AND. .NOT. llclobber ) THEN      ! Open existing file...
-         !                 ! =============
-         IF( ldwrt ) THEN  ! ... in write mode
-            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode'
-            CALL flioopfd( TRIM(cdname), ioipslid, "WRITE" )
-         ELSE              ! ... in read mode
-            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
-            CALL flioopfd( TRIM(cdname), ioipslid )
-         ENDIF
-      ELSE                 ! the file does not exist
-         !                 ! =============
-         iln = INDEX( cdname, '.nc' )
-         IF( ldwrt ) THEN  ! the file should be open in write mode so we create it...
-            IF( llclobber ) THEN   ;   clstatus = 'REPLACE 64' 
-            ELSE                   ;   clstatus = 'NEW 64'
-            ENDIF
-            IF( jpnij > 1 ) THEN
-               ! define the domain position regarding to the global domain (mainly useful in mpp)
-               CALL flio_dom_set( jpnij, narea-1, (/1, 2/), (/jpiglo, jpjglo/)   &
-                  &             , kdompar(:,1), kdompar(:,2), kdompar(:,3), kdompar(:,4), kdompar(:,5)   &
-                  &             , 'BOX', ifliodom )        
-               ! Note that fliocrfd may change the value of cdname (add the cpu number...)
-               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//cdname(1:iln-1)//'... in WRITE mode'
-               CALL fliocrfd( cdname, (/'x'         , 'y'         , 'z', 't'/)   &
-                  &         , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid, ifliodom, mode = clstatus )
-            ELSE              ! the file should be open for read mode so it must exist...
-               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//cdname//' in WRITE mode'
-               CALL fliocrfd( cdname, (/'x'         , 'y'         , 'z', 't'/)   &
-                  &         , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid,           mode = clstatus )
-            ENDIF
-         ELSE              ! the file should be open for read mode so it must exist...
-            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
-         ENDIF
-      ENDIF
-      ! start to fill file informations
-      ! =============
-      IF( istop == nstop ) THEN   ! no error within this routine
-!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1)
-         kiomid = 0
-         DO jl = jpmax_files, 1, -1
-            IF( iom_file(jl)%nfid == 0 )   kiomid = jl
-         ENDDO
-         iom_file(kiomid)%name   = TRIM(cdname)
-         iom_file(kiomid)%nfid   = ioipslid
-         iom_file(kiomid)%iolib  = jpioipsl
-         iom_file(kiomid)%nvars  = 0
-         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files
-         CALL flioinqf( ioipslid, id_uld = iom_file(kiomid)%iduld )
-         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK'
-      ELSE
-         kiomid = 0               ! return error flag
-      ENDIF
-      !
-   END SUBROUTINE iom_ioipsl_open
-
-
-   SUBROUTINE iom_ioipsl_close( kiomid )
-      !!--------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  iom_ioipsl_close  ***
-      !!
-      !! ** Purpose : close an input file with IOIPSL (only fliocom module) 
-      !!--------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kiomid   ! iom identifier of the file to be closed
-      !---------------------------------------------------------------------
-      !
-      CALL flioclo( iom_file(kiomid)%nfid )
-      !    
-   END SUBROUTINE iom_ioipsl_close
-
-
-   FUNCTION iom_ioipsl_varid ( kiomid, cdvar, kiv, kdimsz )  
-      !!-----------------------------------------------------------------------
-      !!                  ***  FUNCTION  iom_varid  ***
-      !!
-      !! ** Purpose : get the id of a variable in a file with IOIPSL (only fliocom module)
-      !!-----------------------------------------------------------------------
-      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
-      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
-      INTEGER              , INTENT(in   )           ::   kiv   ! 
-      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
-      !
-      INTEGER                        ::   iom_ioipsl_varid  ! iom variable Id
-      INTEGER                        ::   ioipslid          ! ioipsl file identifier
-      INTEGER                        ::   ji                ! dummy loop index
-      INTEGER                        ::   i_nvd             ! number of dimension of the variable
-      INTEGER, DIMENSION(jpmax_dims) ::   idimid            ! dimension ids of the variable
-      LOGICAL                        ::   ll_fnd            ! found test
-      CHARACTER(LEN=100)             ::   clinfo            ! info character
-      !!-----------------------------------------------------------------------
-      clinfo = 'iom_ioipsl_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
-      iom_ioipsl_varid = 0                  ! default definition
-      IF( PRESENT(kdimsz) ) kdimsz(:) = 0   ! default definition
-      ioipslid = iom_file(kiomid)%nfid      ! get back ioipsl file identifier 
-      CALL flioinqv( ioipslid, cdvar, ll_fnd, nb_dims = i_nvd )   ! does the variable exist in the file
-      IF( ll_fnd ) THEN
-         IF( i_nvd <= jpmax_dims ) THEN
-            iom_ioipsl_varid = kiv
-            iom_file(kiomid)%nvars       = kiv
-            iom_file(kiomid)%nvid(kiv)   = -1   ! variable id is not available in ioipsl
-            iom_file(kiomid)%cn_var(kiv) = TRIM(cdvar)
-            iom_file(kiomid)%ndims(kiv)  = i_nvd
-            iom_file(kiomid)%dimsz(:,kiv) = 0   ! reset dimsz in case previously used
-            CALL flioinqv( ioipslid, cdvar, ll_fnd,   &
-                  &           len_dims = iom_file(kiomid)%dimsz(1:i_nvd,kiv), &   ! dimensions size
-                  &           id_dims  = idimid(1:i_nvd) )                        ! dimensions ids
-            iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value
-            DO ji = 1, i_nvd                       ! find the unlimited dimension
-               IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.
-            END DO
-            !---------- Deal with scale_factor and add_offset
-            CALL flioinqa( ioipslid, cdvar, 'scale_factor', ll_fnd )
-            IF( ll_fnd) THEN
-               CALL fliogeta( ioipslid, cdvar, 'scale_factor', iom_file(kiomid)%scf(kiv) )
-            ELSE
-               iom_file(kiomid)%scf(kiv) = 1.
-            END IF
-            CALL flioinqa( ioipslid, cdvar, 'add_offset', ll_fnd )
-            IF( ll_fnd ) THEN
-               CALL fliogeta( ioipslid, cdvar, 'add_offset', iom_file(kiomid)%ofs(kiv) )
-            ELSE
-               iom_file(kiomid)%ofs(kiv) = 0.
-            END IF
-            ! return the simension size
-            IF( PRESENT(kdimsz) ) THEN 
-               IF( i_nvd == SIZE(kdimsz) ) THEN
-                  kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,kiv)
-               ELSE
-                  WRITE(ctmp1,*) i_nvd, SIZE(kdimsz)
-                  CALL ctl_stop( TRIM(clinfo), 'error in kdimsz size'//TRIM(ctmp1) )
-               ENDIF
-            ENDIF
-         ELSE
-            CALL ctl_stop( TRIM(clinfo), 'Too many dimensions in the file '//iom_file(kiomid)%name,   &
-                  &                       'increase the parameter jpmax_vars')
-         ENDIF
-      ELSE  
-         iom_ioipsl_varid = -1   !   variable not found, return error code: -1
-      ENDIF
-      !
-   END FUNCTION iom_ioipsl_varid
-
-
-   SUBROUTINE iom_ioipsl_g0d( kiomid, kvid, pvar, kstart )
-      !!-----------------------------------------------------------------------
-      !!                  ***  ROUTINE  iom_ioipsl_g0d  ***
-      !!
-      !! ** Purpose : read a scalar with IOIPSL (only fliocom module)
-      !!-----------------------------------------------------------------------
-      INTEGER ,               INTENT(in   )            ::   kiomid    ! Identifier of the file
-      INTEGER ,               INTENT(in   )            ::   kvid      ! variable id
-      REAL(wp),               INTENT(  out)            ::   pvar      ! read field
-      INTEGER , DIMENSION(1), INTENT(in   ), OPTIONAL  ::   kstart    ! start position of the reading in each axis
-      !
-      CALL fliogetv( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), pvar, kstart )
-      ! 
-   END SUBROUTINE iom_ioipsl_g0d
-
-
-   SUBROUTINE iom_ioipsl_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   &
-         &                      pv_r1d, pv_r2d, pv_r3d)
-      !!-----------------------------------------------------------------------
-      !!                  ***  ROUTINE  iom_ioipsl_g123d  ***
-      !!
-      !! ** Purpose : read a 1D/2D/3D variable with IOIPSL (only fliocom module)
-      !!
-      !! ** Method : read ONE record at each CALL
-      !!-----------------------------------------------------------------------
-      INTEGER                    , INTENT(in   )           ::   kiomid     ! iom identifier of the file
-      INTEGER                    , INTENT(in   )           ::   kvid       ! Name of the variable
-      INTEGER                    , INTENT(in   )           ::   knbdim     ! number of dimensions of the variable
-      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart     ! start position of the reading in each axis 
-      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount     ! number of points to be read in each axis
-      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes
-      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case)
-      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case)
-      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case)
-      !
-      INTEGER               ::   ioipslid   ! ioipsl file identifier
-      CHARACTER(LEN=100)    ::   clvn       ! variable name
-      !---------------------------------------------------------------------
-      clvn = TRIM(iom_file(kiomid)%cn_var(kvid))   ! get back variable name 
-      ioipslid = iom_file(kiomid)%nfid             ! get back IPIPSL file id
-      !
-      IF( PRESENT(pv_r1d) ) THEN
-         CALL fliogetv( ioipslid, clvn, pv_r1d(:                ), start = kstart(1:knbdim), count = kcount(1:knbdim) )
-      ELSEIF( PRESENT(pv_r2d) ) THEN
-         CALL fliogetv( ioipslid, clvn, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim), count = kcount(1:knbdim) )
-      ELSEIF( PRESENT(pv_r3d) ) THEN
-         CALL fliogetv( ioipslid, clvn, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim), count = kcount(1:knbdim) )
-      ENDIF
-      !
-      !
-   END SUBROUTINE iom_ioipsl_g123d
-
-
-   SUBROUTINE iom_ioipsl_gettime( kiomid, kvid, ptime, cdunits, cdcalendar )
-      !!--------------------------------------------------------------------
-      !!                   ***  SUBROUTINE iom_gettime  ***
-      !!
-      !! ** Purpose : read the time axis kvid in the file with IOIPSL (only fliocom module)
-      !!--------------------------------------------------------------------
-      INTEGER                   , INTENT(in   ) ::   kiomid     ! file Identifier
-      INTEGER                   , INTENT(in   ) ::   kvid       ! variable id
-      REAL(wp), DIMENSION(:)    , INTENT(  out) ::   ptime      ! the time axis
-      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdunits    ! units attribute
-      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdcalendar ! calendar attribute
-      !---------------------------------------------------------------------
-      !
-      CALL fliogetv( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), ptime(:),   &
-            &         start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /) )
-      IF ( PRESENT(cdunits) ) THEN 
-         CALL fliogeta( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), "units", cdunits )
-      ENDIF
-      IF ( PRESENT(cdcalendar) ) THEN 
-         CALL fliogeta( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), "calendar", cdcalendar )
-      ENDIF
-      !
-   END SUBROUTINE iom_ioipsl_gettime
-
-
-   SUBROUTINE iom_ioipsl_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   &
-         &                                 pv_r0d, pv_r1d, pv_r2d, pv_r3d )
-      !!--------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  iom_ioipsl_rstput  ***
-      !!
-      !! ** Purpose : read the time axis cdvar in the file 
-      !!--------------------------------------------------------------------
-      INTEGER                     , INTENT(in)           ::   kt       ! ocean time-step
-      INTEGER                     , INTENT(in)           ::   kwrite   ! writing time-step
-      INTEGER                     , INTENT(in)           ::   kiomid   ! Identifier of the file 
-      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name
-      INTEGER                     , INTENT(in)           ::   kvid     ! variable id
-      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8)
-      REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
-      REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
-      REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
-      REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
-      !
-      INTEGER               :: idims                ! number of dimension
-      INTEGER               :: idvar                ! variable id
-      INTEGER               :: itype                ! variable type
-      INTEGER               :: ix1, ix2, iy1, iy2   ! subdomain indexes
-      INTEGER, DIMENSION(4) :: idimsz               ! dimensions size  
-      INTEGER, DIMENSION(4) :: idimid               ! dimensions id
-      CHARACTER(LEN=100)    :: clinfo               ! info character
-      INTEGER               :: ioipslid             ! ioipsl file identifier
-      !---------------------------------------------------------------------
-      !
-      clinfo = '          iom_ioipsl_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
-      ioipslid = iom_file(kiomid)%nfid
-      !
-      ! define dimension variables if it is not already done
-      ! ==========================
-      IF( iom_file(kiomid)%nvars == 0 ) THEN
-         ! define the dimension variables if it is not already done
-         CALL fliodefv( ioipslid,'nav_lon', (/1,2/), v_t=flio_r4   , axis='X',   &
-               &                  long_name="Longitude", units="degrees_east" )
-         CALL fliodefv( ioipslid,'nav_lat', (/1,2/), v_t=flio_r4   , axis='Y',   &
-               &                  long_name="Latitude", units="degrees_north" )
-         CALL fliodefv( ioipslid,'nav_lev', (/3/)  , v_t=flio_i4   , axis='Z',   &
-               &                  long_name="Model levels",units="model_levels")
-         CALL fliodefv( ioipslid,'time_counter', (/4/), v_t=flio_r4, axis='T',   &
-               &                  long_name="Time axis", units='seconds since 0001-01-01 00:00:00' )
-         ! update informations structure related the dimension variable we just added...
-         iom_file(kiomid)%nvars       = 4
-         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /)
-         iom_file(kiomid)%cn_var(1:3) = (/ 'nav_lon', 'nav_lat', 'nav_lev' /)
-         iom_file(kiomid)%cn_var(4)   = 'time_counter'
-         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /)
-         ! trick: defined to 0 to say that dimension variables are defined but not yet written
-         iom_file(kiomid)%dimsz(1, 1) = 0   
-         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done'
-      ENDIF
-
-      ! define the data if it is not already done
-      ! ===============
-      IF( kvid <= 0 ) THEN
-         ! variable definition
-         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0
-         ELSEIF( PRESENT(pv_r1d) ) THEN   ;   idims = 2   ;   idimid(1:idims) = (/    3,4/)
-         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/)
-         ELSEIF( PRESENT(pv_r3d) ) THEN   ;   idims = 4   ;   idimid(1:idims) = (/1,2,3,4/)
-         ENDIF
-         IF( PRESENT(ktype) ) THEN   ! variable external type
-            SELECT CASE (ktype)
-            CASE (jp_r8)  ;   itype = flio_r8
-            CASE (jp_r4)  ;   itype = flio_r4
-            CASE (jp_i4)  ;   itype = flio_i4
-            CASE (jp_i2)  ;   itype = flio_i2
-            CASE (jp_i1)  ;   itype = flio_i1   !   fliocom does not handle i1 type of variable
-            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo)//' unknown variable type' )
-            END SELECT
-         ELSE
-            itype = flio_r8
-         ENDIF
-         IF( PRESENT(pv_r0d) ) THEN   ;   CALL fliodefv (ioipslid, TRIM(cdvar)                 , v_t = itype)
-         ELSE                         ;   CALL fliodefv (ioipslid, TRIM(cdvar), idimid(1:idims), v_t = itype)
-         ENDIF
-         ! update informations structure related the new variable we want to add...
-         idvar                          = iom_file(kiomid)%nvars + 1
-         iom_file(kiomid)%nvars         = idvar
-         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
-         iom_file(kiomid)%nvid(idvar)   = -1   ! netcdf variable id is not available in ioipsl
-         iom_file(kiomid)%scf(idvar)    = 1.
-         iom_file(kiomid)%ofs(idvar)    = 0.
-         iom_file(kiomid)%ndims(idvar)  = idims
-         IF( .NOT. PRESENT(pv_r0d) ) THEN
-            iom_file(kiomid)%luld(idvar) = .TRUE.
-            CALL flioinqf( ioipslid, ln_dim = idimsz )
-            iom_file(kiomid)%dimsz(1:idims-1,idvar) = idimsz(idimid(1:idims-1))
-         ELSE                               
-            iom_file(kiomid)%luld(idvar) = .FALSE.
-         ENDIF
-         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' defined ok'
-      ELSE
-         idvar = kvid
-      ENDIF
-
-      ! time step kwrite : write the variable
-      IF( kt == kwrite ) THEN
-         ! on what kind of domain must the data be written?
-         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN
-            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar)
-            IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN
-               ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej
-            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN
-               ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj
-            ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN
-               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
-            ELSE 
-               CALL ctl_stop( 'iom_ioipsl_rp0123d: should have been an impossible case...' )
-            ENDIF
-
-            ! write dimension variables if it is not already done
-            ! =============
-            ! trick: is defined to 0 => dimension variable are defined but not yet written
-            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN
-               CALL flioputv( ioipslid, 'nav_lon'     , glamt(ix1:ix2, iy1:iy2) )
-               CALL flioputv( ioipslid, 'nav_lat'     , gphit(ix1:ix2, iy1:iy2) )
-               CALL flioputv( ioipslid, 'nav_lev'     , gdept_1d )
-               ! +++ WRONG VALUE: to be improved but not really useful...
-               CALL flioputv( ioipslid, 'time_counter', kt )
-               ! update the values of the variables dimensions size
-               CALL flioinqf( ioipslid, ln_dim = idimsz )
-               iom_file(kiomid)%dimsz(1:2, 1) = idimsz(1:2)
-               iom_file(kiomid)%dimsz(1:2, 2) = idimsz(1:2)
-               iom_file(kiomid)%dimsz(1, 3:4) = (/idimsz(3), 1/)
-               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
-            ENDIF
-         ENDIF
-
-         ! write the data
-         ! =============
-         IF(     PRESENT(pv_r0d) ) THEN   ;   CALL flioputv( ioipslid, cdvar, pv_r0d                      )
-         ELSEIF( PRESENT(pv_r1d) ) THEN   ;   CALL flioputv( ioipslid, cdvar, pv_r1d(                  :) )
-         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   CALL flioputv( ioipslid, cdvar, pv_r2d(ix1:ix2, iy1:iy2   ) )
-         ELSEIF( PRESENT(pv_r3d) ) THEN   ;   CALL flioputv( ioipslid, cdvar, pv_r3d(ix1:ix2, iy1:iy2, :) )
-         ENDIF
-         ! add 1 to the size of the temporal dimension (not really useful...)
-         IF( iom_file(kiomid)%luld(idvar) )   iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar)    &
-               &                            = iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar) + 1
-         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
-      ENDIF
-      !     
-   END SUBROUTINE iom_ioipsl_rp0123d
-
-
-   !!======================================================================
-END MODULE iom_ioipsl
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 6808)
@@ -154,6 +154,7 @@
          CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo)
          IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN
-           CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,   &
-        &                                               name = iom_file(kiomid)%uldname), clinfo)
+           CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,     & 
+        &                                               name = iom_file(kiomid)%uldname,  &
+        &                                               len  = iom_file(kiomid)%lenuld ), clinfo )
          ENDIF
          IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK'
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90	(revision 6807)
+++ 	(revision )
@@ -1,504 +1,0 @@
-MODULE iom_rstdimg
-   !!=====================================================================
-   !!                    ***  MODULE  iom_rstdimg ***
-   !! Input/Output manager :  Library to read input rstdimg files
-   !!====================================================================
-   !! History :  9.0  ! 06 09  (S. Masson) Original code
-   !!--------------------------------------------------------------------
-
-   !!--------------------------------------------------------------------
-   !!   iom_open       : open a file read only
-   !!   iom_close      : close a file or all files opened by iom
-   !!   iom_get        : read a field (interfaced to several routines)
-   !!   iom_gettime    : read the time axis kvid in the file
-   !!   iom_varid      : get the id of a variable in a file
-   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
-   !!--------------------------------------------------------------------
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE dom_oce         ! ocean space and time domain
-   USE lbclnk          ! lateal boundary condition / mpp exchanges
-   USE iom_def         ! iom variables definitions
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC iom_rstdimg_open, iom_rstdimg_close, iom_rstdimg_get, iom_rstdimg_rstput
-
-   INTERFACE iom_rstdimg_get
-      MODULE PROCEDURE iom_rstdimg_g0d, iom_rstdimg_g123d
-   END INTERFACE
-   INTERFACE iom_rstdimg_rstput
-      MODULE PROCEDURE iom_rstdimg_rp0d, iom_rstdimg_rp123d
-   END INTERFACE
-
-   INTEGER, PARAMETER ::   jpvnl          = 32   ! variable name length
-      
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE iom_rstdimg_open( cdname, kiomid, ldwrt, ldok, kdompar )
-      !!---------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  iom_open  ***
-      !!
-      !! ** Purpose :  open an input file read only (return 0 if not found)
-      !!---------------------------------------------------------------------
-      CHARACTER(len=*)       , INTENT(inout)           ::   cdname      ! File name
-      INTEGER                , INTENT(  out)           ::   kiomid      ! iom identifier of the opened file
-      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file?
-      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence 
-      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters: 
-
-      CHARACTER(LEN=100)                      ::   clinfo                     ! info character
-      CHARACTER(LEN=100)                      ::   cltmp                      ! temporary character
-      CHARACTER(LEN=10 )                      ::   clstatus                   ! status of opened file (REPLACE or NEW)
-      INTEGER                                 ::   jv                         ! loop counter
-      INTEGER                                 ::   istop                      ! temporary storage of nstop
-      INTEGER                                 ::   idrst                      ! logical unit of the restart file
-      INTEGER                                 ::   iln                        ! lengths of character
-      INTEGER                                 ::   irecl8                     ! record length
-      INTEGER                                 ::   ios                        ! IO status
-      INTEGER                                 ::   irhd                       ! record of the header infos
-      INTEGER                                 ::   ivnum                      ! number of variables
-      INTEGER                                 ::   ishft                      ! counter shift
-      INTEGER                                 ::   inx, iny, inz              ! x,y,z dimension of the variable
-      INTEGER                                 ::   in0d, in1d, in2d, in3d     ! number of 0/1/2/3D variables
-      INTEGER                                 ::   ipni, ipnj, ipnij, iarea   ! domain decomposition 
-      INTEGER                                 ::   iiglo, ijglo               ! domain global size 
-      INTEGER                                 ::   jl                         ! loop variable
-      LOGICAL                                 ::   llclobber                  ! local definition of ln_clobber
-      CHARACTER(LEN=jpvnl), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d     ! name of 0/1/2/3D variables
-      REAL(wp),             DIMENSION(jpmax_vars) ::   zval0d, zval1d, zval2d, zval3d     ! value of 0d variables or record
-      !                                                                                   ! position for 1/2/3D variables
-      !---------------------------------------------------------------------
-      clinfo = '                    iom_rstdimg_open ~~~  '
-      istop = nstop      ! store the actual value of nstop
-      ios = 0            ! default definition
-      kiomid = 0         ! default definition
-      llclobber = ldwrt .AND. ln_clobber
-      ! get a free unit
-      idrst = get_unit()  ! get a free logical unit for the restart file
-!!$#if defined key_agrif 
-!!$      idrst = Agrif_Get_Unit()      
-!!$#endif 
-      ! Open the file...
-      ! =============
-      IF( ldok .AND. .NOT. llclobber ) THEN      ! Open existing file...
-         ! find the record length
-         OPEN( idrst, FILE = TRIM(cdname), FORM = 'unformatted', ACCESS = 'direct'   &
-            &       , RECL = 8, STATUS = 'old', ACTION = 'read', IOSTAT = ios, ERR = 987 )
-         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8
-         CLOSE( idrst )
-         ! Open the file with the appropriate record length and parameters
-         IF( ldwrt ) THEN  ! ... in readwrite mode
-            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READWRITE mode'
-            OPEN( idrst, FILE = TRIM(cdname), FORM = 'unformatted', ACCESS = 'direct'   &
-               &       , RECL = irecl8, STATUS = 'old', ACTION = 'readwrite', IOSTAT = ios, ERR = 987 )
-         ELSE              ! ... in read mode
-            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
-            OPEN( idrst, FILE = TRIM(cdname), FORM = 'unformatted', ACCESS = 'direct'   &
-               &       , RECL = irecl8, STATUS = 'old', ACTION = 'read'     , IOSTAT = ios, ERR = 987 )
-         ENDIF
-      ELSE                                       ! the file does not exist (or we overwrite it)
-         iln = INDEX( cdname, '.dimg' )
-         IF( ldwrt ) THEN  ! the file should be open in readwrite mode so we create it...
-            irecl8= MAX( kdompar(1,1) * kdompar(2,1) * wp, ( 8*jpnij + 15 ) * 4 )
-            IF( jpnij > 1 ) THEN
-               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea, '.dimg'
-               cdname = TRIM(cltmp)
-            ENDIF
-            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in READWRITE mode'
-            
-            IF( llclobber ) THEN   ;   clstatus = 'REPLACE' 
-            ELSE                   ;   clstatus = 'NEW'
-            ENDIF
-            OPEN( idrst, FILE = TRIM(cdname), FORM = 'UNFORMATTED', ACCESS = 'DIRECT'   &
-               &       , RECL = irecl8, STATUS = TRIM(clstatus), ACTION = 'readwrite', IOSTAT = ios, ERR = 987 )
-         ELSE              ! the file should be open for read mode so it must exist...
-            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
-         ENDIF
-      ENDIF
-      ! Performs checks on the file
-      ! =============
-      IF( ldok .AND. .NOT. llclobber ) THEN      ! old file
-         READ( idrst, REC = 1   , IOSTAT = ios, ERR = 987 )              &
-              &   irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd,   &
-              &   ipni, ipnj, ipnij, iarea, iiglo, ijglo
-         READ( idrst, REC = irhd, IOSTAT = ios, ERR = 987 )                       &
-            &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   &
-            &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d)
-         clinfo = TRIM(clinfo)//' file '//TRIM(cdname)
-         IF( iiglo /= jpiglo       )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in global domain size in i direction' )
-         IF( ijglo /= jpjglo       )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in global domain size in j direction' )
-         IF( ldwrt ) THEN
-            IF( inx   /= kdompar(1,1) )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in local domain size in i direction' )
-            IF( iny   /= kdompar(2,1) )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in local domain size in j direction' )
-         ENDIF
-         IF( inz   /= jpk          )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in domain size in k direction' )
-         IF( ipni  /= jpni         )   CALL ctl_stop( TRIM(clinfo), 'Processor splitting changed along I' )
-         IF( ipnj  /= jpnj         )   CALL ctl_stop( TRIM(clinfo), 'Processor splitting changed along J' )
-         IF( ipnij /= jpnij        )   CALL ctl_stop( TRIM(clinfo), 'Total number of processors changed' )
-         IF( iarea /= narea        )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in area numbering ...' )
-      ENDIF
-      ! fill file informations
-      ! =============
-      IF( istop == nstop ) THEN   ! no error within this routine
-!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1)
-         kiomid = 0
-         DO jl = jpmax_files, 1, -1
-            IF( iom_file(jl)%nfid == 0 )   kiomid = jl
-         ENDDO
-         iom_file(kiomid)%name    = TRIM(cdname)
-         iom_file(kiomid)%nfid    = idrst
-         iom_file(kiomid)%iolib   = jprstdimg
-         iom_file(kiomid)%iduld   = -1
-         IF( ldok ) THEN      ! old file
-            ! read variables informations from the file header
-            IF(  TRIM(clna0d(1)) == 'no0d' )   in0d = 0
-            IF(  TRIM(clna1d(1)) == 'no1d' )   in1d = 0
-            IF(  TRIM(clna2d(1)) == 'no2d' )   in2d = 0
-            IF(  TRIM(clna3d(1)) == 'no3d' )   in3d = 0
-            ivnum = in0d + in1d + in2d + in3d
-            iom_file(kiomid)%nvars            = ivnum
-            iom_file(kiomid)%irec             = 2 + in1d + in2d + inz * in3d
-            iom_file(kiomid)%luld(   1:ivnum) = .FALSE.
-            iom_file(kiomid)%scf(    1:ivnum) = 1.
-            ! scalar variable
-            DO jv = 1, in0d
-               iom_file(kiomid)%cn_var(jv) = TRIM(clna0d(jv))
-               iom_file(kiomid)%nvid(  jv) = 1
-               iom_file(kiomid)%ndims( jv) = 0
-               iom_file(kiomid)%ofs(   jv) = zval0d(jv)   ! warning: trick... we use ofs to store the value
-            END DO
-            ! 1d variable
-            ishft = in0d
-            DO jv = 1, in1d
-               iom_file(kiomid)%cn_var(    ishft + jv) = TRIM(clna1d(jv))
-               iom_file(kiomid)%nvid(      ishft + jv) = zval1d(jv)
-               iom_file(kiomid)%ndims(     ishft + jv) = 1
-               iom_file(kiomid)%dimsz(1  , ishft + jv) = jpk
-               iom_file(kiomid)%ofs(       ishft + jv) = 0.
-            END DO
-            ! 2d variable
-            ishft = in0d + in1d
-            DO jv = 1, in2d
-               iom_file(kiomid)%cn_var(    ishft + jv) = TRIM(clna2d(jv))
-               iom_file(kiomid)%nvid(      ishft + jv) = zval2d(jv)
-               iom_file(kiomid)%ndims(     ishft + jv) = 2
-               iom_file(kiomid)%dimsz(1:2, ishft + jv) = (/ inx, iny /)
-               iom_file(kiomid)%ofs(       ishft + jv) = 0.
-            END DO
-            ! 3d variable
-            ishft = in0d + in1d + in2d 
-            DO jv = 1, in3d
-               iom_file(kiomid)%cn_var(    ishft + jv) = TRIM(clna3d(jv))
-               iom_file(kiomid)%nvid(      ishft + jv) = zval3d(jv)
-               iom_file(kiomid)%ndims(     ishft + jv) = 3
-               iom_file(kiomid)%dimsz(1:3, ishft + jv) = (/ inx, iny, jpk /)
-               iom_file(kiomid)%ofs(       ishft + jv) = 0.
-            END DO
-         ELSE                 ! new file
-            iom_file(kiomid)%nvars = 0
-            iom_file(kiomid)%irec  = 2
-            ! store file informations
-            WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, kdompar(:,1), jpk   ! store domain size
-         ENDIF
-      ENDIF
-987   CONTINUE
-      IF( ios /= 0 ) THEN
-         WRITE(ctmp1,*) '           iostat = ', ios
-         CALL ctl_stop( TRIM(clinfo), '   error in opening file '//TRIM(cdname), ctmp1 )
-      ENDIF
-      !
-   END SUBROUTINE iom_rstdimg_open
-
-
-   SUBROUTINE iom_rstdimg_close( kiomid )
-      !!--------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  iom_rstdimg_close  ***
-      !!
-      !! ** Purpose : close an input file
-      !!--------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kiomid   ! iom identifier of the file to be closed
-      !
-      CHARACTER(LEN=100)                      ::   clinfo                     ! info character
-      INTEGER                                 ::   jv                         ! loop counter
-      INTEGER                                 ::   irecl8                     ! record length
-      INTEGER                                 ::   ios                        ! IO status
-      INTEGER                                 ::   irhd                       ! record of the header infos
-      INTEGER                                 ::   ivnum                      ! number of variables
-      INTEGER                                 ::   idrst                      ! file logical unit
-      INTEGER                                 ::   inx, iny, inz              ! x,y,z dimension of the variable
-      INTEGER                                 ::   in0d, in1d, in2d, in3d     ! number of 0/1/2/3D variables
-      CHARACTER(LEN=jpvnl), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d    ! name of 0/1/2/3D variables
-      REAL(wp),          DIMENSION(jpmax_vars) ::   zval0d, zval1d, zval2d, zval3d    ! value of 0d variables or record
-      !                                                                               ! position for 1/2/3D variables
-      !---------------------------------------------------------------------
-      !
-      clinfo = '                    iom_rstdimg_close ~~~  '
-      idrst = iom_file(kiomid)%nfid   ! get back the logical unit of the restart file
-      ! test if we can write in the file (test with INQUIRE gives alsways YES even with read only files...)
-      READ(  idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz   
-      WRITE( idrst, REC = 1, IOSTAT = ios            ) irecl8, inx, iny, inz   
-      ! We can write in the file => we update its header before closing
-      IF( ios == 0 ) THEN
-         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz   ! get back domain size
-         irhd = iom_file(kiomid)%irec
-         ivnum = iom_file(kiomid)%nvars
-         in0d = 0   ;   in1d = 0   ;   in2d = 0   ;   in3d = 0
-         DO jv = 1, ivnum   ! loop on each variable to get its name and value/record position
-            SELECT CASE (iom_file(kiomid)%ndims(jv))
-            CASE (0)   ! scalar variable
-               in0d = in0d + 1
-               clna0d(in0d) = TRIM(iom_file(kiomid)%cn_var(jv))
-               zval0d(in0d) = iom_file(kiomid)%ofs(jv)   ! warning: trick... we use ofs to store the value
-            CASE (1)   ! 1d variable
-               in1d = in1d + 1
-               clna1d(in1d) = TRIM(iom_file(kiomid)%cn_var(jv))
-               zval1d(in1d) = iom_file(kiomid)%nvid(jv)
-            CASE (2)   ! 2d variable
-               in2d = in2d + 1
-               clna2d(in2d) = TRIM(iom_file(kiomid)%cn_var(jv))
-               zval2d(in2d) = iom_file(kiomid)%nvid(jv)
-            CASE (3)   ! 3d variable
-               in3d = in3d + 1
-               clna3d(in3d) = TRIM(iom_file(kiomid)%cn_var(jv))
-               zval3d(in3d) = iom_file(kiomid)%nvid(jv)
-            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo), 'Should not ne there...' )
-            END SELECT
-         END DO
-         ! force to have at least 1 variable in each list (not necessary (?), but safer...)
-         IF( in0d == 0 ) THEN   ;   in0d = 1   ;   clna0d(1) = 'no0d'   ;   zval0d(1) = -1.   ;   ENDIF
-         IF( in1d == 0 ) THEN   ;   in1d = 1   ;   clna1d(1) = 'no1d'   ;   zval1d(1) = -1.   ;   ENDIF
-         IF( in2d == 0 ) THEN   ;   in2d = 1   ;   clna2d(1) = 'no2d'   ;   zval2d(1) = -1.   ;   ENDIF
-         IF( in3d == 0 ) THEN   ;   in3d = 1   ;   clna3d(1) = 'no3d'   ;   zval3d(1) = -1.   ;   ENDIF
-         ! update the file header before closing it
-         WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 )              &
-            &   irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd,   &
-            &   jpni, jpnj, jpnij, narea, jpiglo, jpjglo,              &
-            &   nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
-         IF( (ivnum * (jpvnl + wp)) > irecl8 ) THEN 
-            CALL ctl_stop( TRIM(clinfo),   &
-                 &   'Last record size is too big... You could reduce the value of jpvnl' )
-         ELSE 
-            WRITE( idrst, REC = irhd, IOSTAT = ios, ERR = 987 )                        &
-                 &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   &
-                 &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d)
-         ENDIF
-      ELSE
-         ios = 0   ! we cannot write in the file
-      ENDIF
-      !
-      CLOSE( idrst, IOSTAT = ios, ERR = 987 )
-987   CONTINUE
-      IF( ios /= 0 ) THEN
-         WRITE(ctmp1,*) '           iostat = ', ios
-         CALL ctl_stop( TRIM(clinfo),   &
-            &   '   error when updating the header of '//TRIM(iom_file(kiomid)%name), ctmp1 )
-      ENDIF
-      !    
-   END SUBROUTINE iom_rstdimg_close
-
-
-   SUBROUTINE iom_rstdimg_g0d( kiomid, kvid, pvar )
-      !!-----------------------------------------------------------------------
-      !!                  ***  ROUTINE  iom_rstdimg_g0d  ***
-      !!
-      !! ** Purpose : read a scalar with RSTDIMG
-      !!-----------------------------------------------------------------------
-      INTEGER,  INTENT(in   ) ::   kiomid    ! Identifier of the file
-      INTEGER,  INTENT(in   ) ::   kvid      ! variable id
-      REAL(wp), INTENT(  out) ::   pvar      ! read field
-      !---------------------------------------------------------------------
-      !
-      pvar = iom_file(kiomid)%ofs(kvid)   ! warning: trick... we use ofs to store the value
-      !
-   END SUBROUTINE iom_rstdimg_g0d
-
-
-   SUBROUTINE iom_rstdimg_rp0d( kiomid, cdvar, kvid, pv_r0d )
-      !!--------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  iom_rstdimg_rstput  ***
-      !!
-      !! ** Purpose : write a scalar with RSTDIMG
-      !!--------------------------------------------------------------------
-      INTEGER                   , INTENT(in) ::   kiomid   ! Identifier of the file 
-      CHARACTER(len=*)          , INTENT(in) ::   cdvar    ! time axis name
-      INTEGER                   , INTENT(in) ::   kvid     ! variable id
-      REAL(wp)                  , INTENT(in) ::   pv_r0d   ! written 0d field
-      !
-      CHARACTER(LEN=100) ::   clinfo     ! info character
-      INTEGER            ::   idvar      ! variable id
-      !---------------------------------------------------------------------
-      !  
-      clinfo = '                    iom_rstdimg_rp0d ~~~  '
-      IF( kvid <= 0 ) THEN   !   new variable
-         idvar = iom_file(kiomid)%nvars + 1
-      ELSE                   !   the variable already exists in the file
-         idvar = kvid
-      ENDIF
-      IF( idvar <= jpmax_vars ) THEN
-         iom_file(kiomid)%nvars = idvar
-         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
-         iom_file(kiomid)%nvid(   idvar) = 1   ! useless, Od variables a strored in record 1
-         iom_file(kiomid)%ndims(  idvar) = 0
-         iom_file(kiomid)%luld(   idvar) = .FALSE.
-         iom_file(kiomid)%scf(    idvar) = 1.
-         iom_file(kiomid)%ofs(    idvar) = pv_r0d   ! warning: trick... we use ofs to store the value
-      ELSE
-         CALL ctl_stop( TRIM(clinfo), 'increase the value of jpmax_vars' )
-      ENDIF
-   END SUBROUTINE iom_rstdimg_rp0d
-
-
-   SUBROUTINE iom_rstdimg_g123d( kiomid, kdom  , kvid, kx1, kx2, ky1, ky2,   &
-         &                       pv_r1d, pv_r2d, pv_r3d )
-      !!-----------------------------------------------------------------------
-      !!                  ***  ROUTINE  iom_rstdimg_g123d  ***
-      !!
-      !! ** Purpose : read a 1D/2D/3D variable with RSTDIMG
-      !!
-      !! ** Method : read ONE record at each CALL
-      !!-----------------------------------------------------------------------
-      INTEGER                    , INTENT(in   )           ::   kiomid     ! iom identifier of the file
-      INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read
-      INTEGER                    , INTENT(in   )           ::   kvid       ! variable id
-      INTEGER ,                    INTENT(inout)           ::   kx1, kx2, ky1, ky2   ! subdomain indexes
-      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case)
-      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case)
-      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case)
-
-      CHARACTER(LEN=100) ::   clinfo               ! info character
-      INTEGER            ::   ios                  ! IO status
-      INTEGER            ::   jk                   ! loop counter
-      INTEGER            ::   idrst                ! logical unit of the restart file
-      !---------------------------------------------------------------------
-      clinfo = '                    iom_rstdimg_g123d ~~~  '
-      !
-      IF( kdom == jpdom_data .OR. kdom == jpdom_global ) THEN
-         CALL ctl_stop( TRIM(clinfo), TRIM(iom_file(kiomid)%cn_var(kvid))//': case not coded for rstdimg files' )
-      ELSE
-      !
-         idrst = iom_file(kiomid)%nfid   ! get back the logical unit of the restart file
-         ! modify the subdomain indexes because we cannot directly extract the appropriate subdomaine
-         IF(     kdom == jpdom_local_full    ) THEN   ;   kx1 = 1   ;   kx2 = jpi    ;   ky1 = 1
-         ELSEIF( kdom == jpdom_local_noextra ) THEN   ;   kx1 = 1   ;   kx2 = nlci   ;   ky1 = 1
-         ENDIF
-         !
-         IF(     PRESENT(pv_r1d) ) THEN   ! read 1D variables
-            READ(    idrst, REC = iom_file(kiomid)%nvid(kvid)         , IOSTAT = ios, ERR = 987 )   pv_r1d(:)
-         ELSEIF( PRESENT(pv_r2d) ) THEN   ! read 2D variables
-            READ(    idrst, REC = iom_file(kiomid)%nvid(kvid)         , IOSTAT = ios, ERR = 987 )   pv_r2d(kx1:kx2, ky1:ky2    )
-         ELSEIF( PRESENT(pv_r3d) ) THEN   ! read 3D variables
-            DO jk = 1, iom_file(kiomid)%dimsz(3,kvid)   ! do loop on each level
-               READ( idrst, REC = iom_file(kiomid)%nvid(kvid) + jk - 1, IOSTAT = ios, ERR = 987 )   pv_r3d(kx1:kx2, ky1:ky2, jk)
-            END DO
-         ENDIF
-987      CONTINUE
-         IF( ios /= 0 ) THEN
-            WRITE(ctmp1,*) '           iostat = ', ios
-            CALL ctl_stop( TRIM(clinfo), '   IO error with file '//TRIM(iom_file(kiomid)%name), ctmp1 )
-         ENDIF
-      ENDIF
-      !
-   END SUBROUTINE iom_rstdimg_g123d
-
-
-   SUBROUTINE iom_rstdimg_rp123d( kiomid, cdvar, kvid, pv_r1d, pv_r2d, pv_r3d )
-      !!--------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  iom_rstdimg_rstput  ***
-      !!
-      !! ** Purpose : write a 2D/3D variable with RSTDIMG
-      !!--------------------------------------------------------------------
-      INTEGER                         , INTENT(in)           ::   kiomid   ! Identifier of the file 
-      CHARACTER(len=*)                , INTENT(in)           ::   cdvar    ! time axis name
-      INTEGER                         , INTENT(in)           ::   kvid     ! variable id
-      REAL(wp), DIMENSION(          :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
-      REAL(wp), DIMENSION(:  ,:      ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
-      REAL(wp), DIMENSION(:  ,:  ,:  ), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
-      !
-      CHARACTER(LEN=100)    ::   clinfo               ! info character
-      INTEGER               ::   irecl8               ! reacord length
-      INTEGER               ::   ios                  ! IO status
-      INTEGER               ::   idrst                ! reacord length
-      INTEGER               ::   inx, iny, inz        ! x,y,z dimension of the variable
-      INTEGER               ::   idvar                ! variable id
-      INTEGER               ::   istop                ! temporary storage of nstop
-      INTEGER               ::   irec                 ! record number
-      INTEGER               ::   ix1, ix2, iy1, iy2   ! subdomain indexes
-      INTEGER               ::   jk                   ! loop counter
-      !---------------------------------------------------------------------
-      !
-      clinfo = '          iom_rstdimg_rp123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
-      istop = nstop                   ! store the actual value of nstop
-      irec = iom_file(kiomid)%irec    ! get back the record number of the variable
-      idrst = iom_file(kiomid)%nfid   ! get back the logical unit of the restart file
-      IF( kvid <= 0 ) THEN   !   new variable
-         idvar = iom_file(kiomid)%nvars + 1
-      ELSE                   !   the variable already exists in the file
-         idvar = kvid
-      ENDIF
-      IF( idvar > jpmax_vars )   CALL ctl_stop( TRIM(clinfo), 'increase the value of jpmax_vars' )
-      IF( .NOT. PRESENT(pv_r1d) ) THEN
-         ! find which part of data must be written
-         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz
-         IF(     inx == (nlei - nldi + 1) .AND. iny == (nlej - nldj + 1) ) THEN
-            ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej
-         ELSEIF( inx == nlci              .AND. iny == nlcj              ) THEN
-            ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj
-         ELSEIF( inx == jpi               .AND. iny == jpj               ) THEN
-            ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
-         ELSE 
-            CALL ctl_stop( clinfo, 'should have been an impossible case...' )
-         ENDIF
-      ENDIF
-      IF( istop == nstop ) THEN
-         ! write the data
-         IF(     PRESENT(pv_r1d) ) THEN   ! 1D variable
-            WRITE( idrst, REC = irec            , IOSTAT = ios, ERR = 987 ) pv_r1d(:)
-         ELSEIF( PRESENT(pv_r2d) ) THEN   ! 2D variable
-            WRITE( idrst, REC = irec            , IOSTAT = ios, ERR = 987 ) pv_r2d(ix1:ix2, iy1:iy2    )
-         ELSEIF( PRESENT(pv_r3d) ) THEN   ! 3D variable
-            DO jk = 1, jpk   ! do loop on each level
-               WRITE( idrst, REC = irec + jk - 1, IOSTAT = ios, ERR = 987 ) pv_r3d(ix1:ix2, iy1:iy2, jk)
-            END DO
-         ENDIF
-         ! fill the file informations
-         iom_file(kiomid)%nvars = idvar
-         IF(     PRESENT(pv_r1d) ) THEN
-            iom_file(kiomid)%irec              = irec + 1
-            iom_file(kiomid)%ndims(     idvar) = 1
-            iom_file(kiomid)%dimsz(1  , idvar) = inz
-         ELSEIF( PRESENT(pv_r2d) ) THEN
-            iom_file(kiomid)%irec              = irec + 1
-            iom_file(kiomid)%ndims(     idvar) = 2
-            iom_file(kiomid)%dimsz(1:2, idvar) = (/ inx, iny /)
-         ELSEIF( PRESENT(pv_r3d) ) THEN
-            iom_file(kiomid)%irec              = irec + inz
-            iom_file(kiomid)%ndims(     idvar) = 3
-            iom_file(kiomid)%dimsz(1:3, idvar) = (/ inx, iny, inz /)
-         ENDIF
-         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
-         iom_file(kiomid)%nvid(  idvar) = irec
-         iom_file(kiomid)%luld(  idvar) = .FALSE.
-         iom_file(kiomid)%scf(   idvar) = 1.
-         iom_file(kiomid)%ofs(   idvar) = 0.
-      ENDIF
-987   CONTINUE
-      IF( ios /= 0 ) THEN
-         WRITE(ctmp1,*) '           iostat = ', ios
-         CALL ctl_stop( TRIM(clinfo), '   IO error with file '//TRIM(iom_file(kiomid)%name), ctmp1 )
-      ELSE
-         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
-      ENDIF
-      !     
-   END SUBROUTINE iom_rstdimg_rp123d
-
-
-   !!======================================================================
-END MODULE iom_rstdimg
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 6808)
@@ -9,4 +9,6 @@
    !!            3.3  !  2010-04  (M. Leclair, G. Madec)  modified LF-RA
    !!            - -  !  2010-10  (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D)
+   !!            3.7  !  2014-01  (G. Madec) suppression of curl and hdiv from the restart
+   !!             -   !  2014-12  (G. Madec) remove KPP scheme
    !!----------------------------------------------------------------------
 
@@ -18,11 +20,13 @@
    USE oce             ! ocean dynamics and tracers 
    USE dom_oce         ! ocean space and time domain
+   USE sbc_ice         ! only lk_lim3 
    USE phycst          ! physical constants
+   USE eosbn2          ! equation of state            (eos bn2 routine)
+   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables
+   !
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
-   USE eosbn2          ! equation of state            (eos bn2 routine)
-   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables
-   USE divcur          ! hor. divergence and curl      (div & cur routines)
-
+   USE diurnal_bulk
+   
    IMPLICIT NONE
    PRIVATE
@@ -34,5 +38,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -92,6 +95,4 @@
                WRITE(numout,*)
                SELECT CASE ( jprstlib )
-               CASE ( jprstdimg )   ;   WRITE(numout,*)                            &
-                   '             open ocean restart binary file: ',TRIM(clpath)//clname
                CASE DEFAULT         ;   WRITE(numout,*)                            &
                    '             open ocean restart NetCDF file: ',TRIM(clpath)//clname
@@ -123,13 +124,11 @@
       !!----------------------------------------------------------------------
 
-                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       )   ! dynamics time step
-                     CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) )   ! surface tracer time step
-
+                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       )   ! dynamics and tracer time step
+
+      IF ( .NOT. ln_diurnal_only ) THEN
                      CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        )     ! before fields
                      CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        )
                      CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem) )
                      CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal) )
-                     CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb      )
-                     CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     )
                      CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      )
                      !
@@ -138,11 +137,22 @@
                      CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem) )
                      CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal) )
-                     CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn      )
-                     CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn     )
                      CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn      )
                      CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      )
-#if defined key_zdfkpp
-                     CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       )
-#endif
+
+                  ! extra variable needed for the ice sheet coupling
+                  IF ( ln_iscpl ) THEN 
+                     CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask     ) ! need to extrapolate T/S
+                     CALL iom_rstput( kt, nitrst, numrow, 'umask'  , umask     ) ! need to correct barotropic velocity
+                     CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask     ) ! need to correct barotropic velocity
+                     CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask    ) ! need to correct barotropic velocity
+                     CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) )   ! need to compute temperature correction
+                     CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:) )   ! need to compute bt conservation
+                     CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:) )   ! need to compute bt conservation
+                     CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:) ) ! need to compute extrapolation if vvl
+                  END IF
+      ENDIF
+      
+      IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst    )  
+
       IF( kt == nitrst ) THEN
          CALL iom_close( numrow )     ! close the restart file (only at last time step)
@@ -179,5 +189,4 @@
             SELECT CASE ( jprstlib )
             CASE ( jpnf90    )   ;   WRITE(numout,*) 'rst_read : read oce NetCDF restart file'
-            CASE ( jprstdimg )   ;   WRITE(numout,*) 'rst_read : read oce binary restart file'
             END SELECT
             IF ( snc4set%luse )      WRITE(numout,*) 'rst_read : configured with NetCDF4 support'
@@ -187,13 +196,8 @@
          clpath = TRIM(cn_ocerst_indir)
          IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
-         IF ( jprstlib == jprstdimg ) THEN
-           ! eventually read netcdf file (monobloc)  for restarting on different number of processors
-           ! if {cn_ocerst_in}.nc exists, then set jlibalt to jpnf90
-           INQUIRE( FILE = TRIM(cn_ocerst_indir)//'/'//TRIM(cn_ocerst_in)//'.nc', EXIST = llok )
-           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
-         ENDIF
          CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt )
       ENDIF
    END SUBROUTINE rst_read_open
+
 
    SUBROUTINE rst_read
@@ -205,7 +209,6 @@
       !! ** Method  :   Read in restart.nc file fields which are necessary for restart
       !!----------------------------------------------------------------------
-      REAL(wp) ::   zrdt, zrdttra1
+      REAL(wp) ::   zrdt
       INTEGER  ::   jk
-      LOGICAL  ::   llok
       !!----------------------------------------------------------------------
 
@@ -217,9 +220,15 @@
          IF( zrdt /= rdt )   neuler = 0
       ENDIF
-      IF( iom_varid( numror, 'rdttra1', ldstop = .FALSE. ) > 0 )   THEN
-         CALL iom_get( numror, 'rdttra1', zrdttra1 )
-         IF( zrdttra1 /= rdttra(1) )   neuler = 0
-      ENDIF
-      ! 
+
+      ! Diurnal DSST 
+      IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst  ) 
+      IF ( ln_diurnal_only ) THEN 
+         IF(lwp) WRITE( numout, * ) &
+         &   "rst_read:- ln_diurnal_only set, setting rhop=rau0" 
+         rhop = rau0
+         CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,1,jp_tem) ) 
+         RETURN 
+      ENDIF  
+      
       IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN
          CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields
@@ -227,6 +236,4 @@
          CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) )
          CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) )
-         CALL iom_get( numror, jpdom_autoglo, 'rotb'   , rotb    )
-         CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   )
          CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    )
       ELSE
@@ -239,22 +246,9 @@
       CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) )
       CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
-      IF( iom_varid( numror, 'rotn', ldstop = .FALSE. ) > 0 ) THEN
-         CALL iom_get( numror, jpdom_autoglo, 'rotn'   , rotn    )
-         CALL iom_get( numror, jpdom_autoglo, 'hdivn'  , hdivn   )
-      ELSE
-         CALL div_cur( 0 )                              ! Horizontal divergence & Relative vorticity
-      ENDIF
       IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN
          CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density
       ELSE
-         CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )   
-      ENDIF
-#if defined key_zdfkpp
-      IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN
-         CALL iom_get( numror, jpdom_autoglo, 'rhd'    , rhd     )   ! now    in situ density anomaly
-      ELSE
-         CALL eos( tsn, rhd, fsdept_n(:,:,:) )   ! compute rhd
-      ENDIF
-#endif
+         CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) )   
+      ENDIF
       !
       IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
@@ -262,14 +256,12 @@
          ub   (:,:,:)   = un   (:,:,:)
          vb   (:,:,:)   = vn   (:,:,:)
-         rotb (:,:,:)   = rotn (:,:,:)
-         hdivb(:,:,:)   = hdivn(:,:,:)
          sshb (:,:)     = sshn (:,:)
-
-         IF( lk_vvl ) THEN
+         !
+         IF( .NOT.ln_linssh ) THEN
             DO jk = 1, jpk
-               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
+               e3t_b(:,:,jk) = e3t_n(:,:,jk)
             END DO
          ENDIF
-
+         !
       ENDIF
       !
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90	(revision 6807)
+++ 	(revision )
@@ -1,732 +1,0 @@
-MODULE cla
-   !!======================================================================
-   !!                    ***  MODULE  cla  ***
-   !! Cross Land Advection : specific update of the horizontal divergence,
-   !!                        tracer trends and after velocity
-   !!
-   !!                 ---   Specific to ORCA_R2   ---
-   !!
-   !!======================================================================
-   !! History :  1.0  ! 2002-11 (A. Bozec)  Original code
-   !!            3.2  ! 2009-07 (G. Madec)  merge cla, cla_div, tra_cla, cla_dynspg
-   !!                 !                     and correct a mpp bug reported by A.R. Porter
-   !!----------------------------------------------------------------------
-   !!   cla_div           : update of horizontal divergence at cla straits
-   !!   tra_cla           : update of tracers at cla straits
-   !!   cla_dynspg        : update of after horizontal velocities at cla straits
-   !!   cla_init          : initialisation - control check
-   !!   cla_bab_el_mandeb : cross land advection for Bab-el-mandeb strait
-   !!   cla_gibraltar     : cross land advection for Gibraltar strait
-   !!   cla_hormuz        : cross land advection for Hormuz strait
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers
-   USE dom_oce        ! ocean space and time domain
-   USE sbc_oce        ! surface boundary condition: ocean
-   USE dynspg_oce     ! ocean dynamics: surface pressure gradient variables
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! distributed memory computing library
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp        ! MPP library
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   cla_init     ! routine called by opa.F90
-   PUBLIC   cla_div      ! routine called by divcur.F90
-   PUBLIC   cla_traadv   ! routine called by traadv.F90
-   PUBLIC   cla_dynspg   ! routine called by dynspg_flt.F90
-
-   INTEGER  ::   nbab, ngib, nhor   ! presence or not of required grid-point on local domain
-   !                                ! for Bab-el-Mandeb, Gibraltar, and Hormuz straits
-   
-   !                                           !   fixed part  !  time evolving    !!! profile of hdiv for some straits
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_139_101, hdiv_139_101_kt    ! Gibraltar     (i,j)=(172,101)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_139_102                     ! Gibraltar     (i,j)=(139,102)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_141_102, hdiv_141_102_kt    ! Gibraltar     (i,j)=(141,102)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_161_88 , hdiv_161_88_kt     ! Bab-el-Mandeb (i,j)=(161,88)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_161_87                      ! Bab-el-Mandeb (i,j)=(161,87)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_160_89 , hdiv_160_89_kt     ! Bab-el-Mandeb (i,j)=(160,89)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_172_94                      ! Hormuz        (i,j)=(172, 94)
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   t_171_94_hor, s_171_94_hor       ! Temperature, salinity in Hormuz strait
-   
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE cla_div( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE div_cla  ***
-      !!
-      !! ** Purpose :   update the horizontal divergence of the velocity field
-      !!              at some straits ( Gibraltar, Bab el Mandeb and Hormuz ).
-      !!
-      !! ** Method  : - first time-step: initialisation of cla
-      !!              - all   time-step: using imposed transport at each strait, 
-      !!              the now horizontal divergence is updated
-      !!
-      !! ** Action  :   phdivn   updted now horizontal divergence at cla straits
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !!----------------------------------------------------------------------
-      !     
-      IF( kt == nit000 ) THEN
-         !
-         CALL cla_init                                        ! control check 
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'div_cla : cross land advection on hdiv '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~'
-         !
-         IF( nbab == 1 )   CALL cla_bab_el_mandeb('ini')    ! Bab el Mandeb ( Red Sea - Indian ocean )
-         IF( ngib == 1 )   CALL cla_gibraltar    ('ini')    ! Gibraltar strait (Med Sea - Atlantic ocean)
-         IF( nhor == 1 )   CALL cla_hormuz       ('ini')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
-         !
-      ENDIF                           
-      !
-      IF( nbab == 1    )   CALL cla_bab_el_mandeb('div')    ! Bab el Mandeb ( Red Sea - Indian ocean )
-      IF( ngib == 1    )   CALL cla_gibraltar    ('div')    ! Gibraltar strait (Med Sea - Atlantic ocean)
-      IF( nhor == 1    )   CALL cla_hormuz       ('div')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
-      !
-!!gm  lbc useless here, no?
-!!gm      CALL lbc_lnk( hdivn, 'T', 1. )                    ! Lateral boundary conditions on hdivn
-      !
-   END SUBROUTINE cla_div
-   
-   
-   SUBROUTINE cla_traadv( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE tra_cla  ***
-      !!                   
-      !! ** Purpose :   Update the now trend due to the advection of tracers
-      !!      and add it to the general trend of passive tracer equations
-      !!      at some straits ( Bab el Mandeb, Gibraltar, Hormuz ).
-      !!
-      !! ** Method  :   using both imposed transport at each strait and T & S
-      !!              budget, the now tracer trends is updated
-      !!
-      !! ** Action  :   (ta,sa)   updated now tracer trends at cla straits
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == nit000 ) THEN 
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_cla : cross land advection on tracers '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~'
-      ENDIF
-      !
-      IF( nbab == 1    )   CALL cla_bab_el_mandeb('tra')      ! Bab el Mandeb strait
-      IF( ngib == 1    )   CALL cla_gibraltar    ('tra')      ! Gibraltar strait
-      IF( nhor == 1    )   CALL cla_hormuz       ('tra')      ! Hormuz Strait ( Persian Gulf)
-      !
-   END SUBROUTINE cla_traadv
-
-   
-   SUBROUTINE cla_dynspg( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE cla_dynspg  ***
-      !!                   
-      !! ** Purpose :   Update the after velocity at some straits 
-      !!              (Bab el Mandeb, Gibraltar, Hormuz).
-      !!
-      !! ** Method  :   required to compute the filtered surface pressure gradient 
-      !!
-      !! ** Action  :   (ua,va)   after velocity at the cla straits
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == nit000 ) THEN 
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'cla_dynspg : cross land advection on (ua,va) '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-      ENDIF
-      !
-      IF( nbab == 1    )   CALL cla_bab_el_mandeb('spg')      ! Bab el Mandeb strait
-      IF( ngib == 1    )   CALL cla_gibraltar    ('spg')      ! Gibraltar strait
-      IF( nhor == 1    )   CALL cla_hormuz       ('spg')      ! Hormuz Strait ( Persian Gulf)
-      !
-!!gm lbc is needed here, not?
-!!gm      CALL lbc_lnk( hdivn, 'U', -1. )   ;   CALL lbc_lnk( hdivn, 'V', -1. )      ! Lateral boundary conditions 
-      !
-   END SUBROUTINE cla_dynspg
-
-
-   SUBROUTINE cla_init
-      !! -------------------------------------------------------------------
-      !!                   ***  ROUTINE cla_init  ***
-      !!           
-      !! ** Purpose :   control check for mpp computation  
-      !!
-      !! ** Method  : - All the strait grid-points must be inside one of the 
-      !!              local domain interior for the cla advection to work
-      !!              properly in mpp (i.e. inside (2:jpim1,2:jpjm1) ).
-      !!              Define the corresponding indicators (nbab, ngib, nhor)
-      !!              - The profiles of cross-land fluxes are currently hard
-      !!              coded for L31 levels. Stop if jpk/=31
-      !!
-      !! ** Action  :   nbab, ngib, nhor   strait inside the local domain or not
-      !!---------------------------------------------------------------------
-      REAL(wp) ::   ztemp   ! local scalar
-      INTEGER  ::   ierr    ! local integer
-      !!---------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'cla_init : cross land advection initialisation '
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
-      !
-      !                           ! Allocate arrays for this module
-      ALLOCATE( hdiv_139_101(jpk) , hdiv_139_101_kt(jpk) ,     &    ! Gibraltar
-         &      hdiv_139_102(jpk) ,                            &
-         &      hdiv_141_102(jpk) , hdiv_141_102_kt(jpk) ,     &
-         &      hdiv_161_88 (jpk) , hdiv_161_88_kt (jpk) ,     &    ! Bab-el-Mandeb
-         &      hdiv_161_87 (jpk) ,                            &                     
-         &      hdiv_160_89 (jpk) , hdiv_160_89_kt (jpk) ,     &     ! Hormuz
-         &      hdiv_172_94 (jpk) ,                            &
-         &      t_171_94_hor(jpk) , s_171_94_hor   (jpk) , STAT=ierr )
-      IF( lk_mpp    )   CALL mpp_sum( ierr )
-      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'cla_init: unable to allocate arrays' )
-      !
-      IF( .NOT.lk_dynspg_flt )   CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' )
-      !
-      IF( lk_vvl             )   CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' )
-      !
-      IF( jpk /= 31          )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' )
-      !
-      !                                        _|_______|_______|_
-      !                                     89  |       |///////|  
-      !                                        _|_______|_______|_
-      ! ------------------------ !          88  |///////|       | 
-      !   Bab el Mandeb strait   !             _|_______|_______|_
-      ! ------------------------ !          87  |///////|       | 
-      !                                        _|_______|_______|_
-      !                                         |  160  |  161  |  
-      !
-      ! The 6 Bab el Mandeb grid-points must be inside one of the interior of the
-      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
-      nbab = 0
-      IF(  ( 1 <= mj0( 88) .AND. mj1( 89) <= jpj ) .AND.    &  !* (161,89), (161,88) and (161,88) on the local pocessor
-         & ( 1 <= mi0(160) .AND. mi1(161) <= jpi )       )    nbab = 1 
-      !
-      ! test if there is no local domain that includes all required grid-points
-      ztemp = REAL( nbab )
-      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
-      IF( ztemp == 0 ) THEN                     ! Only 2 points in each direction, this should never be a problem
-         CALL ctl_stop( ' cross land advection at Bab-el_Mandeb does not work with your processor cutting: change it' )
-      ENDIF
-      !                                        ___________________________
-      ! ------------------------ !         102  |       |///////|       |
-      !     Gibraltar strait     !             _|_______|_______|_______|_
-      ! ------------------------ !         101  |       |///////|       |
-      !                                        _|_______|_______|_______|_ 
-      !                                         |  139  |  140  |  141  |
-      !
-      ! The 6 Gibraltar grid-points must be inside one of the interior of the
-      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
-      ngib = 0
-      IF(  ( 2 <= mj0(101) .AND. mj1(102) <= jpjm1 ) .AND.    &  !* (139:141,101:102) on the local pocessor
-         & ( 2 <= mi0(139) .AND. mi1(141) <= jpim1 )       )    ngib = 1 
-      !
-      ! test if there is no local domain that includes all required grid-points
-      ztemp = REAL( ngib )
-      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
-      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
-           CALL ctl_stop( ' cross land advection at Gibraltar does not work with your processor cutting: change it' )
-      ENDIF
-      !                                        _______________
-      ! ------------------------ !          94  |/////|     | 
-      !       Hormuz strait      !             _|_____|_____|_
-      ! ------------------------ !                171   172     
-      !           
-      ! The 2 Hormuz grid-points must be inside one of the interior of the
-      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
-      nhor = 0
-      IF(    2 <= mj0( 94) .AND. mj1( 94) <= jpjm1  .AND.  & 
-         &   2 <= mi0(171) .AND. mi1(172) <= jpim1         )   nhor = 1 
-      !
-      ! test if there is no local domain that includes all required grid-points
-      ztemp = REAL( nhor )
-      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
-      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
-           CALL ctl_stop( ' cross land advection at Hormuz does not work with your processor cutting: change it' )
-      ENDIF
-      !
-   END SUBROUTINE cla_init
-
-
-   SUBROUTINE cla_bab_el_mandeb( cd_td )
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE cla_bab_el_mandeb  ***
-      !!       
-      !! ** Purpose :   update the now horizontal divergence, the tracer tendancy
-      !!              and the after velocity in vicinity of Bab el Mandeb ( Red Sea - Indian ocean).
-      !!
-      !! ** Method  :   compute the exchanges at each side of the strait :
-      !!
-      !!       surf. zio_flow
-      !! (+ balance of emp) /\  |\\\\\\\\\\\|
-      !!                    ||  |\\\\\\\\\\\|  
-      !!    deep zio_flow   ||  |\\\\\\\\\\\|  
-      !!            |  ||   ||  |\\\\\\\\\\\|  
-      !!        89  |  ||   ||  |\\\\\\\\\\\|  
-      !!            |__\/_v_||__|____________ 
-      !!            !\\\\\\\\\\\|          surf. zio_flow
-      !!            |\\\\\\\\\\\|<===    (+ balance of emp)
-      !!            |\\\\\\\\\\\u
-      !!        88  |\\\\\\\\\\\|<---      deep  zrecirc (upper+deep at 2 different levels)
-      !!            |___________|__________   
-      !!            !\\\\\\\\\\\|         
-      !!            |\\\\\\\\\\\| ---\     deep  zrecirc (upper+deep) 
-      !!        87  !\\\\\\\\\\\u ===/   + deep  zio_flow   (all at the same level)
-      !!            !\\\\\\\\\\\|  
-      !!            !___________|__________ 
-      !!                160         161
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
-      !                                         ! ='tra' update the tracers
-      !                                         ! ='spg' update after velocity
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zemp_red     ! temporary scalar
-      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
-      !!---------------------------------------------------------------------
-      !
-      SELECT CASE( cd_td ) 
-      !                     ! ---------------- !
-      CASE( 'ini' )         !  initialisation  ! 
-         !                  ! ---------------- ! 
-         !                                   
-         zio_flow    = 0.4e6                       ! imposed in/out flow
-         zrecirc_upp = 0.2e6                       ! imposed upper recirculation water
-         zrecirc_bot = 0.5e6                       ! imposed bottom  recirculation water
-
-         hdiv_161_88(:) = 0.e0                     ! (161,88) Gulf of Aden side, north point
-         hdiv_161_87(:) = 0.e0                     ! (161,87) Gulf of Aden side, south point
-         hdiv_160_89(:) = 0.e0                     ! (160,89) Red sea side
-
-         DO jj = mj0(88), mj1(88)              !** profile of hdiv at (161,88)   (Gulf of Aden side, north point)
-            DO ji = mi0(161), mi1(161)         !------------------------------
-               DO jk = 1, 8                        ! surface in/out flow   (Ind -> Red)   (div >0)
-                  hdiv_161_88(jk) = + zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                   ! recirculation water   (Ind -> Red)   (div >0)
-               hdiv_161_88(20) =                 + zrecirc_upp   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,20) )
-               hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
-            END DO
-         END DO
-         !
-         DO jj = mj0(87), mj1(87)              !** profile of hdiv at (161,88)   (Gulf of Aden side, south point)
-            DO ji = mi0(161), mi1(161)         !------------------------------
-               !                                   ! deep out flow + recirculation   (Red -> Ind)   (div <0)
-               hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
-            END DO
-         END DO
-         !
-         DO jj = mj0(89), mj1(89)              !** profile of hdiv at (161,88)   (Red sea side)
-            DO ji = mi0(160), mi1(160)         !------------------------------
-               DO jk = 1, 8                        ! surface inflow    (Ind -> Red)   (div <0)
-                  hdiv_160_89(jk) = - zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                   ! deep    outflow   (Red -> Ind)   (div >0)
-               hdiv_160_89(16)    = + zio_flow / (      e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,16) )
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
-         !                  ! ---------=====-- ! 
-         !                                     !** emp on the Red Sea   (div >0) 
-         zemp_red = 0.e0                       !---------------------
-         DO jj = mj0(87), mj1(96)                  ! sum over the Red sea
-            DO ji = mi0(148), mi1(160) 
-               zemp_red = zemp_red + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_sum( zemp_red )   ! sum with other processors value
-         zemp_red = zemp_red * 1.e-3               ! convert in m3
-         !
-         !                                     !** Correct hdivn (including emp adjustment)
-         !                                     !-------------------------------------------
-         DO jj = mj0(88), mj1(88)                  !* profile of hdiv at (161,88)   (Gulf of Aden side, north point)
-            DO ji = mi0(161), mi1(161) 
-               hdiv_161_88_kt(:) = hdiv_161_88(:)
-               DO jk = 1, 8                              ! increase the inflow from the Indian   (div >0) 
-                  hdiv_161_88_kt(jk) = hdiv_161_88(jk) + zemp_red / (8. * e2u(ji,jj) * fse3u(ji,jj,jk) )
-               END DO
-               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_88_kt(:)
-            END DO
-         END DO
-         DO jj = mj0(87), mj1(87)                  !* profile of divergence at (161,87)   (Gulf of Aden side, south point)
-            DO ji = mi0(161), mi1(161) 
-               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_87(:)
-            END DO
-         END DO
-         DO jj = mj0(89), mj1(89)                  !* profile of divergence at (160,89)   (Red sea side)
-            DO ji = mi0(160), mi1(160) 
-               hdiv_160_89_kt(:) = hdiv_160_89(:)
-               DO jk = 1, 18                              ! increase the inflow from the Indian   (div <0) 
-                  hdiv_160_89_kt(jk) = hdiv_160_89(jk) - zemp_red / (10. * e1v(ji,jj) * fse3v(ji,jj,jk) )
-               END DO
-               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_160_89_kt(:)
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
-         !                  ! --------=======- !
-         !
-         DO jj = mj0(88), mj1(88)              !** (161,88)   (Gulf of Aden side, north point)
-            DO ji = mi0(161), mi1(161) 
-               DO jk = 1, jpkm1                         ! surf inflow + reciculation (from Gulf of Aden)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_tem)
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_sal)
-               END DO
-            END DO
-         END DO
-         DO jj = mj0(87), mj1(87)              !** (161,87)   (Gulf of Aden side, south point)
-            DO ji = mi0(161), mi1(161) 
-               jk =  21                                 ! deep outflow + recirulation (combined flux)
-               tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + hdiv_161_88(20) * tsn(ji  ,jj+1,20,jp_tem)   &  ! upper recirculation from Gulf of Aden
-                  &                        + hdiv_161_88(21) * tsn(ji  ,jj+1,21,jp_tem)   &  ! deep  recirculation from Gulf of Aden
-                  &                        + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_tem)      ! deep inflow from Red sea
-               tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + hdiv_161_88(20) * tsn(ji  ,jj+1,20,jp_sal)   &
-                  &                        + hdiv_161_88(21) * tsn(ji  ,jj+1,21,jp_sal)   &
-                  &                        + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_sal)   
-            END DO
-         END DO
-         DO jj = mj0(89), mj1(89)              !** (161,88)   (Red sea side)
-            DO ji = mi0(160), mi1(160)
-               DO jk = 1, 14                            ! surface inflow (from Gulf of Aden)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_tem)
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_sal)
-               END DO
-               !                                  ! deep    outflow (from Red sea)
-               tsa(ji,jj,16,jp_tem) = tsa(ji,jj,16,jp_tem) - hdiv_160_89(16) * tsn(ji,jj,16,jp_tem)
-               tsa(ji,jj,16,jp_sal) = tsa(ji,jj,16,jp_sal) - hdiv_160_89(16) * tsn(ji,jj,16,jp_sal)
-            END DO
-         END DO
-         !
-         !                  ! ---------------- !
-      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
-         !                  ! --------=======- !
-         ! at this stage, (ua,va) are the after velocity, not the tendancy
-         ! compute the velocity from the divergence at T-point
-         !
-         DO jj = mj0(88), mj1(88)              !** (160,88)   (Gulf of Aden side, north point)
-            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point) 
-               ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
-                  &                              * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         DO jj = mj0(87), mj1(87)              !** (160,87)   (Gulf of Aden side, south point)
-            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point) 
-               ua(ji,jj,:) = - hdiv_161_87(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
-                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         DO jj = mj0(88), mj1(88)              !** profile of divergence at (160,89)   (Red sea side)
-            DO ji = mi0(160), mi1(160)                   ! 88, not 89 as it is a V-point)
-               va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1t(ji,jj+1) * e2t(ji,jj+1) * fse3t(ji,jj+1,:) )   &
-                  &                              * e1v(ji,jj) * fse3v(ji,jj,:)
-            END DO
-         END DO
-      END SELECT
-      !
-   END SUBROUTINE cla_bab_el_mandeb
-   
-
-   SUBROUTINE cla_gibraltar( cd_td )
-      !! -------------------------------------------------------------------
-      !!                 ***  ROUTINE cla_gibraltar  ***
-      !!        
-      !! ** Purpose :   update the now horizontal divergence, the tracer 
-      !!              tendancyand the after velocity in vicinity of Gibraltar 
-      !!              strait ( Persian Gulf - Indian ocean ).
-      !!
-      !! ** Method :
-      !!                     _______________________            
-      !!      deep  zio_flow /====|///////|====> surf. zio_flow
-      !!    + deep  zrecirc  \----|///////|     (+balance of emp)
-      !! 102                      u///////u
-      !!      mid.  recicul    <--|///////|<==== deep  zio_flow
-      !!                     _____|_______|_____  
-      !!      surf. zio_flow ====>|///////|       
-      !!    (+balance of emp)     |///////|
-      !! 101                      u///////|             
-      !!      mid.  recicul    -->|///////|               Caution: zrecirc split into 
-      !!      deep  zrecirc  ---->|///////|                  upper & bottom recirculation
-      !!                   _______|_______|_______ 
-      !!                     139     140     141  
-      !!
-      !!---------------------------------------------------------------------
-      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
-      !                                         ! ='tra' update the tracers
-      !                                         ! ='spg' update after velocity
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zemp_med     ! temporary scalar
-      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
-      !!---------------------------------------------------------------------
-      !
-      SELECT CASE( cd_td ) 
-      !                     ! ---------------- !
-      CASE( 'ini' )         !  initialisation  ! 
-         !                  ! ---------------- ! 
-         !                                     !** initialization of the velocity
-         hdiv_139_101(:) = 0.e0                     !  139,101 (Atlantic side, south point)
-         hdiv_139_102(:) = 0.e0                     !  139,102 (Atlantic side, north point)
-         hdiv_141_102(:) = 0.e0                     !  141,102 (Med sea  side)
-            
-         !                                     !** imposed transport
-         zio_flow    = 0.8e6                        ! inflow surface  water
-         zrecirc_mid = 0.7e6                        ! middle recirculation water
-         zrecirc_upp = 2.5e6                        ! upper  recirculation water
-         zrecirc_bot = 3.5e6                        ! bottom recirculation water
-         !
-         DO jj = mj0(101), mj1(101)            !** profile of hdiv at 139,101 (Atlantic side, south point)
-            DO ji = mi0(139), mi1(139)         !-----------------------------
-               DO jk = 1, 14                        ! surface in/out flow (Atl -> Med)   (div >0)
-                  hdiv_139_101(jk) = + zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               DO jk = 15, 20                       ! middle  reciculation (Atl 101 -> Atl 102)   (div >0)   
-                  hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                    ! upper reciculation (Atl 101 -> Atl 101)   (div >0)
-               hdiv_139_101(21) =               + zrecirc_upp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               !
-               !                                    ! upper & bottom reciculation (Atl 101 -> Atl 101 & 102)   (div >0)
-               hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)            !** profile of hdiv at 139,102 (Atlantic side, north point)
-            DO ji = mi0(139), mi1(139)         !-----------------------------
-               DO jk = 15, 20                       ! middle reciculation (Atl 101 -> Atl 102)   (div <0)                
-                  hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                    ! outflow of Mediterranean sea + deep recirculation   (div <0) 
-               hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)            !** velocity profile at 141,102  (Med sea side)
-            DO ji = mi0(141), mi1(141)         !------------------------------
-               DO  jk = 1, 14                       ! surface inflow in the Med     (div <0)
-                  hdiv_141_102(jk) = - zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                    ! deep    outflow toward the Atlantic    (div >0) 
-               hdiv_141_102(21)    = + zio_flow / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
-         !                  ! ---------=====-- ! 
-         !                                     !** emp on the Mediterranean Sea  (div >0) 
-         zemp_med = 0.e0                       !-------------------------------
-         DO jj = mj0(96), mj1(110)                  ! sum over the Med sea
-            DO ji = mi0(141),mi1(181)
-               zemp_med = zemp_med + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 
-            END DO
-         END DO
-         DO jj = mj0(96), mj1(96)                   ! minus 2 points in Red Sea 
-            DO ji = mi0(148),mi1(148)
-               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
-            END DO
-            DO ji = mi0(149),mi1(149)
-               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_sum( zemp_med )    ! sum with other processors value
-         zemp_med = zemp_med * 1.e-3                ! convert in m3
-         !
-         !                                     !** Correct hdivn (including emp adjustment)
-         !                                     !-------------------------------------------
-         DO jj = mj0(101), mj1(101)                 !* 139,101 (Atlantic side, south point)
-            DO ji = mi0(139), mi1(139) 
-               hdiv_139_101_kt(:) = hdiv_139_101(:)      
-               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div >0) 
-                  hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_139_101_kt(:)
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)                 !* 139,102 (Atlantic side, north point)
-            DO ji = mi0(139), mi1(139) 
-               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_139_102(:)
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)
-            DO ji = mi0(141), mi1(141) 
-               hdiv_141_102(:) = hdiv_141_102(:)
-               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div <0)
-                  hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_141_102_kt(:)
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
-         !                  ! --------=======- !
-         !
-         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)   (div >0)
-            DO ji = mi0(139), mi1(139) 
-               DO jk = 1, jpkm1                         ! surf inflow + mid. & bottom reciculation (from Atlantic)	
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_tem)
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_sal)
-               END DO
-            END DO
-         END DO
-         !
-         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)   (div <0)
-            DO ji = mi0(139), mi1(139) 
-               DO jk = 15, 20                            ! middle  reciculation (Atl 101 -> Atl 102)   (div <0)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_tem)  ! middle Atlantic recirculation
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_sal)
-               END DO
-               !                                         ! upper & bottom Atl. reciculation (Atl 101 -> Atl 102) - (div <0)
-               !                                         ! deep Med flow                    (Med 102 -> Atl 102) - (div <0)
-               tsa(ji,jj,22,jp_tem) = tsa(ji,jj,22,jp_tem) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_tem)   &  ! deep Med flow  
-                  &                        + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_tem)   &  ! upper  Atlantic recirculation  
-                  &                        + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_tem)      ! bottom Atlantic recirculation  
-               tsa(ji,jj,22,jp_sal) = tsa(ji,jj,22,jp_sal) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_sal)   &
-                  &                        + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_sal)   &
-                  &                        + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_sal) 
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)   (div <0)
-            DO ji = mi0(141), mi1(141) 
-               DO jk = 1, 14                             ! surface flow from Atlantic to Med sea
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_tem)
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_sal)
-               END DO
-               !                                         ! deeper flow from Med sea to Atlantic
-               tsa(ji,jj,21,jp_tem) = tsa(ji,jj,21,jp_tem) - hdiv_141_102(21) * tsn(ji,jj,21,jp_tem)
-               tsa(ji,jj,21,jp_sal) = tsa(ji,jj,21,jp_sal) - hdiv_141_102(21) * tsn(ji,jj,21,jp_sal)
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
-         !                  ! --------=======- !
-         ! at this stage, (ua,va) are the after velocity, not the tendancy
-         ! compute the velocity from the divergence at T-point
-         !
-         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)
-            DO ji = mi0(139), mi1(139)                    ! div >0 => ua >0, same sign
-               ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
-                  &                             * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)
-            DO ji = mi0(139), mi1(139)                    ! div <0 => ua <0, same sign
-               ua(ji,jj,:) = hdiv_139_102(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
-                  &                          * e2u(ji,jj) * fse3u(ji,jj,:)   
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)            !** 140,102 (Med side) (140 not 141 as it is a U-point)
-            DO ji = mi0(140), mi1(140)                    ! div >0 => ua <0, opposite sign
-               ua(ji,jj,:) = - hdiv_141_102(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
-                  &                            * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-   END SUBROUTINE cla_gibraltar
-
-
-   SUBROUTINE cla_hormuz( cd_td )
-      !! -------------------------------------------------------------------
-      !!                   ***  ROUTINE div_hormuz  ***
-      !!              
-      !! ** Purpose :   update the now horizontal divergence, the tracer 
-      !!              tendancyand the after velocity in vicinity of Hormuz 
-      !!              strait ( Persian Gulf - Indian ocean ).
-      !!
-      !! ** Method  :   Hormuz strait
-      !!            ______________   
-      !!            |/////|<==      surface inflow
-      !!        94  |/////|     
-      !!            |/////|==>      deep    outflow
-      !!            |_____|_______
-      !!              171    172     
-      !!---------------------------------------------------------------------
-      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='ini' initialisation
-      !!                                        ! ='div' update the divergence
-      !!                                        ! ='tra' update the tracers
-      !!                                        ! ='spg' update after velocity
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zio_flow     ! temporary scalar
-      !!---------------------------------------------------------------------
-      !
-      SELECT CASE( cd_td ) 
-      !                     ! ---------------- !
-      CASE( 'ini' )         !  initialisation  ! 
-         !                  ! ---------------- ! 
-         !                                     !** profile of horizontal divergence due to cross-land advection
-         zio_flow  = 1.e6                          ! imposed in/out flow
-         !
-         hdiv_172_94(:) = 0.e0         
-         !
-         DO jj = mj0(94), mj1(94)                  ! in/out flow at (i,j) = (172,94)
-            DO ji = mi0(172), mi1(172) 
-               DO jk = 1, 8                            ! surface inflow  (Indian ocean to Persian Gulf) (div<0)
-                  hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               DO jk = 16, 18                          ! deep    outflow (Persian Gulf to Indian ocean) (div>0)
-                  hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
-         !                                     !** T & S profile in the Hormuz strait (use in deep outflow)
-         !      Temperature       and         Salinity
-         t_171_94_hor(:)  = 0.e0   ;   s_171_94_hor(:)  = 0.e0
-         t_171_94_hor(16) = 18.4   ;   s_171_94_hor(16) = 36.27
-         t_171_94_hor(17) = 17.8   ;   s_171_94_hor(17) = 36.4
-         t_171_94_hor(18) = 16.    ;   s_171_94_hor(18) = 36.27
-         !
-         !                  ! ---------------- !
-      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
-         !                  ! ---------=====-- ! 
-         !                                   
-         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
-            DO ji = mi0(172), mi1(172) 
-               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_172_94(:)
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
-         !                  ! --------=======- !
-         !                          
-         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
-            DO ji = mi0(172), mi1(172) 
-               DO jk = 1, 8                          ! surface inflow   (Indian ocean to Persian Gulf) (div<0)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_tem) 
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_sal) 
-               END DO
-               DO jk = 16, 18                        ! deep outflow     (Persian Gulf to Indian ocean) (div>0)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * t_171_94_hor(jk)
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * s_171_94_hor(jk)
-               END DO
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
-         !                  ! --------=======- !
-         ! No barotropic flow through Hormuz strait
-         ! at this stage, (ua,va) are the after velocity, not the tendancy
-         ! compute the velocity from the divergence at T-point
-         DO jj = mj0(94), mj1(94)              !** 171,94 (Indian ocean side) (171 not 172 as it is the western U-point)
-            DO ji = mi0(171), mi1(171)                ! div >0 => ua >0, opposite sign
-               ua(ji,jj,:) = - hdiv_172_94(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
-                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-   END SUBROUTINE cla_hormuz
-   
-   !!======================================================================
-END MODULE cla
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 6808)
@@ -4,11 +4,9 @@
    !! Ocean        : lateral boundary conditions
    !!=====================================================================
-   !! History :  OPA  ! 1997-06  (G. Madec)     Original code
-   !!   NEMO     1.0  ! 2002-09  (G. Madec)     F90: Free form and module
+   !! History :  OPA  ! 1997-06  (G. Madec)  Original code
+   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
    !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment  
-   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco) Add 'lbc_bdy_lnk' 
-   !!                            and lbc_obc_lnk' routine to optimize  
-   !!                            the BDY/OBC communications
-   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add a C1D case  
+   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case  
    !!----------------------------------------------------------------------
 #if defined key_mpp_mpi
@@ -17,35 +15,41 @@
    !!----------------------------------------------------------------------
    !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
+   !!   lbc_sum      : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp
    !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
    !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
    !!----------------------------------------------------------------------
-   USE lib_mpp          ! distributed memory computing library
-
+   USE lib_mpp        ! distributed memory computing library
 
    INTERFACE lbc_lnk_multi
       MODULE PROCEDURE mpp_lnk_2d_9
    END INTERFACE
-
+   !
    INTERFACE lbc_lnk
       MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
    END INTERFACE
+   !
+!JMM interface not defined if not key_mpp_mpi : likely do not compile without this CPP key !!!!
+   INTERFACE lbc_sum
+      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d
+   END INTERFACE
 
    INTERFACE lbc_bdy_lnk
       MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
    END INTERFACE
-
+   !
    INTERFACE lbc_lnk_e
       MODULE PROCEDURE mpp_lnk_2d_e
    END INTERFACE
-
+   !
    INTERFACE lbc_lnk_icb
       MODULE PROCEDURE mpp_lnk_2d_icb
    END INTERFACE
 
-   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
-   PUBLIC lbc_lnk_multi ! modified ocean lateral boundary conditions
-   PUBLIC lbc_lnk_e
-   PUBLIC lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
-   PUBLIC lbc_lnk_icb
+   PUBLIC   lbc_lnk       ! ocean lateral boundary conditions
+   PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions
+   PUBLIC   lbc_sum
+   PUBLIC   lbc_lnk_e     !
+   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
+   PUBLIC   lbc_lnk_icb   !
 
    !!----------------------------------------------------------------------
@@ -54,13 +58,15 @@
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 #else
    !!----------------------------------------------------------------------
    !!   Default option                              shared memory computing
    !!----------------------------------------------------------------------
-   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
-   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh
-   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh
-   !!   lbc_bdy_lnk  : set the lateral BDY boundary condition
+   !!   lbc_sum       : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d 
+   !!   lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh
+   !!   lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh
+   !!   lbc_lnk       : generic interface for lbc_lnk_3d and lbc_lnk_2d
+   !!   lbc_lnk_3d    : set the lateral boundary condition on a 3D variable on ocean mesh
+   !!   lbc_lnk_2d    : set the lateral boundary condition on a 2D variable on ocean mesh
+   !!   lbc_bdy_lnk   : set the lateral BDY boundary condition
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers   
@@ -75,13 +81,17 @@
       MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
    END INTERFACE
+   !
+   INTERFACE lbc_sum
+      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d
+   END INTERFACE
 
    INTERFACE lbc_lnk_e
       MODULE PROCEDURE lbc_lnk_2d_e
    END INTERFACE
-
+   !
    INTERFACE lbc_bdy_lnk
       MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d
    END INTERFACE
-
+   !
    INTERFACE lbc_lnk_icb
       MODULE PROCEDURE lbc_lnk_2d_e
@@ -89,10 +99,10 @@
 
    PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
-   PUBLIC   lbc_lnk_e 
+   PUBLIC   lbc_lnk_e     !
    PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
-   PUBLIC   lbc_lnk_icb
+   PUBLIC   lbc_lnk_icb   !
    
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -230,5 +240,4 @@
          ! this is in mpp case. In this module, just do nothing
       ELSE
-         !
          !                                     !  East-West boundaries
          !                                     ! ======================
@@ -249,5 +258,4 @@
             !
          END SELECT
-         !
          !                                     ! North-South boundaries
          !                                     ! ======================
@@ -287,4 +295,5 @@
    END SUBROUTINE lbc_lnk_3d
 
+
    SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
       !!---------------------------------------------------------------------
@@ -316,5 +325,4 @@
          ! this is in mpp case. In this module, just do nothing
       ELSE      
-         !
          !                                     ! East-West boundaries
          !                                     ! ====================
@@ -335,5 +343,4 @@
             !
          END SELECT
-         !
          !                                     ! North-South boundaries
          !                                     ! ======================
@@ -375,5 +382,4 @@
 #endif
 
-
    SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
       !!---------------------------------------------------------------------
@@ -381,17 +387,18 @@
       !!
       !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
-      !!                to maintain the same interface with regards to the mpp
-      !case
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign 
-      INTEGER                                                   ::   ib_bdy    ! BDY boundary set
-      !!
+      !!              to maintain the same interface with regards to the mpp case
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   ) ::   psgn      ! control of the sign 
+      INTEGER                         , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
+      !
       CALL lbc_lnk_3d( pt3d, cd_type, psgn)
-
+      !
    END SUBROUTINE lbc_bdy_lnk_3d
 
+
    SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
       !!---------------------------------------------------------------------
@@ -399,15 +406,15 @@
       !!
       !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
-      !!                to maintain the same interface with regards to the mpp
-      !case
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj),     INTENT(inout)           ::   pt2d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign 
-      INTEGER                                                   ::   ib_bdy    ! BDY boundary set
-      !!
+      !!              to maintain the same interface with regards to the mpp case
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied
+      REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign 
+      INTEGER                     , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
+      !
       CALL lbc_lnk_2d( pt2d, cd_type, psgn)
-
+      !
    END SUBROUTINE lbc_bdy_lnk_2d
 
@@ -426,11 +433,11 @@
       !!                             for closed boundaries.
       !!----------------------------------------------------------------------
-      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign 
-      INTEGER                     , INTENT(in   )           ::   jpri      ! size of extra halo (not needed in non-mpp)
-      INTEGER                     , INTENT(in   )           ::   jprj      ! size of extra halo (not needed in non-mpp)
-      !!----------------------------------------------------------------------
-
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied
+      REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign 
+      INTEGER                     , INTENT(in   ) ::   jpri      ! size of extra halo (not needed in non-mpp)
+      INTEGER                     , INTENT(in   ) ::   jprj      ! size of extra halo (not needed in non-mpp)
+      !!----------------------------------------------------------------------
+      !
       CALL lbc_lnk_2d( pt2d, cd_type, psgn )
       !    
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 6808)
@@ -24,17 +24,15 @@
       MODULE PROCEDURE   lbc_nfd_3d, lbc_nfd_2d
    END INTERFACE
-
-   PUBLIC   lbc_nfd   ! north fold conditions
+   !
    INTERFACE mpp_lbc_nfd
       MODULE PROCEDURE   mpp_lbc_nfd_3d, mpp_lbc_nfd_2d
    END INTERFACE
 
-   PUBLIC   mpp_lbc_nfd   ! north fold conditions in parallel case
-
-   INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 3
-   INTEGER, PUBLIC                                  ::   nsndto, nfsloop, nfeloop
-   INTEGER, PUBLIC,  DIMENSION (jpmaxngh)           ::   isendto ! processes to which communicate
-
-
+   PUBLIC   lbc_nfd       ! north fold conditions
+   PUBLIC   mpp_lbc_nfd   ! north fold conditions (parallel case)
+
+   INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !:
+   INTEGER, PUBLIC                       ::   nsndto, nfsloop, nfeloop   !:
+   INTEGER, PUBLIC, DIMENSION (jpmaxngh) ::   isendto                    !: processes to which communicate
 
    !!----------------------------------------------------------------------
@@ -391,12 +389,12 @@
       REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
       !                                                        !   = -1. , the sign is changed if north fold boundary
-      !                                                        !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3dl      ! 3D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pt3dr      ! 3D array on which the boundary condition is applied
+      !                                                        !   =  1. , the sign is kept    if north fold boundary
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3dl     ! 3D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pt3dr     ! 3D array on which the boundary condition is applied
       !
       INTEGER  ::   ji, jk
       INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
       !!----------------------------------------------------------------------
-
+      !
       SELECT CASE ( jpni )
       CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
@@ -657,6 +655,6 @@
       !                                                      !   = -1. , the sign is changed if north fold boundary
       !                                                      !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2dl      ! 2D array on which the boundary condition is applied
-      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pt2dr      ! 2D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2dl     ! 2D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pt2dr     ! 2D array on which the boundary condition is applied
       !
       INTEGER  ::   ji
@@ -970,3 +968,4 @@
    END SUBROUTINE mpp_lbc_nfd_2d
 
+   !!======================================================================
 END MODULE lbcnfd
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 6808)
@@ -23,13 +23,13 @@
    !!                          the mppobc routine to optimize the BDY and OBC communications
    !!            3.5  !  2013  ( C. Ethe, G. Madec ) message passing arrays as local variables 
-   !!            3.5  !  2013 (S.Mocavero, I.Epicoco - CMCC) north fold optimizations
+   !!            3.5  !  2013  (S.Mocavero, I.Epicoco - CMCC) north fold optimizations
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   ctl_stop   : update momentum and tracer Kz from a tke scheme
-   !!   ctl_warn   : initialization, namelist read, and parameters control
-   !!   ctl_opn    : Open file and check if required file is available.
-   !!   ctl_nam    : Prints informations when an error occurs while reading a namelist
-   !!   get_unit   : give the index of an unused logical unit
+   !!   ctl_stop      : update momentum and tracer Kz from a tke scheme
+   !!   ctl_warn      : initialization, namelist read, and parameters control
+   !!   ctl_opn       : Open file and check if required file is available.
+   !!   ctl_nam       : Prints informations when an error occurs while reading a namelist
+   !!   get_unit      : give the index of an unused logical unit
    !!----------------------------------------------------------------------
 #if   defined key_mpp_mpi
@@ -43,5 +43,5 @@
    !!   mpp_lnk_e     : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e)
    !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb)
-   !!   mpprecv         :
+   !!   mpprecv       :
    !!   mppsend       :   SUBROUTINE mpp_ini_znl
    !!   mppscatter    :
@@ -72,4 +72,5 @@
    PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
    PUBLIC   mpp_lnk_2d_9 
+   PUBLIC   mpp_lnk_sum_3d, mpp_lnk_sum_2d
    PUBLIC   mppscatter, mppgather
    PUBLIC   mpp_ini_ice, mpp_ini_znl
@@ -94,5 +95,5 @@
    END INTERFACE
    INTERFACE mpp_sum
-      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, &
+      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real,   &
                        mppsum_realdd, mppsum_a_realdd
    END INTERFACE
@@ -175,11 +176,11 @@
       !! ** Purpose :   Find processor unit
       !!----------------------------------------------------------------------
-      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt
-      CHARACTER(len=*)             , INTENT(in   ) ::   ldname
-      INTEGER                      , INTENT(in   ) ::   kumnam_ref     ! logical unit for reference namelist
-      INTEGER                      , INTENT(in   ) ::   kumnam_cfg     ! logical unit for configuration namelist
-      INTEGER                      , INTENT(inout) ::   kumond         ! logical unit for namelist output
-      INTEGER                      , INTENT(inout) ::   kstop          ! stop indicator
-      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt        !
+      CHARACTER(len=*)             , INTENT(in   ) ::   ldname       !
+      INTEGER                      , INTENT(in   ) ::   kumnam_ref   ! logical unit for reference namelist
+      INTEGER                      , INTENT(in   ) ::   kumnam_cfg   ! logical unit for configuration namelist
+      INTEGER                      , INTENT(inout) ::   kumond       ! logical unit for namelist output
+      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator
+      INTEGER         , OPTIONAL   , INTENT(in   ) ::   localComm    !
       !
       INTEGER ::   mynode, ierr, code, ji, ii, ios
@@ -190,7 +191,7 @@
       !
       ii = 1
-      WRITE(ldtxt(ii),*)                                                                          ;   ii = ii + 1
-      WRITE(ldtxt(ii),*) 'mynode : mpi initialisation'                                            ;   ii = ii + 1
-      WRITE(ldtxt(ii),*) '~~~~~~ '                                                                ;   ii = ii + 1
+      WRITE(ldtxt(ii),*)                                                                  ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'mynode : mpi initialisation'                                    ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~ '                                                        ;   ii = ii + 1
       !
 
@@ -204,7 +205,7 @@
 
       !                              ! control print
-      WRITE(ldtxt(ii),*) '   Namelist nammpp'                                                     ;   ii = ii + 1
-      WRITE(ldtxt(ii),*) '      mpi send type                      cn_mpi_send = ', cn_mpi_send   ;   ii = ii + 1
-      WRITE(ldtxt(ii),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer     ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '   Namelist nammpp'                                             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      mpi send type          cn_mpi_send = ', cn_mpi_send       ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      size exported buffer   nn_buffer   = ', nn_buffer,' bytes';   ii = ii + 1
 
 #if defined key_agrif
@@ -223,9 +224,9 @@
 
       IF( (jpni < 1) .OR. (jpnj < 1) )THEN
-         WRITE(ldtxt(ii),*) '      jpni, jpnj and jpnij will be calculated automatically'; ii = ii + 1
+         WRITE(ldtxt(ii),*) '      jpni, jpnj and jpnij will be calculated automatically' ;   ii = ii + 1
       ELSE
-         WRITE(ldtxt(ii),*) '      processor grid extent in i         jpni = ',jpni; ii = ii + 1
-         WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj; ii = ii + 1
-         WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij; ii = ii +1
+         WRITE(ldtxt(ii),*) '      processor grid extent in i         jpni = ',jpni       ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj       ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij      ;   ii = ii + 1
       END IF
 
@@ -246,35 +247,35 @@
          SELECT CASE ( cn_mpi_send )
          CASE ( 'S' )                ! Standard mpi send (blocking)
-            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'                     ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1
          CASE ( 'B' )                ! Buffer mpi send (blocking)
-            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'                      ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'              ;   ii = ii + 1
             IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr )
          CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'                   ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'           ;   ii = ii + 1
             l_isend = .TRUE.
          CASE DEFAULT
-            WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1
-            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1
+            WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1
             kstop = kstop + 1
          END SELECT
       ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
-         WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '                  ;   ii = ii + 1
-         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                        ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1
          kstop = kstop + 1
       ELSE
          SELECT CASE ( cn_mpi_send )
          CASE ( 'S' )                ! Standard mpi send (blocking)
-            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'                     ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1
             CALL mpi_init( ierr )
          CASE ( 'B' )                ! Buffer mpi send (blocking)
-            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'                      ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'              ;   ii = ii + 1
             IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr )
          CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'                   ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'           ;   ii = ii + 1
             l_isend = .TRUE.
             CALL mpi_init( ierr )
          CASE DEFAULT
-            WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1
-            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1
+            WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1
             kstop = kstop + 1
          END SELECT
@@ -298,4 +299,12 @@
       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 )
@@ -310,4 +319,5 @@
       !
    END FUNCTION mynode
+
 
    SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )
@@ -339,14 +349,12 @@
       CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
       REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
+      !
       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
       REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
+      INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend
       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
-
       !!----------------------------------------------------------------------
       
@@ -356,5 +364,5 @@
       !
       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
+      ELSE                         ;   zland = 0._wp     ! zero by default
       ENDIF
 
@@ -447,5 +455,4 @@
       END SELECT
 
-
       ! 3. North and south directions
       ! -----------------------------
@@ -500,5 +507,4 @@
       END SELECT
 
-
       ! 4. north fold treatment
       ! -----------------------
@@ -516,4 +522,5 @@
       !
    END SUBROUTINE mpp_lnk_3d
+
 
    SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval )
@@ -534,9 +541,5 @@
       !!                    noso   : number for local neighboring processors
       !!                    nono   : number for local neighboring processors
-      !!
-      !!----------------------------------------------------------------------
-
-      INTEGER :: num_fields
-      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
+      !!----------------------------------------------------------------------
       CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
       !                                                               ! = T , U , V , F , W and I points
@@ -550,19 +553,18 @@
       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-
+      INTEGER :: num_fields
+      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
       REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
+      INTEGER , DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat       ! for key_mpi_isend
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
 
       !!----------------------------------------------------------------------
-
+      !
       ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields),  &
          &      zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields)   )
-
       !
       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
+      ELSE                         ;   zland = 0._wp     ! zero by default
       ENDIF
 
@@ -736,5 +738,5 @@
          !
       END DO
-      
+      !
       DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
       !
@@ -742,18 +744,18 @@
 
    
-   SUBROUTINE load_array(pt2d,cd_type,psgn,pt2d_array, type_array, psgn_array,num_fields)
+   SUBROUTINE load_array( pt2d, cd_type, psgn, pt2d_array, type_array, psgn_array, num_fields )
       !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), TARGET   ,   INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points
-      REAL(wp)                    , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied
+      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points
+      REAL(wp)                            , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary
       TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array
       CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
       REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
-      INTEGER                      , INTENT (inout):: num_fields 
+      INTEGER                            , INTENT (inout) :: num_fields 
       !!---------------------------------------------------------------------
-      num_fields=num_fields+1
-      pt2d_array(num_fields)%pt2d=>pt2d
-      type_array(num_fields)=cd_type
-      psgn_array(num_fields)=psgn
+      num_fields = num_fields + 1
+      pt2d_array(num_fields)%pt2d => pt2d
+      type_array(num_fields)      =  cd_type
+      psgn_array(num_fields)      =  psgn
    END SUBROUTINE load_array
    
@@ -784,21 +786,22 @@
       INTEGER :: num_fields
       !!---------------------------------------------------------------------
-
+      !
       num_fields = 0
-
-      !! Load the first array
-      CALL load_array(pt2dA,cd_typeA,psgnA,pt2d_array, type_array, psgn_array,num_fields)
-
-      !! Look if more arrays are added
-      IF(PRESENT (psgnB) )CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields)
-      IF(PRESENT (psgnC) )CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields)
-      IF(PRESENT (psgnD) )CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields)
-      IF(PRESENT (psgnE) )CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields)
-      IF(PRESENT (psgnF) )CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields)
-      IF(PRESENT (psgnG) )CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields)
-      IF(PRESENT (psgnH) )CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields)
-      IF(PRESENT (psgnI) )CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields)
-      
-      CALL mpp_lnk_2d_multiple(pt2d_array,type_array,psgn_array,num_fields,cd_mpp,pval)
+      !
+      ! Load the first array
+      CALL load_array( pt2dA, cd_typeA, psgnA, pt2d_array, type_array, psgn_array, num_fields )
+      !
+      ! Look if more arrays are added
+      IF( PRESENT(psgnB) )   CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnC) )   CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnD) )   CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnE) )   CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnF) )   CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnG) )   CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnH) )   CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnI) )   CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields)
+      !
+      CALL mpp_lnk_2d_multiple( pt2d_array, type_array, psgn_array, num_fields, cd_mpp,pval )
+      !
    END SUBROUTINE mpp_lnk_2d_9
 
@@ -835,17 +838,14 @@
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
       REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
+      INTEGER, DIMENSION(MPI_STATUS_SIZE)     ::   ml_stat       ! for key_mpi_isend
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-
-      !!----------------------------------------------------------------------
-
+      !!----------------------------------------------------------------------
+      !
       ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
          &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
-
       !
       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
+      ELSE                         ;   zland = 0._wp     ! zero by default
       ENDIF
 
@@ -1038,14 +1038,12 @@
       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !
+      INTEGER , DIMENSION(MPI_STATUS_SIZE)        ::   ml_stat   ! for key_mpi_isend
       REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ns, zt4sn   ! 2 x 3d for north-south & south-north
       REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ew, zt4we   ! 2 x 3d for east-west & west-east
-
-      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      !
       ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) ,    &
          &      zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) )
-
-
+      !
       ! 1. standard boundary treatment
       ! ------------------------------
@@ -1391,7 +1389,350 @@
          END DO
       END SELECT
-
+      !
    END SUBROUTINE mpp_lnk_2d_e
 
+   SUBROUTINE mpp_lnk_sum_3d( ptab, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_sum_3d  ***
+      !!
+      !! ** Purpose :   Message passing manadgement (sum the overlap region)
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !! ** Action  :   ptab with update value at its periphery
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                             ! = T , U , V , F , W points
+      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                             ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+      
+      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
+         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
+
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      SELECT CASE ( nbondi )      ! Read lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+      iihom = nlci-jpreci
+         DO jl = 1, jpreci
+            zt3ew(:,jl,:,1) = ptab(jl      ,:,:) ; ptab(jl      ,:,:) = 0.0_wp
+            zt3we(:,jl,:,1) = ptab(iihom+jl,:,:) ; ptab(iihom+jl,:,:) = 0.0_wp 
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write lateral conditions
+      iihom = nlci-nreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:,:) = ptab(iihom+jl,:,:) + zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)
+            ptab(iihom +jl,:,:) = ptab(iihom +jl,:,:) + zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read lateral conditions
+         ijhom = nlcj-jprecj
+         DO jl = 1, jprecj
+            zt3sn(:,jl,:,1) = ptab(:,ijhom+jl,:) ; ptab(:,ijhom+jl,:) = 0.0_wp
+            zt3ns(:,jl,:,1) = ptab(:,jl      ,:) ; ptab(:,jl      ,:) = 0.0_wp
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write lateral conditions
+      ijhom = nlcj-nrecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl,:) = ptab(:,ijhom+jl,:) + zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl,:,2)
+            ptab(:,ijhom +jl,:) = ptab(:,ijhom +jl,:) + zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl   ,:,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
+      !
+   END SUBROUTINE mpp_lnk_sum_3d
+
+   SUBROUTINE mpp_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_sum_2d  ***
+      !!
+      !! ** Purpose :   Message passing manadgement for 2d array (sum the overlap region)
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W and I points
+      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                         ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
+         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
+
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      SELECT CASE ( nbondi )      ! Read lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci - jpreci
+         DO jl = 1, jpreci
+            zt2ew(:,jl,1) = pt2d(jl       ,:) ; pt2d(jl       ,:) = 0.0_wp
+            zt2we(:,jl,1) = pt2d(iihom +jl,:) ; pt2d(iihom +jl,:) = 0.0_wp
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write lateral conditions
+      iihom = nlci-nreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            pt2d(iihom+jl,:) = pt2d(iihom+jl,:) + zt2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)
+            pt2d(iihom +jl,:) = pt2d(iihom +jl,:) + zt2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read lateral conditions
+         ijhom = nlcj - jprecj
+         DO jl = 1, jprecj
+            zt2sn(:,jl,1) = pt2d(:,ijhom +jl) ; pt2d(:,ijhom +jl) = 0.0_wp
+            zt2ns(:,jl,1) = pt2d(:,jl       ) ; pt2d(:,jl       ) = 0.0_wp
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write lateral conditions
+      ijhom = nlcj-nrecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            pt2d(:,ijhom+jl) = pt2d(:,ijhom+jl) + zt2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)
+            pt2d(:,ijhom +jl) = pt2d(:,ijhom +jl) + zt2ns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
+      !
+   END SUBROUTINE mpp_lnk_sum_2d
 
    SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
@@ -1441,12 +1782,9 @@
       !!----------------------------------------------------------------------
       !
-
       ! If a specific process number has been passed to the receive call,
       ! use that one. Default is to use mpi_any_source
-      use_source=mpi_any_source
-      if(present(ksource)) then
-         use_source=ksource
-      end if
-
+      use_source = mpi_any_source
+      IF( PRESENT(ksource) )   use_source = ksource
+      !
       CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_opa, istatus, iflag )
       !
@@ -1462,6 +1800,6 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj),       INTENT(in   ) ::   ptab   ! subdomain input array
-      INTEGER ,                           INTENT(in   ) ::   kp     ! record length
+      REAL(wp), DIMENSION(jpi,jpj)      , INTENT(in   ) ::   ptab   ! subdomain input array
+      INTEGER                           , INTENT(in   ) ::   kp     ! record length
       REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT(  out) ::   pio    ! subdomain input array
       !!
@@ -1484,12 +1822,12 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::  pio        ! output array
-      INTEGER                             ::   kp        ! Tag (not used with MPI
-      REAL(wp), DIMENSION(jpi,jpj)        ::  ptab       ! subdomain array input
+      REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::   pio    ! output array
+      INTEGER                             ::   kp     ! Tag (not used with MPI
+      REAL(wp), DIMENSION(jpi,jpj)        ::   ptab   ! subdomain array input
       !!
       INTEGER :: itaille, ierror   ! temporary integer
       !!---------------------------------------------------------------------
       !
-      itaille=jpi*jpj
+      itaille = jpi * jpj
       !
       CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   &
@@ -1509,5 +1847,5 @@
       INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array
       INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   !
-      !!
+      !
       INTEGER :: ierror, localcomm   ! temporary integer
       INTEGER, DIMENSION(kdim) ::   iwork
@@ -1531,7 +1869,7 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(inout)           ::   ktab      ! ???
-      INTEGER, INTENT(in   ), OPTIONAL ::   kcom      ! ???
-      !!
+      INTEGER, INTENT(inout)           ::   ktab   ! ???
+      INTEGER, INTENT(in   ), OPTIONAL ::   kcom   ! ???
+      !
       INTEGER ::   ierror, iwork, localcomm   ! temporary integer
       !!----------------------------------------------------------------------
@@ -1540,5 +1878,5 @@
       IF( PRESENT(kcom) )   localcomm = kcom
       !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror)
+      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror )
       !
       ktab = iwork
@@ -1554,7 +1892,7 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER , INTENT( in  )                  ::   kdim        ! size of array
-      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array
-      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
+      INTEGER , INTENT( in  )                  ::   kdim   ! size of array
+      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array
+      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom   ! input array
       !!
       INTEGER ::   ierror, localcomm   ! temporary integer
@@ -1588,5 +1926,5 @@
       IF( PRESENT(kcom) )   localcomm = kcom
       !
-     CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror )
+      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror )
       !
       ktab = iwork
@@ -1602,7 +1940,7 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in   )                   ::   kdim      ! ???
-      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab      ! ???
-      !!
+      INTEGER, INTENT(in   )                   ::   kdim   ! ???
+      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab   ! ???
+      !
       INTEGER :: ierror
       INTEGER, DIMENSION (kdim) ::  iwork
@@ -1645,5 +1983,5 @@
       REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
       INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
-      !!
+      !
       INTEGER :: ierror, localcomm
       REAL(wp), DIMENSION(kdim) ::  zwork
@@ -1777,4 +2115,5 @@
    END SUBROUTINE mppsum_real
 
+
    SUBROUTINE mppsum_realdd( ytab, kcom )
       !!----------------------------------------------------------------------
@@ -1785,20 +2124,19 @@
       !!
       !!-----------------------------------------------------------------------
-      COMPLEX(wp), INTENT(inout)         :: ytab    ! input scalar
-      INTEGER , INTENT( in  ), OPTIONAL :: kcom
-
-      !! * Local variables   (MPI version)
-      INTEGER  ::    ierror
-      INTEGER  ::   localcomm
-      COMPLEX(wp) :: zwork
-
+      COMPLEX(wp), INTENT(inout)           ::   ytab    ! input scalar
+      INTEGER    , INTENT(in   ), OPTIONAL ::   kcom
+      !
+      INTEGER     ::   ierror
+      INTEGER     ::   localcomm
+      COMPLEX(wp) ::   zwork
+      !!-----------------------------------------------------------------------
+      !
       localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
       ! reduce local sums into global sum
-      CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, &
-                       MPI_SUMDD,localcomm,ierror)
+      CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror )
       ytab = zwork
-
+      !
    END SUBROUTINE mppsum_realdd
 
@@ -1812,21 +2150,20 @@
       !!
       !!-----------------------------------------------------------------------
-      INTEGER , INTENT( in )                        ::   kdim      ! size of ytab
-      COMPLEX(wp), DIMENSION(kdim), INTENT( inout ) ::   ytab      ! input array
-      INTEGER , INTENT( in  ), OPTIONAL :: kcom
-
-      !! * Local variables   (MPI version)
-      INTEGER                      :: ierror    ! temporary integer
-      INTEGER                      ::   localcomm
+      INTEGER                     , INTENT(in   ) ::   kdim   ! size of ytab
+      COMPLEX(wp), DIMENSION(kdim), INTENT(inout) ::   ytab   ! input array
+      INTEGER    , OPTIONAL       , INTENT(in   ) ::   kcom
+      !
+      INTEGER:: ierror, localcomm    ! local integer
       COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace
-
+      !!-----------------------------------------------------------------------
+      !
       localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-
-      CALL MPI_ALLREDUCE (ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, &
-                       MPI_SUMDD,localcomm,ierror)
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror )
       ytab(:) = zwork(:)
-
+      !
    END SUBROUTINE mppsum_a_realdd
+
 
    SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj )
@@ -1844,7 +2181,7 @@
       REAL(wp)                     , INTENT(  out) ::   pmin    ! Global minimum of ptab
       INTEGER                      , INTENT(  out) ::   ki, kj   ! index of minimum in global frame
-      !!
+      !
+      INTEGER :: ierror
       INTEGER , DIMENSION(2)   ::   ilocs
-      INTEGER :: ierror
       REAL(wp) ::   zmin   ! local minimum
       REAL(wp), DIMENSION(2,1) ::   zain, zaout
@@ -2654,5 +2991,6 @@
    END SUBROUTINE mpp_lbc_north_e
 
-      SUBROUTINE mpp_lnk_bdy_3d( ptab, cd_type, psgn, ib_bdy )
+
+   SUBROUTINE mpp_lnk_bdy_3d( ptab, cd_type, psgn, ib_bdy )
       !!----------------------------------------------------------------------
       !!                  ***  routine mpp_lnk_bdy_3d  ***
@@ -2675,9 +3013,4 @@
       !!
       !!----------------------------------------------------------------------
-
-      USE lbcnfd          ! north fold
-
-      INCLUDE 'mpif.h'
-
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
@@ -2686,48 +3019,44 @@
       !                                                             ! =  1. , the sign is kept
       INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
+      !
       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   imigr, iihom, ijhom        ! local integers
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
+      REAL(wp) ::   zland                      ! local scalar
       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
       !
       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
-
-      !!----------------------------------------------------------------------
-      
+      !!----------------------------------------------------------------------
+      !
       ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
          &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
 
-      zland = 0.e0
+      zland = 0._wp
 
       ! 1. standard boundary treatment
       ! ------------------------------
-      
       !                                   ! East-West boundaries
       !                                        !* Cyclic east-west
-
       IF( nbondi == 2) THEN
-        IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
-          ptab( 1 ,:,:) = ptab(jpim1,:,:)
-          ptab(jpi,:,:) = ptab(  2  ,:,:)
-        ELSE
-          IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
-          ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
-        ENDIF
+         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+            ptab( 1 ,:,:) = ptab(jpim1,:,:)
+            ptab(jpi,:,:) = ptab(  2  ,:,:)
+         ELSE
+            IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point
+            ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north
+         ENDIF
       ELSEIF(nbondi == -1) THEN
-        IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
+         IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point
       ELSEIF(nbondi == 1) THEN
-        ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
+         ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north
       ENDIF                                     !* closed
 
       IF (nbondj == 2 .OR. nbondj == -1) THEN
-        IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
+        IF( .NOT. cd_type == 'F' )   ptab(:,1:jprecj,:) = zland       ! south except F-point
       ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
-        ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
-      ENDIF
-      
-      !
-
+        ptab(:,nlcj-jprecj+1:jpj,:) = zland       ! north
+      ENDIF
+      !
       ! 2. East and west directions exchange
       ! ------------------------------------
@@ -2786,10 +3115,10 @@
       CASE ( 0 )
          DO jl = 1, jpreci
-            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
+            ptab(      jl,:,:) = zt3we(:,jl,:,2)
             ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jpreci
-            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
+            ptab(      jl,:,:) = zt3we(:,jl,:,2)
          END DO
       END SELECT
@@ -2877,5 +3206,6 @@
    END SUBROUTINE mpp_lnk_bdy_3d
 
-      SUBROUTINE mpp_lnk_bdy_2d( ptab, cd_type, psgn, ib_bdy )
+
+   SUBROUTINE mpp_lnk_bdy_2d( ptab, cd_type, psgn, ib_bdy )
       !!----------------------------------------------------------------------
       !!                  ***  routine mpp_lnk_bdy_2d  ***
@@ -2898,17 +3228,13 @@
       !!
       !!----------------------------------------------------------------------
-
-      USE lbcnfd          ! north fold
-
-      INCLUDE 'mpif.h'
-
-      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W points
+      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                         ! =  1. , the sign is kept
+      INTEGER                     , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
+      !
       INTEGER  ::   ji, jj, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   imigr, iihom, ijhom        ! local integers
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
       REAL(wp) ::   zland
@@ -2917,5 +3243,4 @@
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
-
       !!----------------------------------------------------------------------
 
@@ -2923,34 +3248,30 @@
          &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
 
-      zland = 0.e0
+      zland = 0._wp
 
       ! 1. standard boundary treatment
       ! ------------------------------
-      
       !                                   ! East-West boundaries
-      !                                        !* Cyclic east-west
-
-      IF( nbondi == 2) THEN
-        IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
-          ptab( 1 ,:) = ptab(jpim1,:)
-          ptab(jpi,:) = ptab(  2  ,:)
-        ELSE
-          IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:) = zland    ! south except F-point
-          ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
-        ENDIF
+      !                                      !* Cyclic east-west
+      IF( nbondi == 2 ) THEN
+         IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
+            ptab( 1 ,:) = ptab(jpim1,:)
+            ptab(jpi,:) = ptab(  2  ,:)
+         ELSE
+            IF(.NOT.cd_type == 'F' )  ptab(     1       :jpreci,:) = zland    ! south except F-point
+                                      ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
+         ENDIF
       ELSEIF(nbondi == -1) THEN
-        IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:) = zland    ! south except F-point
+         IF( .NOT.cd_type == 'F' )    ptab(     1       :jpreci,:) = zland    ! south except F-point
       ELSEIF(nbondi == 1) THEN
-        ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
-      ENDIF                                     !* closed
-
-      IF (nbondj == 2 .OR. nbondj == -1) THEN
-        IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj) = zland       ! south except F-point
+                                      ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
+      ENDIF
+      !                                      !* closed
+      IF( nbondj == 2 .OR. nbondj == -1 ) THEN
+         IF( .NOT.cd_type == 'F' )    ptab(:,     1       :jprecj) = zland    ! south except F-point
       ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
-        ptab(:,nlcj-jprecj+1:jpj) = zland       ! north
-      ENDIF
-      
-      !
-
+                                      ptab(:,nlcj-jprecj+1:jpj   ) = zland    ! north
+      ENDIF
+      !
       ! 2. East and west directions exchange
       ! ------------------------------------
@@ -3099,4 +3420,5 @@
       !
    END SUBROUTINE mpp_lnk_bdy_2d
+
 
    SUBROUTINE mpi_init_opa( ldtxt, ksft, code )
@@ -3188,4 +3510,5 @@
    END SUBROUTINE DDPDD_MPI
 
+
    SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, pr2dj)
       !!---------------------------------------------------------------------
@@ -3210,4 +3533,5 @@
       !!                                                    ! north fold, =  1. otherwise
       INTEGER, OPTIONAL       , INTENT(in   ) ::   pr2dj
+      !
       INTEGER ::   ji, jj, jr
       INTEGER ::   ierr, itaille, ildi, ilei, iilb
@@ -3216,5 +3540,4 @@
       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
-
       !!----------------------------------------------------------------------
       !
@@ -3226,9 +3549,8 @@
       ENDIF
       ALLOCATE( ztab_e(jpiglo,4+2*ipr2dj), znorthloc_e(jpi,4+2*ipr2dj), znorthgloio_e(jpi,4+2*ipr2dj,jpni) )
-
-      !
-      ztab_e(:,:) = 0.e0
-
-      ij=0
+      !
+      ztab_e(:,:) = 0._wp
+      !
+      ij = 0
       ! put in znorthloc_e the last 4 jlines of pt2d
       DO jj = nlcj - ijpj + 1 - ipr2dj, nlcj +ipr2dj
@@ -3272,4 +3594,5 @@
       !
    END SUBROUTINE mpp_lbc_north_icb
+
 
    SUBROUTINE mpp_lnk_2d_icb( pt2d, cd_type, psgn, jpri, jprj )
@@ -3292,5 +3615,4 @@
       !!                    noso   : number for local neighboring processors
       !!                    nono   : number for local neighboring processors
-      !!
       !!----------------------------------------------------------------------
       INTEGER                                             , INTENT(in   ) ::   jpri
@@ -3451,4 +3773,5 @@
 
    END SUBROUTINE mpp_lnk_2d_icb
+   
 #else
    !!----------------------------------------------------------------------
@@ -3736,9 +4059,9 @@
       LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
       INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number
-      !!
+      !
       CHARACTER(len=80) ::   clfile
       INTEGER           ::   iost
       !!----------------------------------------------------------------------
-
+      !
       ! adapt filename
       ! ----------------
@@ -3753,5 +4076,5 @@
       knum=get_unit()
 #endif
-
+      !
       iost=0
       IF( cdacce(1:6) == 'DIRECT' )  THEN
@@ -3786,7 +4109,8 @@
          STOP 'ctl_opn bad opening'
       ENDIF
-
+      !
    END SUBROUTINE ctl_opn
 
+
    SUBROUTINE ctl_nam ( kios, cdnam, ldwp )
       !!----------------------------------------------------------------------
@@ -3797,26 +4121,25 @@
       !! ** Method  :   Fortan open
       !!----------------------------------------------------------------------
-      INTEGER          , INTENT(inout) ::   kios      ! IO status after reading the namelist
-      CHARACTER(len=*) , INTENT(in   ) ::   cdnam     ! group name of namelist for which error occurs
-      CHARACTER(len=4)                 ::   clios     ! string to convert iostat in character for print
-      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
-      !!----------------------------------------------------------------------
-
-      ! 
-      ! ----------------
-      WRITE (clios, '(I4.0)') kios
+      INTEGER         , INTENT(inout) ::   kios    ! IO status after reading the namelist
+      CHARACTER(len=*), INTENT(in   ) ::   cdnam   ! group name of namelist for which error occurs
+      CHARACTER(len=4)                ::   clios   ! string to convert iostat in character for print
+      LOGICAL         , INTENT(in   ) ::   ldwp    ! boolean term for print
+      !!----------------------------------------------------------------------
+      !
+      WRITE (clios, '(I4.0)')   kios
       IF( kios < 0 ) THEN         
-         CALL ctl_warn( 'W A R N I N G:  end of record or file while reading namelist ' &
- &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
-      ENDIF
-
+         CALL ctl_warn( 'end of record or file while reading namelist '   &
+            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
+      ENDIF
+      !
       IF( kios > 0 ) THEN
-         CALL ctl_stop( 'E R R O R :   misspelled variable in namelist ' &
- &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
+         CALL ctl_stop( 'misspelled variable in namelist '   &
+            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
       ENDIF
       kios = 0
       RETURN
-      
+      !
    END SUBROUTINE ctl_nam
+
 
    INTEGER FUNCTION get_unit()
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 6808)
@@ -11,5 +11,4 @@
    !!   mpp_init_ioispl: IOIPSL initialization in mpp
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE dom_oce         ! ocean space and time domain 
    USE in_out_manager  ! I/O Manager
@@ -23,6 +22,4 @@
    PUBLIC mpp_init2      ! called by opa.F90
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -457,11 +454,4 @@
 #  include "mppini_2.h90"
 
-# if defined key_dimgout
-   !!----------------------------------------------------------------------
-   !!   'key_dimgout'                  NO use of NetCDF files
-   !!----------------------------------------------------------------------
-   SUBROUTINE mpp_init_ioipsl       ! Dummy routine
-   END SUBROUTINE mpp_init_ioipsl  
-# else
    SUBROUTINE mpp_init_ioipsl
       !!----------------------------------------------------------------------
@@ -509,5 +499,4 @@
    END SUBROUTINE mpp_init_ioipsl  
 
-# endif
 #endif
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 6808)
@@ -136,5 +136,5 @@
 
       imask(:,:)=1
-      WHERE ( zdta(:,:) - zdtaisf(:,:) <= 0. ) imask = 0
+      WHERE ( zdta(:,:) - zdtaisf(:,:) <= rn_isfhmin ) imask = 0
 
       !  1. Dimension arrays for subdomains
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90	(revision 6808)
@@ -0,0 +1,208 @@
+MODULE ldfc1d_c2d
+   !!======================================================================
+   !!                    ***  MODULE  ldfc1d_c2d  ***
+   !! Ocean physics:  profile and horizontal shape of lateral eddy coefficients 
+   !!=====================================================================
+   !! History :  3.7  ! 2013-12  (G. Madec)  restructuration/simplification of aht/aeiv specification,
+   !!                 !                      add velocity dependent coefficient and optional read in file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ldf_c1d       : ah reduced by 1/4 on the vertical (tanh profile, inflection at 300m) 
+   !!   ldf_c2d       : ah = F(e1,e2) (laplacian or = F(e1^3,e2^3) (bilaplacian)
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ldf_c1d   ! called by ldftra and ldfdyn modules
+   PUBLIC   ldf_c2d   ! called by ldftra and ldfdyn modules
+
+ 
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id: $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ldf_c1d( cd_type, prat, pahs1, pahs2, pah1, pah2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_c1d  ***
+      !!              
+      !! ** Purpose :   1D eddy diffusivity/viscosity coefficients
+      !!
+      !! ** Method  :   1D eddy diffusivity coefficients F( depth )
+      !!                Reduction by prat from surface to bottom 
+      !!                hyperbolic tangent profile with inflection point 
+      !!                at zh=500m and a width of zw=200m
+      !!
+      !!   cd_type = TRA      pah1, pah2 defined at U- and V-points
+      !!             DYN      pah1, pah2 defined at T- and F-points
+      !!----------------------------------------------------------------------
+      CHARACTER(len=2)                , INTENT(in   ) ::   cd_type        ! DYNamique or TRAcers
+      REAL(wp)                        , INTENT(in   ) ::   prat           ! ratio surface/deep values           [-]
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) ::   pahs1, pahs2   ! surface value of eddy coefficient   [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pah1 , pah2    ! eddy coefficient                    [m2/s]
+      !
+      INTEGER  ::   ji, jj, jk      ! dummy loop indices
+      REAL(wp) ::   zh, zc, zdep1   ! local scalars
+      REAL(wp) ::   zw    , zdep2   !   -      -
+      !!----------------------------------------------------------------------
+
+      ! initialization of the profile
+      zh =  500._wp              ! depth    of the inflection point [m]
+      zw =  1._wp / 200._wp      ! width^-1     -        -      -   [1/m]
+      !                          ! associated coefficient           [-]
+      zc = ( 1._wp - prat ) / ( 1._wp + TANH( zh * zw) )
+      !
+      !
+      SELECT CASE( cd_type )        ! point of calculation
+      !
+      CASE( 'DYN' )                     ! T- and F-points
+         DO jk = 1, jpk                      ! pah1 at T-point
+            pah1(:,:,jk) = pahs1(:,:) * (  prat + zc * ( 1._wp + TANH( - ( gdept_n(:,:,jk) - zh ) * zw) )  ) * tmask(:,:,jk)
+         END DO
+         DO jk = 1, jpk                      ! pah2 at F-point (zdep2 is an approximation in zps-coord.)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1
+                  zdep2 = (  gdept_n(ji,jj+1,jk) + gdept_n(ji+1,jj+1,jk)   &
+                     &     + gdept_n(ji,jj  ,jk) + gdept_n(ji+1,jj  ,jk)  ) * 0.25_wp
+                  pah2(ji,jj,jk) = pahs2(ji,jj) * (  prat + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) )  ) * fmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( pah2, 'F', 1. )   ! Lateral boundary conditions
+         !
+      CASE( 'TRA' )                     ! U- and V-points (zdep1 & 2 are an approximation in zps-coord.)
+         DO jk = 1, jpk
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1
+                  zdep1 = (  gdept_n(ji,jj,jk) + gdept_n(ji+1,jj,jk)  ) * 0.5_wp
+                  zdep2 = (  gdept_n(ji,jj,jk) + gdept_n(ji,jj+1,jk)  ) * 0.5_wp
+                  pah1(ji,jj,jk) = pahs1(ji,jj) * (  prat + zc * ( 1._wp + TANH( - ( zdep1 - zh ) * zw) )  ) * umask(ji,jj,jk)
+                  pah2(ji,jj,jk) = pahs2(ji,jj) * (  prat + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) )  ) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( pah1, 'U', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( pah2, 'V', 1. )   
+         !
+      END SELECT
+      !
+   END SUBROUTINE ldf_c1d
+
+
+   SUBROUTINE ldf_c2d( cd_type, cd_op, pah0, pah1, pah2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_c2d  ***
+      !!              
+      !! ** Purpose :   2D eddy diffusivity/viscosity coefficients
+      !!
+      !! ** Method  :   2D eddy diffusivity coefficients F( e1 , e2 )
+      !!       laplacian   operator :   ah proportional to the scale factor      [m2/s]
+      !!       bilaplacian operator :   ah proportional to the (scale factor)^3  [m4/s]
+      !!       In both cases, pah0 is the maximum value reached by the coefficient 
+      !!       at the Equator in case of e1=ra*rad= ~111km, not over the whole domain.
+      !!
+      !!   cd_type = TRA      pah1, pah2 defined at U- and V-points
+      !!             DYN      pah1, pah2 defined at T- and F-points
+      !!----------------------------------------------------------------------
+      CHARACTER(len=3)                , INTENT(in   ) ::   cd_type      ! DYNamique or TRAcers
+      CHARACTER(len=3)                , INTENT(in   ) ::   cd_op        ! operator: LAPlacian BiLaPlacian
+      REAL(wp)                        , INTENT(in   ) ::   pah0         ! eddy coefficient   [m2/s or m4/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pah1, pah2   ! eddy coefficient   [m2/s or m4/s]
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   za00, zd_max, zemax1, zemax2   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      zd_max = ra * rad       ! = 1 degree at the equator in meters
+      !
+      IF(lwp) THEN
+         WRITE(numout,*) 'ldf_c2d :     aht = rn_aht0 *  max(e1,e2)/e_equator     (  laplacian) '
+         WRITE(numout,*) '~~~~~~~       or  = rn_bht0 * [max(e1,e2)/e_equator]**3 (bilaplacian)'
+         WRITE(numout,*)
+      ENDIF
+      !
+      SELECT CASE( cd_type )        !==  surface values  ==!  (depending on DYN/TRA)
+      !
+      CASE( 'DYN' )                     ! T- and F-points
+         IF( cd_op == 'LAP' ) THEN            ! laplacian operator
+            IF(lwp) WRITE(numout,*) '              momentum laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)'
+            za00 = pah0 / zd_max
+            DO jj = 1, jpj 
+               DO ji = 1, jpi 
+                  zemax1 = MAX( e1t(ji,jj), e2t(ji,jj) ) * tmask(ji,jj,1)
+                  zemax2 = MAX( e1f(ji,jj), e2f(ji,jj) ) * fmask(ji,jj,1)
+                  pah1(ji,jj,1) = za00 * zemax1
+                  pah2(ji,jj,1) = za00 * zemax2
+               END DO
+            END DO
+         ELSEIF( cd_op == 'BLP' ) THEN     ! bilaplacian operator
+            IF(lwp) WRITE(numout,*) '              momentum bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3'
+            za00 = pah0 / ( zd_max * zd_max * zd_max )
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zemax1 = MAX( e1t(ji,jj), e2t(ji,jj) ) * tmask(ji,jj,1)
+                  zemax2 = MAX( e1f(ji,jj), e2f(ji,jj) ) * fmask(ji,jj,1)
+                  pah1(ji,jj,1) = za00 * zemax1 * zemax1 * zemax1 
+                  pah2(ji,jj,1) = za00 * zemax2 * zemax2 * zemax2 
+               END DO
+            END DO
+         ELSE                                ! NO diffusion/viscosity
+            CALL ctl_stop( 'ldf_c2d: ', cd_op, ' case. Unknown lateral operator ' )
+         ENDIF
+         !                                !  deeper values  (LAP and BLP cases)
+         DO jk = 2, jpk
+            pah1(:,:,jk) = pah1(:,:,1) * tmask(:,:,jk) 
+            pah2(:,:,jk) = pah2(:,:,1) * fmask(:,:,jk) 
+         END DO
+         !
+      CASE( 'TRA' )                     ! U- and V-points (approximation in zps-coord.)
+         IF( cd_op == 'LAP' ) THEN            ! laplacian operator
+            IF(lwp) WRITE(numout,*) '              tracer laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)'
+            za00 = pah0 / zd_max
+            DO jj = 1, jpj 
+               DO ji = 1, jpi 
+                  zemax1 = MAX( e1u(ji,jj), e2u(ji,jj) ) * umask(ji,jj,1)
+                  zemax2 = MAX( e1v(ji,jj), e2v(ji,jj) ) * vmask(ji,jj,1)
+                  pah1(ji,jj,1) = za00 * zemax1
+                  pah2(ji,jj,1) = za00 * zemax2
+               END DO
+            END DO
+         ELSEIF( cd_op == 'BLP' ) THEN      ! bilaplacian operator (NB: square root of the coeff)
+            IF(lwp) WRITE(numout,*) '              tracer bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3'
+            za00 = pah0 / ( zd_max * zd_max * zd_max )
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zemax1 = MAX( e1u(ji,jj), e2u(ji,jj) ) * umask(ji,jj,1) 
+                  zemax2 = MAX( e1v(ji,jj), e2v(ji,jj) ) * vmask(ji,jj,1) 
+                  pah1(ji,jj,1) = za00 * zemax1 * zemax1 * zemax1 
+                  pah2(ji,jj,1) = za00 * zemax2 * zemax2 * zemax2 
+               END DO
+            END DO
+         ELSE                                ! NO diffusion/viscosity
+            CALL ctl_stop( 'ldf_c2d: ', cd_op, ' case. Unknown lateral operator ' )
+         ENDIF
+         !                                !  deeper values  (LAP and BLP cases)
+         DO jk = 2, jpk
+            pah1(:,:,jk) = pah1(:,:,1) * umask(:,:,jk) 
+            pah2(:,:,jk) = pah2(:,:,1) * vmask(:,:,jk) 
+         END DO
+         !
+      END SELECT
+      !
+   END SUBROUTINE ldf_c2d
+
+   !!======================================================================
+END MODULE ldfc1d_c2d
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 6808)
@@ -6,19 +6,20 @@
    !! History :  OPA  ! 1997-07  (G. Madec)  multi dimensional coefficients
    !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   ldf_dyn_init : initialization, namelist read, and parameters control
-   !!   ldf_dyn_c3d   : 3D eddy viscosity coefficient initialization
-   !!   ldf_dyn_c2d   : 2D eddy viscosity coefficient initialization
-   !!   ldf_dyn_c1d   : 1D eddy viscosity coefficient initialization
+   !!            3.7  ! 2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification,
+   !!                 !                                  add velocity dependent coefficient and optional read in file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ldf_dyn_init  : initialization, namelist read, and parameters control
+   !!   ldf_dyn       : update lateral eddy viscosity coefficients at each time step 
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers   
    USE dom_oce         ! ocean space and time domain 
-   USE ldfdyn_oce      ! ocean dynamics lateral physics
    USE phycst          ! physical constants
-   USE ldfslp          ! ???
-   USE ioipsl
+   USE ldfc1d_c2d      ! lateral diffusion: 1D and 2D cases
+   !
    USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module for ehanced bottom friction file
+   USE timing          ! Timing
    USE lib_mpp         ! distribued memory computing library
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
@@ -28,14 +29,30 @@
    PRIVATE
 
-   PUBLIC   ldf_dyn_init   ! called by opa.F90
-
-  INTERFACE ldf_zpf
-     MODULE PROCEDURE ldf_zpf_1d, ldf_zpf_1d_3d, ldf_zpf_3d
-  END INTERFACE
+   PUBLIC   ldf_dyn_init   ! called by nemogcm.F90
+   PUBLIC   ldf_dyn        ! called by step.F90
+
+   !                                                !!* Namelist namdyn_ldf : lateral mixing on momentum *
+   LOGICAL , PUBLIC ::   ln_dynldf_lap   !: laplacian operator
+   LOGICAL , PUBLIC ::   ln_dynldf_blp   !: bilaplacian operator
+   LOGICAL , PUBLIC ::   ln_dynldf_lev   !: iso-level direction
+   LOGICAL , PUBLIC ::   ln_dynldf_hor   !: horizontal (geopotential) direction
+   LOGICAL , PUBLIC ::   ln_dynldf_iso   !: iso-neutral direction
+   INTEGER , PUBLIC ::   nn_ahm_ijk_t    !: choice of time & space variations of the lateral eddy viscosity coef.
+   REAL(wp), PUBLIC ::   rn_ahm_0        !: lateral laplacian eddy viscosity            [m2/s]
+   REAL(wp), PUBLIC ::   rn_ahm_b        !: lateral laplacian background eddy viscosity [m2/s]
+   REAL(wp), PUBLIC ::   rn_bhm_0        !: lateral bilaplacian eddy viscosity          [m4/s]
+
+   LOGICAL , PUBLIC ::   l_ldfdyn_time   !: flag for time variation of the lateral eddy viscosity coef.
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahmt, ahmf   !: eddy diffusivity coef. at U- and V-points   [m2/s or m4/s]
+
+   REAL(wp) ::   r1_12   = 1._wp / 12._wp    ! =1/12
+   REAL(wp) ::   r1_4    = 0.25_wp           ! =1/4
+   REAL(wp) ::   r1_288  = 1._wp / 288._wp   ! =1/( 12^2 * 2 )
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -49,29 +66,27 @@
       !! ** Purpose :   set the horizontal ocean dynamics physics
       !!
-      !! ** Method  :  
-      !!      -  default option : ahm = constant coef. = rn_ahm_0 (namelist)
-      !!      - 'key_dynldf_c1d': ahm = F(depth)                     see ldf_dyn_c1d.h90
-      !!      - 'key_dynldf_c2d': ahm = F(latitude,longitude)        see ldf_dyn_c2d.h90
-      !!      - 'key_dynldf_c3d': ahm = F(latitude,longitude,depth)  see ldf_dyn_c3d.h90
-      !!
-      !!      N.B. User defined include files.  By default, 3d and 2d coef.
-      !!      are set to a constant value given in the namelist and the 1d
-      !!      coefficients are initialized to a hyperbolic tangent vertical
-      !!      profile.
-      !!
-      !! Reference :   Madec, G. and M. Imbard, 1996: Climate Dynamics, 12, 381-388.
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio         ! ???
-      INTEGER ::   ios            ! Local : output status for namelist read
-      LOGICAL ::   ll_print = .FALSE.    ! Logical flag for printing viscosity coef.
-      !! 
-      NAMELIST/namdyn_ldf/ ln_dynldf_lap  , ln_dynldf_bilap,                  &
-         &                 ln_dynldf_level, ln_dynldf_hor  , ln_dynldf_iso,   &
-         &                 rn_ahm_0_lap   , rn_ahmb_0      , rn_ahm_0_blp ,   &
-         &                 rn_cmsmag_1    , rn_cmsmag_2    , rn_cmsh,         &
-         &                 rn_ahm_m_lap   , rn_ahm_m_blp
-
-   !!----------------------------------------------------------------------
-
+      !! ** Method  :   the eddy viscosity coef. specification depends on:
+      !!              - the operator:
+      !!             ln_dynldf_lap = T     laplacian operator
+      !!             ln_dynldf_blp = T   bilaplacian operator
+      !!              - the parameter nn_ahm_ijk_t:
+      !!    nn_ahm_ijk_t  =  0 => = constant
+      !!                  = 10 => = F(z) :     = constant with a reduction of 1/4 with depth 
+      !!                  =-20 => = F(i,j)     = shape read in 'eddy_viscosity.nc' file
+      !!                  = 20    = F(i,j)     = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case)
+      !!                  =-30 => = F(i,j,k)   = shape read in 'eddy_viscosity.nc'  file
+      !!                  = 30    = F(i,j,k)   = 2D (case 20) + decrease with depth (case 10)
+      !!                  = 31    = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator
+      !!                                                           or |u|e^3/12 bilaplacian operator )
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk                ! dummy loop indices
+      INTEGER  ::   ierr, inum, ios   ! local integer
+      REAL(wp) ::   zah0              ! local scalar
+      !
+      NAMELIST/namdyn_ldf/ ln_dynldf_lap, ln_dynldf_blp,                  &
+         &                 ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso,   &
+         &                 nn_ahm_ijk_t , rn_ahm_0, rn_ahm_b, rn_bhm_0
+      !!----------------------------------------------------------------------
+      !
       REWIND( numnam_ref )              ! Namelist namdyn_ldf in reference namelist : Lateral physics
       READ  ( numnam_ref, namdyn_ldf, IOSTAT = ios, ERR = 901)
@@ -88,210 +103,191 @@
          WRITE(numout,*) '~~~~~~~'
          WRITE(numout,*) '   Namelist namdyn_ldf : set lateral mixing parameters'
-         WRITE(numout,*) '      laplacian operator                      ln_dynldf_lap   = ', ln_dynldf_lap
-         WRITE(numout,*) '      bilaplacian operator                    ln_dynldf_bilap = ', ln_dynldf_bilap
-         WRITE(numout,*) '      iso-level                               ln_dynldf_level = ', ln_dynldf_level
-         WRITE(numout,*) '      horizontal (geopotential)               ln_dynldf_hor   = ', ln_dynldf_hor
-         WRITE(numout,*) '      iso-neutral                             ln_dynldf_iso   = ', ln_dynldf_iso
-         WRITE(numout,*) '      horizontal laplacian eddy viscosity     rn_ahm_0_lap    = ', rn_ahm_0_lap
-         WRITE(numout,*) '      background viscosity                    rn_ahmb_0       = ', rn_ahmb_0
-         WRITE(numout,*) '      horizontal bilaplacian eddy viscosity   rn_ahm_0_blp    = ', rn_ahm_0_blp
-         WRITE(numout,*) '      upper limit for laplacian eddy visc     rn_ahm_m_lap    = ', rn_ahm_m_lap
-         WRITE(numout,*) '      upper limit for bilap eddy viscosity    rn_ahm_m_blp    = ', rn_ahm_m_blp
-
-      ENDIF
-
-      ahm0     = rn_ahm_0_lap              ! OLD namelist variables defined from DOCTOR namelist variables
-      ahmb0    = rn_ahmb_0
-      ahm0_blp = rn_ahm_0_blp
-
-      ! ... check of lateral diffusive operator on tracers
-      !           ==> will be done in trazdf module
-
-      ! ... Space variation of eddy coefficients
-      ioptio = 0
-#if defined key_dynldf_c3d
-      IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( latitude, longitude, depth)'
-      ioptio = ioptio+1
-#endif
-#if defined key_dynldf_c2d
-      IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( latitude, longitude)'
-      ioptio = ioptio+1
-#endif
-#if defined key_dynldf_c1d
-      IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( depth )'
-      ioptio = ioptio+1
-      IF( ln_sco ) CALL ctl_stop( 'key_dynldf_c1d cannot be used in s-coordinate (ln_sco)' )
-#endif
-      IF( ioptio == 0 ) THEN
-          IF(lwp) WRITE(numout,*) '   momentum mixing coef. = constant  (default option)'
-        ELSEIF( ioptio > 1 ) THEN
-           CALL ctl_stop( 'use only one of the following keys: key_dynldf_c3d, key_dynldf_c2d, key_dynldf_c1d' )
-      ENDIF
-
-
-      IF( ln_dynldf_bilap ) THEN
-         IF(lwp) WRITE(numout,*) '   biharmonic momentum diffusion'
-         IF( .NOT. ln_dynldf_lap ) ahm0 = ahm0_blp   ! Allow spatially varying coefs, which use ahm0 as input
-         IF( ahm0_blp > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be negative' )
-      ELSE
-         IF(lwp) WRITE(numout,*) '   harmonic momentum diff. (default)'
-         IF( ahm0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be positive' )
-      ENDIF
-
-
-      ! Lateral eddy viscosity
-      ! ======================
-#if defined key_dynldf_c3d
-      CALL ldf_dyn_c3d( ll_print )   ! ahm = 3D coef. = F( longitude, latitude, depth )
-#elif defined key_dynldf_c2d
-      CALL ldf_dyn_c2d( ll_print )   ! ahm = 1D coef. = F( longitude, latitude )
-#elif defined key_dynldf_c1d
-      CALL ldf_dyn_c1d( ll_print )   ! ahm = 1D coef. = F( depth )
-#else
-                                     ! Constant coefficients
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'inildf: constant eddy viscosity coef. '
-      IF(lwp) WRITE(numout,*) '~~~~~~'
-      IF(lwp) WRITE(numout,*) '        ahm1 = ahm2 = ahm0 =  ',ahm0
-#endif
-     nkahm_smag = 0
-#if defined key_dynldf_smag
-     nkahm_smag = 1
-#endif
-
+         !
+         WRITE(numout,*) '      type :'
+         WRITE(numout,*) '         laplacian operator                   ln_dynldf_lap = ', ln_dynldf_lap
+         WRITE(numout,*) '         bilaplacian operator                 ln_dynldf_blp = ', ln_dynldf_blp
+         !
+         WRITE(numout,*) '      direction of action :'
+         WRITE(numout,*) '         iso-level                            ln_dynldf_lev = ', ln_dynldf_lev
+         WRITE(numout,*) '         horizontal (geopotential)            ln_dynldf_hor = ', ln_dynldf_hor
+         WRITE(numout,*) '         iso-neutral                          ln_dynldf_iso = ', ln_dynldf_iso
+         !
+         WRITE(numout,*) '      coefficients :'
+         WRITE(numout,*) '         type of time-space variation         nn_ahm_ijk_t  = ', nn_ahm_ijk_t
+         WRITE(numout,*) '         lateral laplacian eddy viscosity     rn_ahm_0_lap  = ', rn_ahm_0, ' m2/s'
+         WRITE(numout,*) '         background viscosity (iso case)      rn_ahm_b      = ', rn_ahm_b, ' m2/s'
+         WRITE(numout,*) '         lateral bilaplacian eddy viscosity   rn_ahm_0_blp  = ', rn_bhm_0, ' m4/s'
+      ENDIF
+
+      !                                ! Parameter control
+      IF( .NOT.ln_dynldf_lap .AND. .NOT.ln_dynldf_blp ) THEN
+         IF(lwp) WRITE(numout,*) '   No viscous operator selected. ahmt and ahmf are not allocated'
+         l_ldfdyn_time = .FALSE.
+         RETURN
+      ENDIF
+      !
+      IF( ln_dynldf_blp .AND. ln_dynldf_iso ) THEN     ! iso-neutral bilaplacian not implemented
+         CALL ctl_stop( 'dyn_ldf_init: iso-neutral bilaplacian not coded yet' ) 
+      ENDIF
+
+      ! ... Space/Time variation of eddy coefficients
+      !                                               ! allocate the ahm arrays
+      ALLOCATE( ahmt(jpi,jpj,jpk) , ahmf(jpi,jpj,jpk) , STAT=ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays')
+      !
+      ahmt(:,:,jpk) = 0._wp                           ! last level always 0  
+      ahmf(:,:,jpk) = 0._wp
+      !
+      !                                               ! value of eddy mixing coef.
+      IF    ( ln_dynldf_lap ) THEN   ;   zah0 =      rn_ahm_0         !   laplacian operator
+      ELSEIF( ln_dynldf_blp ) THEN   ;   zah0 = ABS( rn_bhm_0 )       ! bilaplacian operator
+      ELSE                                                                  ! NO viscous  operator
+         CALL ctl_warn( 'ldf_dyn_init: No lateral viscous operator used ' )
+      ENDIF
+      !
+      l_ldfdyn_time = .FALSE.                         ! no time variation except in case defined below
+      !
+      IF( ln_dynldf_lap .OR. ln_dynldf_blp ) THEN     ! only if a lateral diffusion operator is used
+         !
+         SELECT CASE(  nn_ahm_ijk_t  )                ! Specification of space time variations of ahmt, ahmf
+         !
+         CASE(   0  )      !==  constant  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = constant '
+            ahmt(:,:,:) = zah0 * tmask(:,:,:)
+            ahmf(:,:,:) = zah0 * fmask(:,:,:)
+            !
+         CASE(  10  )      !==  fixed profile  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( depth )'
+            ahmt(:,:,1) = zah0 * tmask(:,:,1)                      ! constant surface value
+            ahmf(:,:,1) = zah0 * fmask(:,:,1)
+            CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf )
+            !
+         CASE ( -20 )      !== fixed horizontal shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F(i,j) read in eddy_viscosity.nc file'
+            CALL iom_open( 'eddy_viscosity_2D.nc', inum )
+            CALL iom_get ( inum, jpdom_data, 'ahmt_2d', ahmt(:,:,1) )
+            CALL iom_get ( inum, jpdom_data, 'ahmf_2d', ahmf(:,:,1) )
+            CALL iom_close( inum )
+!!gm Question : info for LAP or BLP case  to take into account the SQRT in the bilaplacian case ???
+!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ????
+!!              better:  check that the max is <=1  i.e. it is a shape from 0 to 1, not a coef that has physical dimension
+            DO jk = 2, jpkm1
+               ahmt(:,:,jk) = ahmt(:,:,1) * tmask(:,:,jk)
+               ahmf(:,:,jk) = ahmf(:,:,1) * fmask(:,:,jk)
+            END DO
+            !
+         CASE(  20  )      !== fixed horizontal shape  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap. or blp. case)'
+            IF( ln_dynldf_lap )   CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor
+            IF( ln_dynldf_blp )   CALL ldf_c2d( 'DYN', 'BLP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor^3
+            !
+         CASE( -30  )      !== fixed 3D shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file'
+            CALL iom_open( 'eddy_viscosity_3D.nc', inum )
+            CALL iom_get ( inum, jpdom_data, 'ahmt_3d', ahmt )
+            CALL iom_get ( inum, jpdom_data, 'ahmf_3d', ahmf )
+            CALL iom_close( inum )
+!!gm Question : info for LAP or BLP case  to take into account the SQRT in the bilaplacian case ????
+!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ????
+            DO jk = 1, jpkm1
+               ahmt(:,:,jk) = ahmt(:,:,jk) * tmask(:,:,jk)
+               ahmf(:,:,jk) = ahmf(:,:,jk) * fmask(:,:,jk)
+            END DO
+            !
+         CASE(  30  )       !==  fixed 3D shape  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth )'
+            IF( ln_dynldf_lap )   CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor
+            IF( ln_dynldf_blp )   CALL ldf_c2d( 'DYN', 'BLP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor
+            !                                                    ! reduction with depth
+            CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf )
+            !
+         CASE(  31  )       !==  time varying 3D field  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth , time )'
+            IF(lwp) WRITE(numout,*) '                                proportional to the velocity : |u|e/12 or |u|e^3/12'
+            !
+            l_ldfdyn_time = .TRUE.     ! will be calculated by call to ldf_dyn routine in step.F90
+            !
+         CASE DEFAULT
+            CALL ctl_stop('ldf_dyn_init: wrong choice for nn_ahm_ijk_t, the type of space-time variation of ahm')
+         END SELECT
+         !
+         IF( ln_dynldf_blp .AND. .NOT. l_ldfdyn_time ) THEN       ! bilapcian and no time variation:
+            ahmt(:,:,:) = SQRT( ahmt(:,:,:) )                     ! take the square root of the coefficient
+            ahmf(:,:,:) = SQRT( ahmf(:,:,:) )
+         ENDIF
+         !
+      ENDIF
       !
    END SUBROUTINE ldf_dyn_init
 
-#if defined key_dynldf_c3d
-#   include "ldfdyn_c3d.h90"
-#elif defined key_dynldf_c2d
-#   include "ldfdyn_c2d.h90"
-#elif defined key_dynldf_c1d
-#   include "ldfdyn_c1d.h90"
-#endif
-
-
-   SUBROUTINE ldf_zpf_1d( ld_print, pdam, pwam, pbot, pdep, pah )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_zpf  ***
-      !!                   
-      !! ** Purpose :   vertical adimensional profile for eddy coefficient
-      !!
-      !! ** Method  :   1D eddy viscosity coefficients ( depth )
-      !!----------------------------------------------------------------------
-      LOGICAL , INTENT(in   )                 ::   ld_print   ! If true, output arrays on numout
-      REAL(wp), INTENT(in   )                 ::   pdam       ! depth of the inflection point
-      REAL(wp), INTENT(in   )                 ::   pwam       ! width of inflection
-      REAL(wp), INTENT(in   )                 ::   pbot       ! bottom value (0<pbot<= 1)
-      REAL(wp), INTENT(in   ), DIMENSION(jpk) ::   pdep       ! depth of the gridpoint (T, U, V, F)
-      REAL(wp), INTENT(inout), DIMENSION(jpk) ::   pah        ! adimensional vertical profile
-      !!
-      INTEGER  ::   jk           ! dummy loop indices
-      REAL(wp) ::   zm00, zm01, zmhb, zmhs       ! temporary scalars
-      !!----------------------------------------------------------------------
-
-      zm00 = TANH( ( pdam - gdept_1d(1    ) ) / pwam )
-      zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam )
-      zmhs = zm00 / zm01
-      zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01
-
-      DO jk = 1, jpk
-         pah(jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(jk) ) / pwam )  )
-      END DO
-
-      IF(lwp .AND. ld_print ) THEN      ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm profile : '
-         WRITE(numout,*)
-         WRITE(numout,'("  jk      ahm       ","  depth t-level " )')
-         DO jk = 1, jpk
-            WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(jk), pdep(jk)
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE ldf_zpf_1d
-
-
-   SUBROUTINE ldf_zpf_1d_3d( ld_print, pdam, pwam, pbot, pdep, pah )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_zpf  ***
-      !!
-      !! ** Purpose :   vertical adimensional profile for eddy coefficient
-      !!
-      !! ** Method  :   1D eddy viscosity coefficients ( depth )
-      !!----------------------------------------------------------------------
-      LOGICAL , INTENT(in   )                         ::   ld_print   ! If true, output arrays on numout
-      REAL(wp), INTENT(in   )                         ::   pdam       ! depth of the inflection point
-      REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection
-      REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1)
-      REAL(wp), INTENT(in   ), DIMENSION          (:) ::   pdep       ! depth of the gridpoint (T, U, V, F)
-      REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile
-      !!
-      INTEGER  ::   jk           ! dummy loop indices
-      REAL(wp) ::   zm00, zm01, zmhb, zmhs, zcf  ! temporary scalars
-      !!----------------------------------------------------------------------
-
-      zm00 = TANH( ( pdam - gdept_1d(1    ) ) / pwam )
-      zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam )
-      zmhs = zm00 / zm01
-      zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01
-
-      DO jk = 1, jpk
-         zcf = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(jk) ) / pwam )  )
-         pah(:,:,jk) = zcf
-      END DO
-
-      IF(lwp .AND. ld_print ) THEN      ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm profile : '
-         WRITE(numout,*)
-         WRITE(numout,'("  jk      ahm       ","  depth t-level " )')
-         DO jk = 1, jpk
-            WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(1,1,jk), pdep(jk)
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE ldf_zpf_1d_3d
-
-
-   SUBROUTINE ldf_zpf_3d( ld_print, pdam, pwam, pbot, pdep, pah )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_zpf  ***
-      !!
-      !! ** Purpose :   vertical adimensional profile for eddy coefficient
-      !!
-      !! ** Method  :   3D for partial step or s-coordinate
-      !!----------------------------------------------------------------------
-      LOGICAL , INTENT(in   )                         ::   ld_print   ! If true, output arrays on numout
-      REAL(wp), INTENT(in   )                         ::   pdam       ! depth of the inflection point
-      REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection
-      REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1)
-      REAL(wp), INTENT(in   ), DIMENSION      (:,:,:) ::   pdep       ! dep of the gridpoint (T, U, V, F)
-      REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile
-      !!
-      INTEGER  ::   jk           ! dummy loop indices
-      REAL(wp) ::   zm00, zm01, zmhb, zmhs       ! temporary scalars
-      !!----------------------------------------------------------------------
-
-      zm00 = TANH( ( pdam - gdept_1d(1    ) ) / pwam )   
-      zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam )
-      zmhs = zm00 / zm01
-      zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01
-
-      DO jk = 1, jpk
-         pah(:,:,jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(:,:,jk) ) / pwam )  )
-      END DO
-
-      IF(lwp .AND. ld_print ) THEN      ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm profile : '
-         WRITE(numout,*)
-         WRITE(numout,'("  jk      ahm       ","  depth t-level " )')
-         DO jk = 1, jpk
-            WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(1,1,jk), pdep(1,1,jk)
-         END DO
-      ENDIF
-      !
-   END SUBROUTINE ldf_zpf_3d
+
+   SUBROUTINE ldf_dyn( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_dyn  ***
+      !! 
+      !! ** Purpose :   update at kt the momentum lateral mixing coeff. (ahmt and ahmf)
+      !!
+      !! ** Method  :   time varying eddy viscosity coefficients:
+      !!
+      !!    nn_ahm_ijk_t = 31    ahmt, ahmf = F(i,j,k,t) = F(local velocity) 
+      !!                         ( |u|e /12  or  |u|e^3/12 for laplacian or bilaplacian operator )
+      !!                BLP case : sqrt of the eddy coef, since bilaplacian is en re-entrant laplacian
+      !!
+      !! ** action  :    ahmt, ahmf   update at each time step
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! time step index
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zu2pv2_ij_p1, zu2pv2_ij, zu2pv2_ij_m1, zetmax, zefmax   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_dyn')
+      !
+      SELECT CASE(  nn_ahm_ijk_t  )       !== Eddy vicosity coefficients ==!
+      !
+      CASE(  31  )       !==  time varying 3D field  ==!   = F( local velocity )
+         !
+         IF( ln_dynldf_lap   ) THEN          !   laplacian operator : |u| e /12 = |u/144| e
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk)
+                     zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk)
+                     zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk)
+                     zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) )
+                     zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) )
+                     ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zetmax * tmask(ji,jj,jk)      ! 288= 12*12 * 2
+                     ahmf(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zefmax * fmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ELSEIF( ln_dynldf_blp ) THEN      ! bilaplacian operator : sqrt( |u| e^3 /12 ) = sqrt( |u/144| e ) * e
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk)
+                     zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk)
+                     zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk)
+                     zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) )
+                     zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) )
+                     ahmt(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zetmax  ) * zetmax * tmask(ji,jj,jk)
+                     ahmf(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zefmax  ) * zefmax * fmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         !
+         CALL lbc_lnk( ahmt, 'T', 1. )   ;   CALL lbc_lnk( ahmf, 'F', 1. )
+         !
+      END SELECT
+      !
+      CALL iom_put( "ahmt_2d", ahmt(:,:,1) )   ! surface u-eddy diffusivity coeff.
+      CALL iom_put( "ahmf_2d", ahmf(:,:,1) )   ! surface v-eddy diffusivity coeff.
+      CALL iom_put( "ahmt_3d", ahmt(:,:,:) )   ! 3D      u-eddy diffusivity coeff.
+      CALL iom_put( "ahmf_3d", ahmf(:,:,:) )   ! 3D      v-eddy diffusivity coeff.
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_dyn')
+      !
+   END SUBROUTINE ldf_dyn
 
    !!======================================================================
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90	(revision 6807)
+++ 	(revision )
@@ -1,124 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                     ***  ldfdyn_c1d.h90  ***
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_dyn_c1d( ld_print )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_dyn_c1d  ***
-      !!                   
-      !! ** Purpose :   initializations of the horizontal ocean physics
-      !!
-      !! ** Method  :   1D eddy viscosity coefficients ( depth )
-      !!      ahm3, ahm4 never used
-      !!      harmonic   operator : ahm1 defined at T-level
-      !!      biharmonic operator : ahm2 defined at T-level
-      !!      isopycnal or geopotential harmonic operator
-      !!                                      : ahm1 defined at T-level
-      !!                                      : ahm2 defined at w-level
-      !!
-      !!----------------------------------------------------------------------
-      LOGICAL, INTENT(in) :: ld_print   ! If true, output arrays on numout
-      !
-      INTEGER  ::   jk   ! dummy loop indice
-      REAL(wp) ::   zdam,  zwam,  zm00,  zm01,  zmhf,  zmhs
-      REAL(wp) ::   zdam2, zwam2, zm200, zm201, zmh2f, zmh2s
-      REAL(wp) ::   zahmf, zahms
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'inildf: 1D eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~  --'
-
-      ! Set ahm1 for laplacian     (always at t-level)
-      ! =============
-      ! (USER: modify ahm1 following your desiderata)
-
-      ! initialization of the profile
-      ! ahms, ahmf: surface and bottom values
-      zahms = ahm0
-      zahmf = ahm0/4.
-      ! zdam, zwam: depth of the inflection pt and width of inflection
-      zdam  = -300.
-      zwam  =  300.
-      ! computation coefficients
-      zm00 = TANH( (0-zdam)/zwam )
-      zm01 = TANH( (-fsdept(1,1,jpk)-zdam)/zwam )
-      zmhf = (zahms-zahmf)/(zm00-zm01)
-      zmhs = zahms-zmhf * zm00
-
-      ! Set ahm2 for bilaplacian   (always at t-level)
-      ! =============
-      ! (USER: modify ahm2 following your desiderata)
-
-      ! initialization of the profile
-      ! ahms, ahmf: surface and bottom values
-      zahm2s = ahm0_blp
-      zahm2f = ahm0_blp/4.
-      ! zdam, zwam: depth of the inflection pt and width of inflection
-      zdam2  = -300.
-      zwam2  =  300.
-      ! computation coefficients
-      zm200 = TANH( (0-zdam2)/zwam2 )
-      zm201 = TANH( (-fsdept(1,1,jpk)-zdam2)/zwam2 )
-      zmh2f = (zahm2s-zahm2f)/(zm200-zm201)
-      zmh2s = zahm2s-zmh2f * zm00
-
-
-      ! set ahm1 and ahm2 at T-level
-      DO jk = 1, jpk
-         ahm1(jk) = zmhs  + zmhf  * TANH( (-fsdept(1,1,jk)-zdam ) / zwam  )
-         ahm2(jk) = zmh2s + zmh2f * TANH( (-fsdept(1,1,jk)-zdam2) / zwam2 )
-      END DO
-
-      ! Control print
-      IF(lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm profile (laplacian): '
-         WRITE(numout,*)
-         WRITE(numout,9100)
-         DO jk = 1, jpk
-            WRITE(numout,9110) jk, ahm1(jk), fsdept(1,1,jk)
-         END DO
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm profile (bilaplacian): '
-         WRITE(numout,*)
-         WRITE(numout,9100)
-         DO jk = 1, jpk
-            WRITE(numout,9110) jk, ahm2(jk), fsdept(1,1,jk)
-         END DO
-      ENDIF
- 9100 FORMAT('  jk      ahm       ','  depth t-level ' )
- 9110 FORMAT(i6,2f12.4,3x,2f12.4)
-
-
-      ! Set ahm3=ahm4   (always defined at w-level)
-      ! =============
-
-      ! define ahm3 from the same vertical profile used for ahm4
-      ! (always defined at w-level)
-      ! (USER: modify ahm1 following your desiderata)
-
-      DO jk = 1, jpk
-         ahm3(jk) = zmhs + zmhf * TANH( (-fsdepw(1,1,jk)-zdam) / zwam )
-         ahm4(jk) = ahm3(jk)
-      END DO
-
-      ! Control print
-      IF(lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm3=ahm4 profile : '
-         WRITE(numout,*)
-         WRITE(numout,9120)
-         DO jk = 1, jpk
-            WRITE(numout,9110) jk, ahm3(jk), fsdepw(1,1,jk)
-         END DO
-      ENDIF
- 9120 FORMAT('  jk      ahm       ','  depth w-level ' )
-      !
-   END SUBROUTINE ldf_dyn_c1d
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90	(revision 6807)
+++ 	(revision )
@@ -1,523 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                      ***  ldfdyn_c2d.h90  ***
-   !!----------------------------------------------------------------------
-   !!   ldf_dyn_c2d  : set the lateral viscosity coefficients
-   !!   ldf_dyn_c2d_orca : specific case for orca r2 and r4
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_dyn_c2d( ld_print )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE ldf_dyn_c2d  ***
-      !!                  
-      !! ** Purpose :   initializations of the horizontal ocean physics
-      !!
-      !! ** Method :
-      !!      2D eddy viscosity coefficients ( longitude, latitude )
-      !!
-      !!       harmonic operator   : ahm1 is defined at t-point
-      !!                             ahm2 is defined at f-point
-      !!           + isopycnal     : ahm3 is defined at u-point
-      !!           or geopotential   ahm4 is defined at v-point
-      !!           iso-model level : ahm3, ahm4 not used
-      !!
-      !!       biharmonic operator : ahm3 is defined at u-point
-      !!                             ahm4 is defined at v-point
-      !!                           : ahm1, ahm2 not used
-      !!
-      !!----------------------------------------------------------------------
-      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout
-      !
-      INTEGER  ::   ji, jj
-      REAL(wp) ::   za00, zd_max, zetmax, zeumax, zefmax, zevmax
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'ldf_dyn_c2d : 2d lateral eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-
-      ! harmonic operator (ahm1, ahm2) : ( T- and F- points) (used for laplacian operators
-      ! ===============================                       whatever its orientation is)
-      IF( ln_dynldf_lap ) THEN
-         ! define ahm1 and ahm2 at the right grid point position
-         ! (USER: modify ahm1 and ahm2 following your desiderata)
-
-         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
-         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
-
-         IF(lwp) WRITE(numout,*) '              laplacian operator: ahm proportional to e1'
-         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
-
-         za00 = ahm0 / zd_max
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zetmax = MAX( e1t(ji,jj), e2t(ji,jj) )
-               zefmax = MAX( e1f(ji,jj), e2f(ji,jj) )
-               ahm1(ji,jj) = za00 * zetmax
-               ahm2(ji,jj) = za00 * zefmax
-            END DO
-         END DO
-
-         IF( ln_dynldf_iso ) THEN
-            IF(lwp) WRITE(numout,*) '              Caution, as implemented now, the isopycnal part of momentum'
-            IF(lwp) WRITE(numout,*) '                 mixing use aht0 as eddy viscosity coefficient. Thus, it is'
-            IF(lwp) WRITE(numout,*) '                 uniform and you must be sure that your ahm is greater than'
-            IF(lwp) WRITE(numout,*) '                 aht0 everywhere in the model domain.'
-         ENDIF
-
-         ! Special case for ORCA R1, R2 and R4 configurations (overwrite the value of ahm1 ahm2)
-         ! ==============================================
-         IF( cp_cfg == "orca" .AND. ( jp_cfg == 2 .OR. jp_cfg == 4 ) )   CALL ldf_dyn_c2d_orca( ld_print )
-         IF( cp_cfg == "orca" .AND.   jp_cfg == 1)                       CALL ldf_dyn_c2d_orca_R1( ld_print )
-
-         ! Control print
-         IF( lwp .AND. ld_print ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: 2D ahm1 array'
-            CALL prihre(ahm1,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: 2D ahm2 array'
-            CALL prihre(ahm2,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         ENDIF
-      ENDIF
-
-      ! biharmonic operator (ahm3, ahm4) : at U- and V-points (used for bilaplacian operator
-      ! =================================                      whatever its orientation is)
-      IF( ln_dynldf_bilap ) THEN
-         ! (USER: modify ahm3 and ahm4 following your desiderata)
-         ! Here: ahm is proportional to the cube of the maximum of the gridspacing
-         !       in the to horizontal direction
-
-         zd_max = MAX( MAXVAL( e1u(:,:) ), MAXVAL( e2u(:,:) ) )
-         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
-
-         IF(lwp) WRITE(numout,*) '              bi-laplacian operator: ahm proportional to e1**3 '
-         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
-
-         za00 = ahm0_blp / ( zd_max * zd_max * zd_max )
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zeumax = MAX( e1u(ji,jj), e2u(ji,jj) )
-               zevmax = MAX( e1v(ji,jj), e2v(ji,jj) )
-               ahm3(ji,jj) = za00 * zeumax * zeumax * zeumax
-               ahm4(ji,jj) = za00 * zevmax * zevmax * zevmax
-            END DO
-         END DO
-
-         ! Control print
-         IF( lwp .AND. ld_print ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahm3 array'
-            CALL prihre(ahm3,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahm4 array'
-            CALL prihre(ahm4,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         ENDIF
-      ENDIF
-      !
-   END SUBROUTINE ldf_dyn_c2d
-
-
-   SUBROUTINE ldf_dyn_c2d_orca( ld_print )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE ldf_dyn_c2d  ***
-      !!
-      !!                   **** W A R N I N G ****
-      !!
-      !!                ORCA R2 and R4 configurations
-      !!                  
-      !!                   **** W A R N I N G ****
-      !!                  
-      !! ** Purpose :   initializations of the lateral viscosity for orca R2
-      !!
-      !! ** Method  :   blah blah blah...
-      !!
-      !!----------------------------------------------------------------------
-      USE ldftra_oce, ONLY:   aht0
-      USE iom
-      !
-      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
-      !
-      INTEGER  ::   ji, jj, jn   ! dummy loop indices
-      INTEGER  ::   inum, iim, ijm            ! local integers
-      INTEGER  ::   ifreq, il1, il2, ij, ii
-      INTEGER  ::   ijpt0,ijpt1, ierror
-      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk
-      CHARACTER (len=15) ::   clexp
-      INTEGER,     POINTER, DIMENSION(:,:)  :: icof
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d  ! temporary array to read ahmcoef file
-      !!----------------------------------------------------------------------
-      !                                
-      CALL wrk_alloc( jpi   , jpj   , icof  )
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~  --'
-      IF(lwp) WRITE(numout,*) '        orca ocean configuration'
-
-      IF( cp_cfg == "orca" .AND. cp_cfz == "antarctic" ) THEN
-!
-! 1.2 Modify ahm
-! --------------
-         IF(lwp)WRITE(numout,*) ' inildf: Antarctic ocean'
-         IF(lwp)WRITE(numout,*) '         no tropics, no reduction of ahm'
-         IF(lwp)WRITE(numout,*) '         north boundary increase'
-
-         ahm1(:,:) = ahm0
-         ahm2(:,:) = ahm0
-
-         ijpt0=max(1,min(49 -njmpp+1,jpj))
-         ijpt1=max(0,min(49-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*2.
-            ahm1(:,jj)=ahm0*2.
-         END DO
-         ijpt0=max(1,min(48 -njmpp+1,jpj))
-         ijpt1=max(0,min(48-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.9
-            ahm1(:,jj)=ahm0*1.75
-         END DO
-         ijpt0=max(1,min(47 -njmpp+1,jpj))
-         ijpt1=max(0,min(47-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.5
-            ahm1(:,jj)=ahm0*1.25
-         END DO
-         ijpt0=max(1,min(46 -njmpp+1,jpj))
-         ijpt1=max(0,min(46-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.1
-         END DO
-
-      ELSE IF( cp_cfg == "orca" .AND. cp_cfz == "arctic" ) THEN
-! 1.2 Modify ahm 
-! --------------
-         IF(lwp)WRITE(numout,*) ' inildf: Arctic ocean'
-         IF(lwp)WRITE(numout,*) '         no tropics, no reduction of ahm'
-         IF(lwp)WRITE(numout,*) '         south and west boundary increase'
-
-
-         ahm1(:,:) = ahm0
-         ahm2(:,:) = ahm0
-
-         ijpt0=max(1,min(98-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(98-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*2.
-            ahm1(:,jj)=ahm0*2.
-         END DO
-         ijpt0=max(1,min(99-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(99-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.9
-            ahm1(:,jj)=ahm0*1.75
-         END DO
-         ijpt0=max(1,min(100-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(100-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.5
-            ahm1(:,jj)=ahm0*1.25
-         END DO
-         ijpt0=max(1,min(101-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(101-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.1
-         END DO
-      ELSE
-         ! Read 2d integer array to specify western boundary increase in the
-         ! ===================== equatorial strip (20N-20S) defined at t-points
-         !
-         ALLOCATE( ztemp2d(jpi,jpj) )
-         ztemp2d(:,:) = 0.
-         CALL iom_open ( 'ahmcoef.nc', inum )
-         CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d)
-         icof(:,:)  = NINT(ztemp2d(:,:))
-         CALL iom_close( inum )
-         DEALLOCATE(ztemp2d)
-
-         ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator)
-         ! =================
-         ! define ahm1 and ahm2 at the right grid point position
-         ! (USER: modify ahm1 and ahm2 following your desiderata)
-
-
-         ! Decrease ahm to zahmeq m2/s in the tropics
-         ! (from 90 to 20 degre: ahm = constant
-         ! from 20 to  2.5 degre: ahm = decrease in (1-cos)/2
-         ! from  2.5 to  0 degre: ahm = constant
-         ! symmetric in the south hemisphere)
-
-         zahmeq = aht0
-
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( ABS( gphif(ji,jj) ) >= 20. ) THEN
-                  ahm2(ji,jj) =  ahm0
-               ELSEIF( ABS( gphif(ji,jj) ) <= 2.5 ) THEN
-                  ahm2(ji,jj) =  zahmeq
-               ELSE
-                  ahm2(ji,jj) = zahmeq + (ahm0-zahmeq)/2.   &
-                     * ( 1. - COS( rad * ( ABS(gphif(ji,jj))-2.5 ) * 180. / 17.5 ) )
-               ENDIF
-               IF( ABS( gphit(ji,jj) ) >= 20. ) THEN
-                  ahm1(ji,jj) =  ahm0
-               ELSEIF( ABS( gphit(ji,jj) ) <= 2.5 ) THEN
-                  ahm1(ji,jj) =  zahmeq
-               ELSE
-                  ahm1(ji,jj) = zahmeq + (ahm0-zahmeq)/2.   &
-                     * ( 1. - COS( rad * ( ABS(gphit(ji,jj))-2.5 ) * 180. / 17.5 ) )
-               ENDIF
-            END DO
-         END DO
-
-         ! increase along western boundaries of equatorial strip
-         ! t-point
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zcoft = FLOAT( icof(ji,jj) ) / 100.
-               ahm1(ji,jj) = zcoft * ahm0 + (1.-zcoft) * ahm1(ji,jj) 
-            END DO
-         END DO
-         ! f-point
-         icof(:,:) = icof(:,:) * tmask(:,:,1)
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1   ! NO vector opt.
-               zmsk = tmask(ji,jj+1,1) + tmask(ji+1,jj+1,1) + tmask(ji,jj,1) + tmask(ji,jj+1,1)
-               IF( zmsk == 0. ) THEN
-                  zcoff = 1.
-               ELSE
-                  zcoff = FLOAT( icof(ji,jj+1) + icof(ji+1,jj+1) + icof(ji,jj) + icof(ji,jj+1) )   &
-                     / (zmsk * 100.)
-               ENDIF
-               ahm2(ji,jj) = zcoff * ahm0 + (1.-zcoff) * ahm2(ji,jj)
-            END DO
-         END DO
-      ENDIF
-      
-      ! Lateral boundary conditions on ( ahm1, ahm2 )
-      !                                ==============
-      CALL lbc_lnk( ahm1, 'T', 1. )   ! T-point, unchanged sign
-      CALL lbc_lnk( ahm2, 'F', 1. )   ! F-point, unchanged sign
-
-      ! Control print
-      IF( lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: 2D ahm1 array'
-         CALL prihre(ahm1,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: 2D ahm2 array'
-         CALL prihre(ahm2,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi   , jpj   , icof  )
-      !
-   END SUBROUTINE ldf_dyn_c2d_orca
-
-
-   SUBROUTINE ldf_dyn_c2d_orca_R1( ld_print )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE ldf_dyn_c2d  ***
-      !!
-      !!                   **** W A R N I N G ****
-      !!
-      !!                ORCA R1 configuration
-      !!                  
-      !!                   **** W A R N I N G ****
-      !!                  
-      !! ** Purpose :   initializations of the lateral viscosity for orca R1
-      !!
-      !! ** Method  :   blah blah blah...
-      !!
-      !!----------------------------------------------------------------------
-      USE ldftra_oce, ONLY:   aht0
-      USE iom
-      !
-      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
-      !
-      INTEGER ::   ji, jj, jn      ! dummy loop indices
-      INTEGER ::   inum            ! temporary logical unit
-      INTEGER ::   iim, ijm
-      INTEGER ::   ifreq, il1, il2, ij, ii
-      INTEGER ::   ijpt0,ijpt1, ierror
-      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk, zam20s
-      CHARACTER (len=15) ::   clexp
-      INTEGER,     POINTER, DIMENSION(:,:)  :: icof
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d  ! temporary array to read ahmcoef file
-      !!----------------------------------------------------------------------
-      !                                
-      CALL wrk_alloc( jpi   , jpj   , icof  )
-      !                                
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~  --'
-      IF(lwp) WRITE(numout,*) '        orca_r1 configuration'
-
-      IF( cp_cfg == "orca" .AND. cp_cfz == "antarctic" ) THEN
-!
-! 1.2 Modify ahm
-! --------------
-         IF(lwp)WRITE(numout,*) ' inildf: Antarctic ocean'
-         IF(lwp)WRITE(numout,*) '         no tropics, no reduction of ahm'
-         IF(lwp)WRITE(numout,*) '         north boundary increase'
-
-         ahm1(:,:) = ahm0
-         ahm2(:,:) = ahm0
-
-         ijpt0=max(1,min(49 -njmpp+1,jpj))
-         ijpt1=max(0,min(49-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*2.
-            ahm1(:,jj)=ahm0*2.
-         END DO
-         ijpt0=max(1,min(48 -njmpp+1,jpj))
-         ijpt1=max(0,min(48-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.9
-            ahm1(:,jj)=ahm0*1.75
-         END DO
-         ijpt0=max(1,min(47 -njmpp+1,jpj))
-         ijpt1=max(0,min(47-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.5
-            ahm1(:,jj)=ahm0*1.25
-         END DO
-         ijpt0=max(1,min(46 -njmpp+1,jpj))
-         ijpt1=max(0,min(46-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.1
-         END DO
-
-      ELSE IF( cp_cfg == "orca" .AND. cp_cfz == "arctic" ) THEN
-! 1.2 Modify ahm 
-! --------------
-         IF(lwp)WRITE(numout,*) ' inildf: Arctic ocean'
-         IF(lwp)WRITE(numout,*) '         no tropics, no reduction of ahm'
-         IF(lwp)WRITE(numout,*) '         south and west boundary increase'
-
-
-         ahm1(:,:) = ahm0
-         ahm2(:,:) = ahm0
-
-         ijpt0=max(1,min(98-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(98-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*2.
-            ahm1(:,jj)=ahm0*2.
-         END DO
-         ijpt0=max(1,min(99-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(99-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.9
-            ahm1(:,jj)=ahm0*1.75
-         END DO
-         ijpt0=max(1,min(100-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(100-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.5
-            ahm1(:,jj)=ahm0*1.25
-         END DO
-         ijpt0=max(1,min(101-jpjzoom+1-njmpp+1,jpj))
-         ijpt1=max(0,min(101-jpjzoom+1-njmpp+1,jpj-1))
-         DO jj=ijpt0,ijpt1
-            ahm2(:,jj)=ahm0*1.1
-         END DO
-      ELSE
-         
-         ! Read 2d integer array to specify western boundary increase in the
-         ! ===================== equatorial strip (20N-20S) defined at t-points
-         ALLOCATE( ztemp2d(jpi,jpj) )
-         ztemp2d(:,:) = 0.
-         CALL iom_open ( 'ahmcoef.nc', inum )
-         CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d)
-         icof(:,:)  = NINT(ztemp2d(:,:))
-         CALL iom_close( inum )
-         DEALLOCATE(ztemp2d)
-
-         ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator)
-         ! =================
-         ! define ahm1 and ahm2 at the right grid point position
-         ! (USER: modify ahm1 and ahm2 following your desiderata)
-
-
-         ! Decrease ahm to zahmeq m2/s in the tropics
-         ! (from 90   to 20   degrees: ahm = scaled by local metrics
-         !  from 20   to  2.5 degrees: ahm = decrease in (1-cos)/2
-         !  from  2.5 to  0   degrees: ahm = constant
-         ! symmetric in the south hemisphere)
-
-         zahmeq = aht0
-         zam20s = ahm0*COS( rad * 20. )
-
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( ABS( gphif(ji,jj) ) >= 20. ) THEN
-                  !              leave as set in ldf_dyn_c2d
-               ELSEIF( ABS( gphif(ji,jj) ) <= 2.5 ) THEN
-                  ahm2(ji,jj) =  zahmeq
-               ELSE
-                  ahm2(ji,jj) =  zahmeq + (zam20s-zahmeq)/2.   &
-                     * ( 1. - COS( rad * ( ABS(gphif(ji,jj))-2.5 ) * 180. / 17.5 ) )
-               ENDIF
-               IF( ABS( gphit(ji,jj) ) >= 20. ) THEN
-                  !             leave as set in ldf_dyn_c2d
-               ELSEIF( ABS( gphit(ji,jj) ) <= 2.5 ) THEN
-                  ahm1(ji,jj) =  zahmeq
-               ELSE
-                  ahm1(ji,jj) =  zahmeq + (zam20s-zahmeq)/2.   &
-                     * ( 1. - COS( rad * ( ABS(gphit(ji,jj))-2.5 ) * 180. / 17.5 ) )
-               ENDIF
-            END DO
-         END DO
-
-         ! increase along western boundaries of equatorial strip
-         ! t-point
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               IF( ABS( gphit(ji,jj) ) < 20. ) THEN
-                  zcoft = FLOAT( icof(ji,jj) ) / 100.
-                  ahm1(ji,jj) = zcoft * ahm0 + (1.-zcoft) * ahm1(ji,jj) 
-               ENDIF
-            END DO
-         END DO
-         ! f-point
-         icof(:,:) = icof(:,:) * tmask(:,:,1)
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               IF( ABS( gphif(ji,jj) ) < 20. ) THEN
-                  zmsk = tmask(ji,jj+1,1) + tmask(ji+1,jj+1,1) + tmask(ji,jj,1) + tmask(ji,jj+1,1)
-                  IF( zmsk == 0. ) THEN
-                     zcoff = 1.
-                  ELSE
-                     zcoff = FLOAT( icof(ji,jj+1) + icof(ji+1,jj+1) + icof(ji,jj) + icof(ji,jj+1) )   &
-                        / (zmsk * 100.)
-                  ENDIF
-                  ahm2(ji,jj) = zcoff * ahm0 + (1.-zcoff) * ahm2(ji,jj)
-               ENDIF
-            END DO
-         END DO
-      ENDIF
-      
-      ! Lateral boundary conditions on ( ahm1, ahm2 )
-      !                                ==============
-      CALL lbc_lnk( ahm1, 'T', 1. )   ! T-point, unchanged sign
-      CALL lbc_lnk( ahm2, 'F', 1. )   ! F-point, unchanged sign
-
-      ! Control print
-      IF( lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: 2D ahm1 array'
-         CALL prihre(ahm1,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: 2D ahm2 array'
-         CALL prihre(ahm2,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi   , jpj   , icof  )
-      !
-   END SUBROUTINE ldf_dyn_c2d_orca_R1
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90	(revision 6807)
+++ 	(revision )
@@ -1,433 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                        ***  ldfdyn_c3d.h90  ***
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   'key_dynldf_c3d'             3D lateral eddy viscosity coefficients
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_dyn_c3d( ld_print )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_dyn_c3d  ***
-      !!                   
-      !! ** Purpose :   initializations of the horizontal ocean physics
-      !!
-      !! ** Method  :   3D eddy viscosity coef. ( longitude, latitude, depth )
-      !!       laplacian operator   : ahm1, ahm2 defined at T- and F-points
-      !!                              ahm2, ahm4 never used
-      !!       bilaplacian operator : ahm1, ahm2 never used
-      !!                           :  ahm3, ahm4 defined at U- and V-points
-      !!       ??? explanation of the default is missing
-      !!----------------------------------------------------------------------
-      USE ldftra_oce, ONLY :   aht0
-      USE iom
-      !!
-      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zr = 0.2     ! maximum of the reduction factor at the bottom ocean ( 0 < zr < 1 )
-      REAL(wp) ::   zh = 500.    ! depth of at which start the reduction ( > dept(1) )
-      REAL(wp) ::   zd_max       ! maximum grid spacing over the global domain
-      REAL(wp) ::   za00, zc, zd, zetmax, zefmax, zeumax, zevmax   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:) :: zcoef   
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpk, zcoef )
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'ldf_dyn_c3d : 3D lateral eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-
-      
-      ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operators
-      ! =================                       whatever its orientation is)
-      IF( ln_dynldf_lap ) THEN
-         ! define ahm1 and ahm2 at the right grid point position
-         ! (USER: modify ahm1 and ahm2 following your desiderata)
-
-         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
-         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
-
-         IF(lwp) WRITE(numout,*) '              laplacian operator: ahm proportional to e1'
-         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
-
-         za00 = ahm0 / zd_max
-
-         IF( ln_dynldf_iso ) THEN
-            IF(lwp) WRITE(numout,*) '              Caution, as implemented now, the isopycnal part of momentum'
-            IF(lwp) WRITE(numout,*) '                 mixing use aht0 as eddy viscosity coefficient. Thus, it is'
-            IF(lwp) WRITE(numout,*) '                 uniform and you must be sure that your ahm is greater than'
-            IF(lwp) WRITE(numout,*) '                 aht0 everywhere in the model domain.'
-         ENDIF
-
-         CALL ldf_zpf( .TRUE. , 1000., 500., 0.25, fsdept(:,:,:), ahm1 )   ! vertical profile
-         CALL ldf_zpf( .TRUE. , 1000., 500., 0.25, fsdept(:,:,:), ahm2 )   ! vertical profile
-         DO jk = 1,jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zetmax = MAX( e1t(ji,jj), e2t(ji,jj) )
-                  zefmax = MAX( e1f(ji,jj), e2f(ji,jj) )
-                  ahm1(ji,jj,jk) = za00 * zetmax * ahm1(ji,jj,jk)
-                  ahm2(ji,jj,jk) = za00 * zefmax * ahm2(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-
-         ! Special case for ORCA R1, R2 and R4 configurations (overwrite the value of ahm1 ahm2)
-         ! ==============================================
-         IF( cp_cfg == "orca" .AND. ( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) ) THEN 
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '              ORCA R1, R2 or R4: overwrite the previous definition of ahm'
-            IF(lwp) WRITE(numout,*) '              ================='
-            CALL ldf_dyn_c3d_orca( ld_print )
-         ENDIF
-
-      ENDIF
-      
-      ! Control print
-      IF(lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '         3D ahm1 array (k=1)'
-         CALL prihre( ahm1(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) '         3D ahm2 array (k=1)'
-         CALL prihre( ahm2(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
-      ENDIF
-
-
-      ! ahm3 and ahm4 at U- and V-points (used for bilaplacian operator
-      ! ================================  whatever its orientation is)
-      ! (USER: modify ahm3 and ahm4 following your desiderata)
-      ! Here: ahm is proportional to the cube of the maximum of the gridspacing
-      !       in the to horizontal direction
-
-      IF( ln_dynldf_bilap ) THEN
-
-         zd_max = MAX( MAXVAL( e1u(:,:) ), MAXVAL( e2u(:,:) ) )
-         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
-
-         IF(lwp) WRITE(numout,*) '              bi-laplacian operator: ahm proportional to e1**3 '
-         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
-
-         za00 = ahm0_blp / ( zd_max * zd_max * zd_max )
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zeumax = MAX( e1u(ji,jj), e2u(ji,jj) )
-               zevmax = MAX( e1v(ji,jj), e2v(ji,jj) )
-               ahm3(ji,jj,1) = za00 * zeumax * zeumax * zeumax
-               ahm4(ji,jj,1) = za00 * zevmax * zevmax * zevmax
-            END DO
-         END DO
-
-         zh = MAX( zh, fsdept(1,1,1) )   ! at least the first reach ahm0
-         IF( ln_zco ) THEN               ! z-coordinate, same profile everywhere
-            IF(lwp) WRITE(numout,'(36x," ahm ", 7x)')
-            DO jk = 1, jpk
-               IF( fsdept(1,1,jk) <= zh ) THEN
-                  zcoef(jk) = 1.e0
-               ELSE
-                  zcoef(jk) = 1.e0 + ( zr - 1.e0 )   &
-                     &               * (  1. - EXP( ( fsdept(1,1,jk   ) - zh ) / zh )  )   &
-                     &               / (  1. - EXP( ( fsdept(1,1,jpkm1) - zh ) / zh )  )
-               ENDIF
-               ahm3(:,:,jk) = ahm3(:,:,1) * zcoef(jk)
-               ahm4(:,:,jk) = ahm4(:,:,1) * zcoef(jk)
-               IF(lwp) WRITE(numout,'(34x,E7.2,8x,i3)') zcoef(jk) * ahm0, jk
-            END DO
-         ELSE                            ! partial steps or s-ccordinate
-            zc = MAXVAL( fsdept(:,:,jpkm1) )
-            IF( lk_mpp )   CALL mpp_max( zc )   ! max over the global domain
-
-            zc = 1. / (  1. - EXP( ( zc - zh ) / zh )  )
-            DO jk = 2, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     IF( fsdept(ji,jj,jk) <= zh ) THEN
-                        ahm3(ji,jj,jk) = ahm3(ji,jj,1)
-                        ahm4(ji,jj,jk) = ahm4(ji,jj,1)
-                     ELSE
-                        zd = 1.e0 + ( zr - 1.e0 ) * (  1. - EXP( ( fsdept(ji,jj,jk) - zh ) / zh )  ) * zc
-                        ahm3(ji,jj,jk) = ahm3(ji,jj,1) * zd
-                        ahm4(ji,jj,jk) = ahm4(ji,jj,1) * zd
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-            ahm3(:,:,jpk) = ahm3(:,:,jpkm1)
-            ahm4(:,:,jpk) = ahm4(:,:,jpkm1)
-            IF(lwp) WRITE(numout,'(36x," ahm ", 7x)')
-            DO jk = 1, jpk
-               IF(lwp) WRITE(numout,'(30x,E10.2,8x,i3)') ahm3(1,1,jk), jk
-            END DO
-         ENDIF
-
-         ! Control print
-         IF( lwp .AND. ld_print ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahm3 array at level 1'
-            CALL prihre(ahm3(:,:,1  ),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahm4 array at level 1'
-            CALL prihre(ahm4(:,:,jpk),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         ENDIF
-      ENDIF
-      !
-      CALL wrk_dealloc( jpk, zcoef )
-      !
-   END SUBROUTINE ldf_dyn_c3d
-
-
-   SUBROUTINE ldf_dyn_c3d_orca( ld_print )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_dyn_c3d  ***
-      !!                   
-      !! ** Purpose :   ORCA R1, R2 and R4 only
-      !!
-      !! ** Method  :   blah blah blah ....
-      !!----------------------------------------------------------------------
-      USE ldftra_oce, ONLY:   aht0
-      USE iom
-      !!
-      LOGICAL, INTENT(in) ::   ld_print   ! If true, output arrays on numout
-      !!
-      INTEGER ::   ji, jj, jk, jn      ! dummy loop indices
-      INTEGER ::   ii0, ii1, ij0, ij1  ! local integers
-      INTEGER ::   inum, iim, ijm      ! 
-      INTEGER ::   ifreq, il1, il2, ij, ii
-      REAL(wp) ::   zahmeq, zcoff, zcoft, zmsk   ! local scalars
-      REAL(wp) ::   zemax , zemin, zeref, zahmm
-      CHARACTER (len=15) ::   clexp
-      INTEGER , POINTER, DIMENSION(:,:)  :: icof
-      REAL(wp), POINTER, DIMENSION(:  )  :: zcoef   
-      REAL(wp), POINTER, DIMENSION(:,:)  :: zahm0
-      !
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ztemp2d  ! temporary array to read ahmcoef file
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi   , jpj   , icof  )
-      CALL wrk_alloc( jpk   ,         zcoef )
-      CALL wrk_alloc( jpi   , jpj   , zahm0 )
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'ldfdyn_c3d_orca : 3D eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
-      IF(lwp) WRITE(numout,*) '        orca R1, R2 or R4 configuration: reduced in the surface Eq. strip '
-
-      ! Read 2d integer array to specify western boundary increase in the
-      ! ===================== equatorial strip (20N-20S) defined at t-points
-      ALLOCATE( ztemp2d(jpi,jpj) )
-      ztemp2d(:,:) = 0.
-      CALL iom_open ( 'ahmcoef.nc', inum )
-      CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d)
-      icof(:,:)  = NINT(ztemp2d(:,:))
-      CALL iom_close( inum )
-      DEALLOCATE(ztemp2d)
-
-      ! Set ahm1 and ahm2
-      ! =================
-      
-      ! define ahm1 and ahm2 at the right grid point position
-      ! (USER: modify ahm1 and ahm2 following your desiderata)
-      ! biharmonic : ahm1 (ahm2) defined at u- (v-) point
-      ! harmonic   : ahm1 (ahm2) defined at t- (f-) point
-      
-      ! first level : as for 2D coefficients
-      
-      ! Decrease ahm to zahmeq m2/s in the tropics
-      ! (from 90 to 20 degre: ahm = constant
-      ! from 20 to  2.5 degre: ahm = decrease in (1-cos)/2
-      ! from  2.5 to  0 degre: ahm = constant
-      ! symmetric in the south hemisphere)
-      
-      IF( jp_cfg == 4 )   THEN
-         zahmeq = 5.0 * aht0
-         zahmm  = min( 160000.0, ahm0)
-         zemax = MAXVAL ( e1t(:,:) * e2t(:,:), tmask(:,:,1) .GE. 0.5 )
-         zemin = MINVAL ( e1t(:,:) * e2t(:,:), tmask(:,:,1) .GE. 0.5 )
-         zeref = MAXVAL ( e1t(:,:) * e2t(:,:),   &
-             &   tmask(:,:,1) .GE. 0.5 .AND. ABS(gphit(:,:)) .GT. 50. )
- 
-         DO jj = 1, jpj
-           DO ji = 1, jpi
-              zmsk = e1t(ji,jj) * e2t(ji,jj)
-              IF( abs(gphit(ji,jj)) .LE. 15 ) THEN 
-                 zahm0(ji,jj) = ahm0
-              ELSE 
-                 IF( zmsk .GE. zeref ) THEN 
-                    zahm0(ji,jj) = ahm0
-                 ELSE 
-                    zahm0(ji,jj) = zahmm + (ahm0-zahmm)*(1.0 -   &
-                        &          cos((rpi*0.5*(zmsk-zemin)/(zeref-zemin))))
-                 ENDIF 
-              ENDIF 
-           END DO 
-         END DO 
-      ENDIF
-
-      IF( jp_cfg == 2 )   THEN
-         zahmeq     = aht0
-         zahmm      = ahm0
-         zahm0(:,:) = ahm0
-      ENDIF
-
-      IF( jp_cfg == 1 )   THEN
-         zahmeq     = aht0  ! reduced to aht0 on equator; set to ahm0 if no tropical reduction is required
-         zahmm      = ahm0
-         zahm0(:,:) = ahm0
-      ENDIF
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ABS(gphif(ji,jj)) >= 20.) THEN
-               ahm2(ji,jj,1) =  zahm0(ji,jj)
-            ELSEIF( ABS(gphif(ji,jj)) <= 2.5) THEN
-               ahm2(ji,jj,1) =  zahmeq
-            ELSE
-               ahm2(ji,jj,1) = zahmeq + (zahm0(ji,jj)-zahmeq)/2.   &
-                  &            *(1.-COS( rad*(ABS(gphif(ji,jj))-2.5)*180./17.5 ) )
-            ENDIF
-            IF( ABS(gphit(ji,jj)) >= 20.) THEN
-               ahm1(ji,jj,1) =  zahm0(ji,jj)
-            ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN
-               ahm1(ji,jj,1) =  zahmeq
-            ELSE
-               ahm1(ji,jj,1) = zahmeq + (zahm0(ji,jj)-zahmeq)/2.   &
-                  &            *(1.-COS( rad*(ABS(gphit(ji,jj))-2.5)*180./17.5 ) )
-            ENDIF
-         END DO
-      END DO
-      
-      ! increase along western boundaries of equatorial strip
-      ! t-point
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            zcoft = float( icof(ji,jj) ) / 100.
-            ahm1(ji,jj,1) = zcoft * zahm0(ji,jj) + (1.-zcoft) * ahm1(ji,jj,1)
-         END DO
-      END DO
-      ! f-point
-      icof(:,:) = icof(:,:) * tmask(:,:,1)
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1   ! NO vector opt.
-            zmsk = tmask(ji,jj+1,1) + tmask(ji+1,jj+1,1) + tmask(ji,jj,1) + tmask(ji,jj+1,1)
-            IF( zmsk == 0. ) THEN
-               zcoff = 1.
-            ELSE
-               zcoff = FLOAT( icof(ji,jj+1) + icof(ji+1,jj+1) + icof(ji,jj) + icof(ji,jj+1) )   &
-                     / (zmsk * 100.)
-            ENDIF
-            ahm2(ji,jj,1) = zcoff * zahm0(ji,jj) + (1.-zcoff) * ahm2(ji,jj,1)
-         END DO
-      END DO
-
-      ! other level: re-increase the coef in the deep ocean
-      !==================================================================
-      ! Prior to v3.3, zcoeff was hardwired according to k-index jk.
-      !
-      ! From v3.3 onwards this has been generalised to a function of 
-      ! depth so that it can be used with any number of levels.
-      !
-      ! The function has been chosen to match the original values (shown
-      ! in the following comments) when using the standard 31 ORCA levels.  
-      !     DO jk = 1, 21
-      !        zcoef(jk) = 1._wp
-      !     END DO
-      !     zcoef(22) = 2._wp
-      !     zcoef(23) = 3._wp
-      !     zcoef(24) = 5._wp
-      !     zcoef(25) = 7._wp
-      !     zcoef(26) = 9._wp
-      !     DO jk = 27, jpk
-      !        zcoef(jk) = 10._wp
-      !     END DO
-      !==================================================================
-
-       IF(lwp) THEN
-          WRITE(numout,*)
-          WRITE(numout,*) '         1D zcoef array '
-          WRITE(numout,*) '         ~~~~~~~~~~~~~~ '
-          WRITE(numout,*)
-          WRITE(numout,*) '    jk        zcoef '
-       ENDIF
-
-      DO jk=1, jpk
-         zcoef(jk) = 1.0_wp + NINT(9.0_wp*(gdept_1d(jk)-800.0_wp)/(3000.0_wp-800.0_wp))
-         zcoef(jk) = MIN(10.0_wp, MAX(1.0_wp, zcoef(jk)))
-         IF(lwp) WRITE(numout,'(4x,i3,6x,f7.3)') jk,zcoef(jk)
-      END DO
-
-      DO jk = 2, jpk
-         ahm1(:,:,jk) = MIN( zahm0(:,:), zcoef(jk) * ahm1(:,:,1) )
-         ahm2(:,:,jk) = MIN( zahm0(:,:), zcoef(jk) * ahm2(:,:,1) )
-      END DO
-
-      IF( jp_cfg == 4 )   THEN         ! Limit AHM in Gibraltar strait
-         ij0 = 50   ;   ij1 = 53
-         ii0 = 69   ;   ii1 = 71
-         DO jk = 1, jpk
-            ahm1(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) = MIN( zahmm, ahm1(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) ) 
-            ahm2(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) = MIN( zahmm, ahm2(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) )
-         END DO
-      ENDIF
-      CALL lbc_lnk( ahm1, 'T', 1. )   ! Lateral boundary conditions (unchanged sign)
-      CALL lbc_lnk( ahm2, 'F', 1. )
-
-
-      IF(lwp) THEN                    ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '         3D ahm1 array (k=1)'
-         CALL prihre( ahm1(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) '         3D ahm2 array (k=1)'
-         CALL prihre( ahm2(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) '         3D ahm2 array (k=jpk)'
-         CALL prihre( ahm2(:,:,jpk), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
-      ENDIF
-
-
-      ! Set ahm3 and ahm4
-      ! =================
-
-      ! define ahm3 and ahm4 at the right grid point position
-      ! initialization to a constant value
-      !     (USER: modify ahm3 and ahm4 following your desiderata)
-      !     harmonic isopycnal or geopotential:
-      !                          ahm3 (ahm4) defined at u- (v-) point
-      DO jk = 1, jpk
-         DO jj = 2, jpj
-            DO ji = 2, jpi
-               ahm3(ji,jj,jk) = 0.5 * ( ahm2(ji,jj,jk) + ahm2(ji  ,jj-1,jk) )
-               ahm4(ji,jj,jk) = 0.5 * ( ahm2(ji,jj,jk) + ahm2(ji-1,jj  ,jk) )
-            END DO
-         END DO
-      END DO
-      ahm3 ( :, 1, :) = ahm3 ( :, 2, :)
-      ahm4 ( :, 1, :) = ahm4 ( :, 2, :)
-      
-      CALL lbc_lnk( ahm3, 'U', 1. )    ! Lateral boundary conditions (unchanged sign)
-      CALL lbc_lnk( ahm4, 'V', 1. )
-
-      ! Control print
-
-      IF( lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm3 array level 1'
-         CALL prihre(ahm3(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) '         ahm4 array level 1'
-         CALL prihre(ahm4(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi   , jpj   , icof  )
-      CALL wrk_dealloc( jpk   ,         zcoef )
-      CALL wrk_dealloc( jpi   , jpj   , zahm0 )
-      !
-   END SUBROUTINE ldf_dyn_c3d_orca
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90	(revision 6807)
+++ 	(revision )
@@ -1,68 +1,0 @@
-MODULE ldfdyn_oce
-   !!======================================================================
-   !!                  ***  MODULE  ldfdyn_oce  ***
-   !! Ocean physics:  lateral momentum mixing coefficient defined in memory 
-   !!======================================================================
-   !! History :  1.0  ! 2002-11  (G. Madec)  F90: Free form and module
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE in_out_manager ! I/O manager
-   USE lib_mpp         ! MPP library
-
-   IMPLICIT NONE
-   PUBLIC
-
-   !                                       !!* Namelist namdyn_ldf : lateral mixing *
-   LOGICAL , PUBLIC ::   ln_dynldf_lap      !: laplacian operator
-   LOGICAL , PUBLIC ::   ln_dynldf_bilap    !: bilaplacian operator
-   LOGICAL , PUBLIC ::   ln_dynldf_level    !: iso-level direction
-   LOGICAL , PUBLIC ::   ln_dynldf_hor      !: horizontal (geopotential) direction
-   LOGICAL , PUBLIC ::   ln_dynldf_iso      !: iso-neutral direction
-   REAL(wp), PUBLIC ::   rn_ahm_0_lap       !: lateral laplacian eddy viscosity (m2/s)
-   REAL(wp), PUBLIC ::   rn_ahmb_0          !: lateral laplacian background eddy viscosity (m2/s)
-   REAL(wp), PUBLIC ::   rn_ahm_0_blp       !: lateral bilaplacian eddy viscosity (m4/s)
-   REAL(wp), PUBLIC ::   ahm0, ahmb0, ahm0_blp         !: OLD namelist names
-   REAL(wp), PUBLIC ::   rn_cmsmag_1        !: constant in laplacian Smagorinsky viscosity
-   REAL(wp), PUBLIC ::   rn_cmsmag_2        !: constant in bilaplacian Smagorinsky viscosity
-   REAL(wp), PUBLIC ::   rn_cmsh            !: 1 or 0 , if 0 -use only shear for Smagorinsky viscosity
-   REAL(wp), PUBLIC ::   rn_ahm_m_blp       !: upper limit for bilap  abs(ahm) < min( dx^4/128rdt, rn_ahm_m_blp)
-   REAL(wp), PUBLIC ::   rn_ahm_m_lap       !: upper limit for lap  ahm < min(dx^2/16rdt, rn_ahm_m_lap)
-
-   INTEGER , PUBLIC ::   nkahm_smag      =  0          !: 
-
-   !                                                                                  !!! eddy coeff. at U-,V-,W-pts [m2/s]
-#if defined key_dynldf_c3d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahm1, ahm2, ahm3, ahm4   !: ** 3D coefficients **
-#elif defined key_dynldf_c2d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ahm1, ahm2, ahm3, ahm4   !: ** 2D coefficients **
-#elif defined key_dynldf_c1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   ahm1, ahm2, ahm3, ahm4   !: ** 2D coefficients **
-#else
-   REAL(wp), PUBLIC                                      ::   ahm1, ahm2, ahm3, ahm4   !: ** 0D coefficients **
-#endif
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION ldfdyn_oce_alloc()
-      !!----------------------------------------------------------------------
-      !!                 ***  FUNCTION ldfdyn_oce_alloc  ***
-      !!----------------------------------------------------------------------
-      ldfdyn_oce_alloc = 0
-#if defined key_dynldf_c3d
-      ALLOCATE( ahm1(jpi,jpj,jpk) , ahm2(jpi,jpj,jpk) , ahm3(jpi,jpj,jpk) , ahm4(jpi,jpj,jpk) , STAT=ldfdyn_oce_alloc )
-#elif defined key_dynldf_c2d
-      ALLOCATE( ahm1(jpi,jpj    ) , ahm2(jpi,jpj    ) , ahm3(jpi,jpj    ) , ahm4(jpi,jpj    ) , STAT=ldfdyn_oce_alloc )
-#elif defined key_dynldf_c1d
-      ALLOCATE( ahm1(        jpk) , ahm2(        jpk) , ahm3(        jpk) , ahm4(        jpk) , STAT=ldfdyn_oce_alloc )
-#endif
-      IF( ldfdyn_oce_alloc /= 0 )   CALL ctl_warn('ldfdyn_oce_alloc: failed to allocate arrays')
-      !
-   END FUNCTION ldfdyn_oce_alloc
-
-   !!======================================================================
-END MODULE ldfdyn_oce
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90	(revision 6807)
+++ 	(revision )
@@ -1,301 +1,0 @@
-MODULE ldfdyn_smag
-   !!======================================================================
-   !!                     ***  MODULE  ldftrasmag  ***
-   !! Ocean physics:  variable eddy induced velocity coefficients
-   !!======================================================================
-#if   defined key_dynldf_smag   &&   defined key_dynldf_c3d
-   !!----------------------------------------------------------------------
-   !!   'key_dynldf_smag'      and           smagorinsky  diffusivity
-   !!   'key_dynldf_c3d'                    3D tracer lateral  mixing coef.
-   !!----------------------------------------------------------------------
-   !!   ldf_eiv      : compute the eddy induced velocity coefficients
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE sbcrnf          ! river runoffs
-   USE ldfdyn_oce      ! ocean tracer   lateral physics
-   USE phycst          ! physical constants
-   USE ldfslp          ! iso-neutral slopes
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE iom
-   USE wrk_nemo
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC ldf_dyn_smag               ! routine called by step.F90
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-
-
-
-
-   !!----------------------------------------------------------------------
-   !!                        ***  ldfdyn_smag.F90  ***
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   'key_dynldf_smag'             3D lateral eddy viscosity coefficients
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_dyn_smag( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_dyn_smag  ***
-      !!                   
-      !! ** Purpose :   initializations of the horizontal ocean physics
-      !!
-      !! ** Method  :   3D eddy viscosity coef. 
-      !!    M.Griffies, R.Hallberg AMS, 2000
-      !! for laplacian:
-      !!   Asmag=(C/pi)^2*dx*dy sqrt(D^2), C=3-4
-      !! for bilaplacian:
-      !!   Bsmag=Asmag*dx*dy/8
-      !!   D^2=(du/dx-dv/dy)^2+(dv/dx+du/dy)^2 for Cartesian coordinates
-      !!  in general case du/dx ==> e2 d(u/e2)/dx;  du/dy ==> e1 d(u/e1)/dy; 
-      !!                  dv/dx ==> e2 d(v/e2)/dx;  dv/dy ==> e1 d(v/e1)/dy
-      !!
-      !!       laplacian operator   : ahm1, ahm2 defined at T- and F-points
-      !!                              ahm3, ahm4 never used
-      !!       bilaplacian operator : ahm1, ahm2 never used
-      !!                           :  ahm3, ahm4 defined at U- and V-points
-      !!       explanation of the default is missingi
-      !!  last modified : Maria Luneva, September 2011
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      !! ahm0 here is a background viscosity
-
-      !! * Arguments
-
-      !! * local variables
-
-      INTEGER              :: kt                   ! timestep
-
-      INTEGER  ::   ji, jj, jk                     ! dummy loop indices
-      REAL (wp):: zdeltat,zdeltaf,zdeltau,zdeltav  ! temporary scalars
-      REAL (wp), POINTER, DIMENSION (:,:) ::   zux, zuy , zvx ,zvy, zue1, zue2, zve1, zve2 
-      REAL (wp)::  zcmsmag_1, zcmsmag_2 , zcmsh
-
-
-      !!----------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi,jpj,zux,zuy,zvx,zvy )
-      CALL wrk_alloc( jpi,jpj,zue1,zue2,zve1,zve2 )
-
-
-      IF(  kt == nit000 ) THEN
-
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'ldf_dyn_smag : 3D lateral eddy viscosity coefficient'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-     
-      ENDIF
-      
-      zcmsmag_1 = rn_cmsmag_1
-      zcmsmag_2 = rn_cmsmag_2
-      zcmsh     = rn_cmsh
-
-   
-
-
-      ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operators
-      ! =================                       whatever its orientation is)
-      IF( ln_dynldf_lap ) THEN
-         ! define ahm1 and ahm2 at the right grid point position
-         ! (USER: modify ahm1 and ahm2 following your desiderata)
-         
-         DO jk=1,jpk
-           zue2(:,:)=un(:,:,jk)/e2u(:,:)
-           zve1(:,:)=vn(:,:,jk)/e1v(:,:)
-           zue1(:,:)=un(:,:,jk)/e1u(:,:)
-           zve2(:,:)=vn(:,:,jk)/e2v(:,:)
-
- 
-           DO jj=2,jpj
-            DO ji=2,jpi
-            zux(ji,jj)=(zue2(ji,jj)-zue2(ji-1,jj))/e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) * zcmsh
-            zvy(ji,jj)=(zve1(ji,jj)-zve1(ji,jj-1))/e2t(ji,jj)*e1t(ji,jj)*tmask(ji,jj,jk) * zcmsh
-            ENDDO
-           ENDDO
-
-           DO jj=1,jpjm1
-            DO ji=1,jpim1
-            zuy(ji,jj)=(zue1(ji,jj+1)-zue1(ji,jj))/e2f(ji,jj)*e1f(ji,jj)*fmask(ji,jj,jk)
-            zvx(ji,jj)=(zve2(ji+1,jj)-zve2(ji,jj))/e1f(ji,jj)*e2f(ji,jj)*fmask(ji,jj,jk)
-            ENDDO
-           ENDDO
-             
-          DO jj=2,jpjm1
-           DO ji=2,jpim1
-
-            zdeltat=2._wp /(e1t(ji,jj)**(-2)+e2t(ji,jj)**(-2))
-            zdeltaf=2._wp /(e1f(ji,jj)**(-2)+e2f(ji,jj)**(-2))   
-            ahm1(ji,jj,jk)=(zcmsmag_1/rpi)**2*zdeltat*                                         &
-                            sqrt( (zux(ji,jj)-zvy(ji,jj))**2+                                    &
-                     0.0625_wp*(zuy(ji,jj)+zuy(ji,jj-1)+zuy(ji-1,jj)+zuy(ji-1,jj-1)+             &
-                            zvx(ji,jj)+zvx(ji,jj-1)+zvx(ji-1,jj)+zvx(ji-1,jj-1))**2)
-
-            ahm2(ji,jj,jk)=(zcmsmag_1/rpi)**2*zdeltaf*                                         &
-                            sqrt( (zuy(ji,jj)+zvx(ji,jj))**2+                                    &
-                     0.0625_wp*(zux(ji,jj)+zux(ji,jj+1)+zux(ji+1,jj)+zux(ji+1,jj+1)-             &
-                             zvy(ji,jj)-zvy(ji,jj+1)-zvy(ji+1,jj)-zvy(ji+1,jj+1))**2)
-
-            ahm1(ji,jj,jk)=MAX(ahm1(ji,jj,jk),rn_ahm_0_lap)
-            ahm2(ji,jj,jk)=MAX(ahm2(ji,jj,jk),rn_ahm_0_lap)
-
-! stability criteria or upper limit set from namelist
-            ahm1(ji,jj,jk)=MIN(ahm1(ji,jj,jk),zdeltat / (16_wp*rdt),rn_ahm_m_lap)
-            ahm2(ji,jj,jk)=MIN(ahm2(ji,jj,jk),zdeltaf / (16_wp*rdt),rn_ahm_m_lap)
-
-            ENDDO
-           ENDDO
-
-         ENDDO ! jpk
-            ahm1(:,:,jpk) = ahm1(:,:,jpkm1)
-            ahm2(:,:,jpk) = ahm2(:,:,jpkm1)
-            IF(lwp.and.kt==nit000) WRITE(numout,'(36x," ahm ", 7x)')
-            DO jk = 1, jpk
-
-               IF(lwp.and.kt==nit000) WRITE(numout,'(30x,E10.2,8x,i3)') ahm1(jpi/2,jpj/2,jk), jk
-            END DO
-      CALL lbc_lnk( ahm1, 'T', 1. )   ! Lateral boundary conditions on ( ahtt )
-      CALL lbc_lnk( ahm2, 'F', 1. )   ! Lateral boundary conditions on ( ahtt )
-
-      ENDIF    ! ln_dynldf_lap
-      
-
-
-      ! ahm3 and ahm4 at U- and V-points (used for bilaplacian operator
-      ! ================================  whatever its orientation is)
-      ! Here: ahm is proportional to the cube of the maximum of the grid spacing
-      !       in the to horizontal direction
-
-      IF( ln_dynldf_bilap ) THEN
-         DO jk=1,jpk
-           zue2(:,:) = un(:,:,jk)/e2u(:,:)
-           zve1(:,:) = vn(:,:,jk)/e1v(:,:)
-           zue1(:,:) = un(:,:,jk)/e1u(:,:)
-           zve2(:,:) = vn(:,:,jk)/e2v(:,:)
-
-
-           DO jj=2,jpj
-            DO ji=2,jpi
-            zux(ji,jj) = (zue2(ji,jj)-zue2(ji-1,jj))/e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
-            zvy(ji,jj) = (zve1(ji,jj)-zve1(ji,jj-1))/e2t(ji,jj)*e1t(ji,jj)*tmask(ji,jj,jk)
-            ENDDO
-           ENDDO
-
-           DO jj=1,jpjm1
-            DO ji=1,jpim1
-            zuy(ji,jj) = (zue1(ji,jj+1)-zue1(ji,jj))/e2f(ji,jj)*e1f(ji,jj)*fmask(ji,jj,jk)
-            zvx(ji,jj) = (zve2(ji+1,jj)-zve2(ji,jj))/e1f(ji,jj)*e2f(ji,jj)*fmask(ji,jj,jk)
-            ENDDO
-           ENDDO
-
-
-          DO jj=2,jpjm1
-           DO ji=2,jpim1
-            zdeltau = 2._wp/(e1u(ji,jj)**(-2)+e2u(ji,jj)**(-2))
-            zdeltav = 2._wp/(e1v(ji,jj)**(-2)+e2v(ji,jj)**(-2))
-
-            ahm3(ji,jj,jk) = -(zcmsmag_2/rpi)**2/8.0_wp*zdeltau**2*                          &
-
-                         sqrt(0.25_wp*(zux(ji,jj)+zux(ji+1,jj)-zvy(ji,jj)-zvy(ji+1,jj))**2+    &
-                              0.25_wp*(zuy(ji,jj)+zuy(ji,jj-1)+zvx(ji,jj)+zvx(ji,jj-1))**2)
-
-            ahm4(ji,jj,jk) = -(zcmsmag_2/rpi)**2/8.0_wp*zdeltav**2*                           &
-
-                         sqrt(0.25_wp*(zux(ji,jj)+zux(ji,jj+1)-zvy(ji,jj)-zvy(ji,jj+1))**2+    &
-                              0.25_wp*(zuy(ji,jj)+zuy(ji-1,jj)+zvx(ji-1,jj)+zvx(ji,jj))**2)
-
-            ahm3(ji,jj,jk) = MIN (rn_ahm_0_blp , ahm3(ji,jj,jk) )
-            ahm4(ji,jj,jk) = MIN (rn_ahm_0_blp , ahm4(ji,jj,jk) ) 
-
-! stability criteria or upper limit set in namelist
-
-            ahm3(ji,jj,jk) = MAX( ahm3(ji,jj,jk),-zdeltau**2/( 128._wp*rdt ),rn_ahm_m_blp )
-            ahm4(ji,jj,jk) = MAX( ahm4(ji,jj,jk),-zdeltav**2/( 128._wp*rdt ),rn_ahm_m_blp )
-            
-
-            ENDDO
-           ENDDO
-
-         ENDDO
-            ahm3(:,:,jpk) = ahm3(:,:,jpkm1)
-            ahm4(:,:,jpk) = ahm4(:,:,jpkm1)
-
-      DO jk = 1, jpk
-      IF(  kt == nit000 ) THEN
-
-               IF(lwp) WRITE(numout,'(30x,E10.2,8x,i3)') ahm3(jpi/2,jpj/2,jk), jk
-      ENDIF   
-      END DO
-      CALL lbc_lnk( ahm3, 'U', 1. )   ! Lateral boundary conditions
-      CALL lbc_lnk( ahm4, 'V', 1. )
-   ENDIF
-
-      CALL wrk_dealloc( jpi,jpj,zux,zuy,zvx,zvy )
-      CALL wrk_dealloc( jpi,jpj,zue1,zue2,zve1,zve2 )
-   !    zumax = MAXVAL( ABS( ahm3(:,:,:) ) )                ! slower than the following loop on NEC SX5
-      zdeltat = 0._wp
-   If(ln_dynldf_lap)THEN
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zdeltat = MAX(zdeltat,ABS(ahm1(ji,jj,jk)),ABS(ahm2(ji,jj,jk)) )
-          END DO
-        END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_max( zdeltat )                 ! max over the global domain
-      !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,'dynlap:  abs(ahm) max: ', zdeltat
-    ENDIF
-    If(ln_dynldf_bilap)THEN
-     zdeltat = 0._wp
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zdeltat = MAX(zdeltat,ABS(ahm3(ji,jj,jk)),ABS(ahm3(ji,jj,jk)) )
-          END DO
-        END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_max( zdeltat )                 ! max over the global domain
-      !
-      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,'dyn_bilap abs(ahm) max: ', zdeltat
-      !
-   ENDIF
-      !
-
-END SUBROUTINE ldf_dyn_smag
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Dummy module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE ldf_dyn_smag( kt )       ! Empty routine
-      WRITE(*,*) 'ldf_dyn_smag: You should not have seen this print! error? check keys ldf:c3d+smag', kt
-   END SUBROUTINE ldf_dyn_smag
-#endif
-
-   END MODULE ldfdyn_smag
-
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90	(revision 6807)
+++ 	(revision )
@@ -1,40 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                    ***  ldfdyn_substitute.h90  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute fsahm., the lateral eddy viscosity coeff. 
-   !!      with a constant, or 1D, or 2D or 3D array, using CPP macro.
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-   !!
-   !! fsahmt, fsahmf - used for laplaian operator only
-   !! fsahmu, fsahmv - used for bilaplacian operator only
-   !!
-#if defined key_dynldf_c3d
-!   ' key_dynldf_c3d' :                  3D coefficient
-#    define   fsahmt(i,j,k)    ahm1(i,j,k)
-#    define   fsahmf(i,j,k)    ahm2(i,j,k)
-#    define   fsahmu(i,j,k)    ahm3(i,j,k)
-#    define   fsahmv(i,j,k)    ahm4(i,j,k)
-#elif defined key_dynldf_c2d
-!   ' key_dynldf_c2d' :                 2D coefficient
-#  define   fsahmt(i,j,k)    ahm1(i,j)
-#  define   fsahmf(i,j,k)    ahm2(i,j)
-#  define   fsahmu(i,j,k)    ahm3(i,j)
-#  define   fsahmv(i,j,k)    ahm4(i,j)
-#elif defined key_dynldf_c1d
-!   'key_dynldf_c1d' :                  1D coefficient
-#  define   fsahmt(i,j,k)    ahm1(k)
-#  define   fsahmf(i,j,k)    ahm1(k)
-#  define   fsahmu(i,j,k)    ahm2(k)
-#  define   fsahmv(i,j,k)    ahm2(k)
-#else
-!   default option :               Constant coefficient
-#  define   fsahmt(i,j,k)   ahm0
-#  define   fsahmf(i,j,k)   ahm0
-#  define   fsahmu(i,j,k)   ahm0_blp
-#  define   fsahmv(i,j,k)   ahm0_blp
-#endif
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90	(revision 6807)
+++ 	(revision )
@@ -1,224 +1,0 @@
-MODULE ldfeiv
-   !!======================================================================
-   !!                     ***  MODULE  ldfeiv  ***
-   !! Ocean physics:  variable eddy induced velocity coefficients
-   !!======================================================================
-   !! History :  OPA  ! 1999-03  (G. Madec, A. Jouzeau)  Original code
-   !!   NEMO     1.0  ! 2002-06  (G. Madec)  Free form, F90
-   !!----------------------------------------------------------------------
-#if   defined key_traldf_eiv   &&   defined key_traldf_c2d
-   !!----------------------------------------------------------------------
-   !!   'key_traldf_eiv'      and                     eddy induced velocity
-   !!   'key_traldf_c2d'                    2D tracer lateral  mixing coef.
-   !!----------------------------------------------------------------------
-   !!   ldf_eiv      : compute the eddy induced velocity coefficients
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE sbcrnf          ! river runoffs
-   USE ldftra_oce      ! ocean tracer   lateral physics
-   USE phycst          ! physical constants
-   USE ldfslp          ! iso-neutral slopes
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE iom             ! I/O library
-   USE wrk_nemo        ! work arrays
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   ldf_eiv    ! routine called by step.F90
-   
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE ldf_eiv( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_eiv  ***
-      !!
-      !! ** Purpose :   Compute the eddy induced velocity coefficient from the
-      !!              growth rate of baroclinic instability.
-      !!
-      !! ** Method :
-      !!
-      !! ** Action : - uslp , vslp  : i- and j-slopes of neutral surfaces at u- & v-points
-      !!             - wslpi, wslpj : i- and j-slopes of neutral surfaces at w-points. 
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zfw, ze3w, zn2, zf20, zaht, zaht_min      ! temporary scalars
-      REAL(wp), DIMENSION(:,:), POINTER ::   zn, zah, zhw, zross   ! 2D workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ldf_eiv')
-      !
-      CALL wrk_alloc( jpi,jpj, zn, zah, zhw, zross )
-
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'ldf_eiv : eddy induced velocity coefficients'
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-      ENDIF
-      
-      ! 0. Local initialization
-      ! -----------------------
-      zn   (:,:) = 0._wp
-      zhw  (:,:) = 5._wp
-      zah  (:,:) = 0._wp
-      zross(:,:) = 0._wp
-
-
-      ! 1. Compute lateral diffusive coefficient 
-      ! ----------------------------------------
-      IF( ln_traldf_grif ) THEN
-         DO jk = 1, jpk
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  ! Take the max of N^2 and zero then take the vertical sum 
-                  ! of the square root of the resulting N^2 ( required to compute 
-                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
-                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
-                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)
-                  ! Compute elements required for the inverse time scale of baroclinic
-                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
-                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
-                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)
-                  zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w
-                  zhw(ji,jj) = zhw(ji,jj) + ze3w
-               END DO
-            END DO
-         END DO
-      ELSE
-         DO jk = 1, jpk
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  ! Take the max of N^2 and zero then take the vertical sum 
-                  ! of the square root of the resulting N^2 ( required to compute 
-                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
-                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
-                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)
-                  ! Compute elements required for the inverse time scale of baroclinic
-                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
-                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
-                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)
-                  zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
-                     &                            + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w
-                  zhw(ji,jj) = zhw(ji,jj) + ze3w
-               END DO
-            END DO
-         END DO
-      END IF
-
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 )
-            ! Rossby radius at w-point taken < 40km and  > 2km
-            zross(ji,jj) = MAX( MIN( .4 * zn(ji,jj) / zfw, 40.e3 ), 2.e3 )
-            ! Compute aeiw by multiplying Ro^2 and T^-1
-            aeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * ssmask(ji,jj)
-         END DO
-      END DO
-
-      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK 
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! Take the minimum between aeiw and 1000 m2/s over shelves (depth shallower than 650 m)
-               IF( mbkt(ji,jj) <= 20 )   aeiw(ji,jj) = MIN( aeiw(ji,jj), 1000. )
-            END DO
-         END DO
-      ENDIF
-
-      ! Decrease the coefficient in the tropics (20N-20S) 
-      zf20 = 2._wp * omega * sin( rad * 20._wp )
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            aeiw(ji,jj) = MIN( 1., ABS( ff(ji,jj) / zf20 ) ) * aeiw(ji,jj)
-         END DO
-      END DO
-
-      ! ORCA R05: Take the minimum between aeiw  and aeiv0
-      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               aeiw(ji,jj) = MIN( aeiw(ji,jj), aeiv0 )
-            END DO
-         END DO
-      ENDIF
-      CALL lbc_lnk( aeiw, 'W', 1. )      ! lateral boundary condition on aeiw 
-
-
-      ! Average the diffusive coefficient at u- v- points 
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            aeiu(ji,jj) = 0.5_wp * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) )
-            aeiv(ji,jj) = 0.5_wp * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) )
-         END DO 
-      END DO 
-      CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )      ! lateral boundary condition
-
-
-      IF(ln_ctl) THEN
-         CALL prt_ctl(tab2d_1=aeiu, clinfo1=' eiv  - u: ', ovlap=1)
-         CALL prt_ctl(tab2d_1=aeiv, clinfo1=' eiv  - v: ', ovlap=1)
-      ENDIF
-
-      ! ORCA R05: add a space variation on aht (=aeiv except at the equator and river mouth)
-      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN
-         zf20     = 2._wp * omega * SIN( rad * 20._wp )
-         zaht_min = 100._wp                           ! minimum value for aht
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zaht      = ( 1._wp -  MIN( 1._wp , ABS( ff(ji,jj) / zf20 ) ) ) * ( aht0 - zaht_min )  &
-                  &      + aht0 * rnfmsk(ji,jj)                          ! enhanced near river mouths
-               ahtu(ji,jj) = MAX( MAX( zaht_min, aeiu(ji,jj) ) + zaht, aht0 )
-               ahtv(ji,jj) = MAX( MAX( zaht_min, aeiv(ji,jj) ) + zaht, aht0 )
-               ahtw(ji,jj) = MAX( MAX( zaht_min, aeiw(ji,jj) ) + zaht, aht0 )
-            END DO
-         END DO
-         IF(ln_ctl) THEN
-            CALL prt_ctl(tab2d_1=ahtu, clinfo1=' aht  - u: ', ovlap=1)
-            CALL prt_ctl(tab2d_1=ahtv, clinfo1=' aht  - v: ', ovlap=1)
-            CALL prt_ctl(tab2d_1=ahtw, clinfo1=' aht  - w: ', ovlap=1)
-         ENDIF
-      ENDIF
-
-      IF( aeiv0 == 0._wp ) THEN
-         aeiu(:,:) = 0._wp
-         aeiv(:,:) = 0._wp
-         aeiw(:,:) = 0._wp
-      ENDIF
-
-      CALL iom_put( "aht2d"    , ahtw )   ! lateral eddy diffusivity
-      CALL iom_put( "aht2d_eiv", aeiw )   ! EIV lateral eddy diffusivity
-      !  
-      CALL wrk_dealloc( jpi,jpj, zn, zah, zhw, zross )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('ldf_eiv')
-      !
-   END SUBROUTINE ldf_eiv
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Dummy module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE ldf_eiv( kt )       ! Empty routine
-      INTEGER :: kt
-      WRITE(*,*) 'ldf_eiv: You should not have seen this print! error?', kt
-   END SUBROUTINE ldf_eiv
-#endif
-
-   !!======================================================================
-END MODULE ldfeiv
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90	(revision 6807)
+++ 	(revision )
@@ -1,39 +1,0 @@
-#if defined key_traldf_eiv   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!                   ***  ldfeiv_substitute.h90  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute fsaei. the eddy induced velocity coeff.
-   !!      with a constant or 1D or 2D or 3D array, using CPP macro.
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-#  if defined key_traldf_c3d
-!   'traldf_c3d' :                           eiv: 3D coefficient
-#    define   fsaeiu(i,j,k)   aeiu(i,j,k)
-#    define   fsaeiv(i,j,k)   aeiv(i,j,k)
-#    define   fsaeiw(i,j,k)   aeiw(i,j,k)
-#  elif defined key_traldf_c2d
-!   'traldf_c2d' :                           eiv: 2D coefficient
-#    define   fsaeiu(i,j,k)   aeiu(i,j)
-#    define   fsaeiv(i,j,k)   aeiv(i,j)
-#    define   fsaeiw(i,j,k)   aeiw(i,j)
-#  elif defined key_traldf_c1d
-!   'traldf_c1d' :                           eiv: 1D coefficient
-#    define   fsaeiu(i,j,k)   aeiu(k)
-#    define   fsaeiv(i,j,k)   aeiv(k)
-#    define   fsaeiw(i,j,k)   aeiw(k)
-#  else
-!   Default option :                          eiv: Constant coefficient
-#    define   fsaeiu(i,j,k)   aeiv0
-#    define   fsaeiv(i,j,k)   aeiv0
-#    define   fsaeiw(i,j,k)   aeiv0
-#  endif
-#else
-!   Default option :                         eiv: dummy variables
-#    define   fsaeiu(i,j,k)   aeiv0
-#    define   fsaeiv(i,j,k)   aeiv0
-#    define   fsaeiw(i,j,k)   aeiv0
-#endif
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 6808)
@@ -11,11 +11,10 @@
    !!            3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)  add Griffies operator
    !!             -   ! 2010-11  (F. Dupond, G. Madec)  bug correction in slopes just below the ML
+   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  add limiter on triad slopes
    !!----------------------------------------------------------------------
-#if   defined key_ldfslp   ||   defined key_esopa
+
    !!----------------------------------------------------------------------
-   !!   'key_ldfslp'                      Rotation of lateral mixing tensor
-   !!----------------------------------------------------------------------
-   !!   ldf_slp_grif  : calculates the triads of isoneutral slopes (Griffies operator)
    !!   ldf_slp       : calculates the slopes of neutral surface   (Madec operator)
+   !!   ldf_slp_triad : calculates the triads of isoneutral slopes (Griffies operator)
    !!   ldf_slp_mxl   : calculates the slopes at the base of the mixed layer (Madec operator)
    !!   ldf_slp_init  : initialization of the slopes computation
@@ -23,6 +22,5 @@
    USE oce            ! ocean dynamics and tracers
    USE dom_oce        ! ocean space and time domain
-   USE ldftra_oce     ! lateral diffusion: traceur
-   USE ldfdyn_oce     ! lateral diffusion: dynamics
+   USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
    USE phycst         ! physical constants
    USE zdfmxl         ! mixed layer depth
@@ -30,29 +28,42 @@
    !
    USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl         ! Print control
+   USE lib_mpp        ! distribued memory computing library
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
    USE wrk_nemo       ! work arrays
    USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   ldf_slp        ! routine called by step.F90
-   PUBLIC   ldf_slp_grif   ! routine called by step.F90
-   PUBLIC   ldf_slp_init   ! routine called by opa.F90
-
-   LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp = .TRUE.     !: slopes flag
-   !                                                                             !! Madec operator
-   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator
+   PUBLIC   ldf_slp         ! routine called by step.F90
+   PUBLIC   ldf_slp_triad   ! routine called by step.F90
+   PUBLIC   ldf_slp_init    ! routine called by nemogcm.F90
+
+   LOGICAL , PUBLIC ::   l_ldfslp = .FALSE.     !: slopes flag
+
+   LOGICAL , PUBLIC ::   ln_traldf_iso   = .TRUE.       !: iso-neutral direction
+   LOGICAL , PUBLIC ::   ln_traldf_triad = .FALSE.      !: griffies triad scheme
+
+   LOGICAL , PUBLIC ::   ln_triad_iso    = .FALSE.      !: pure horizontal mixing in ML
+   LOGICAL , PUBLIC ::   ln_botmix_triad = .FALSE.      !: mixing on bottom
+   REAL(wp), PUBLIC ::   rn_sw_triad     = 1._wp        !: =1 switching triads ; =0 all four triads used 
+   REAL(wp), PUBLIC ::   rn_slpmax       = 0.01_wp      !: slope limit
+
+   LOGICAL , PUBLIC ::   l_grad_zps = .FALSE.           !: special treatment for Horz Tgradients w partial steps (triad operator)
+   
+   !                                                     !! Classic operator (Madec)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   uslp, wslpi          !: i_slope at U- and W-points
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   vslp, wslpj          !: j-slope at V- and W-points
-   !                                                                !! Griffies operator
+   !                                                     !! triad operator (Griffies)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wslp2                !: wslp**2 from Griffies quarter cells
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi  , triadj     !: isoneutral slopes relative to model-coordinate
-
-   !                                                              !! Madec operator
-   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator
+   !                                                     !! both operators
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   ah_wslp2             !: ah * slope^2 at w-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   akz                  !: stabilizing vertical diffusivity
+   
+   !                                                     !! Madec operator
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   omlmask           ! mask of the surface mixed layer at T-pt
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   uslpml, wslpiml   ! i_slope at U- and W-points just below the mixed layer
@@ -62,10 +73,7 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
-#  include "ldfeiv_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -103,15 +111,15 @@
       !!
       INTEGER  ::   ji , jj , jk    ! dummy loop indices
-      INTEGER  ::   ii0, ii1, iku   ! temporary integer
-      INTEGER  ::   ij0, ij1, ikv   ! temporary integer
-      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw ! local scalars
+      INTEGER  ::   ii0, ii1        ! temporary integer
+      INTEGER  ::   ij0, ij1        ! temporary integer
+      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw, z1_slpmax ! local scalars
       REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      -
       REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
       REAL(wp) ::   zck, zfk,      zbw             !   -      -
-      REAL(wp) ::   zdepv, zdepu         !   -      -
+      REAL(wp) ::   zdepu, zdepv                   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zslpml_hmlpu, zslpml_hmlpv
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwz, zww
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdzr
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zgru, zgrv
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zhmlpu, zhmlpv
       !!----------------------------------------------------------------------
       !
@@ -119,349 +127,254 @@
       !
       CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv )
-      CALL wrk_alloc( jpi,jpj, zhmlpu, zhmlpv )
-
-      IF ( ln_traldf_iso .OR. ln_dynldf_iso ) THEN 
-     
-         zeps   =  1.e-20_wp        !==   Local constant initialization   ==!
-         z1_16  =  1.0_wp / 16._wp
-         zm1_g  = -1.0_wp / grav
-         zm1_2g = -0.5_wp / grav
-         !
-         zww(:,:,:) = 0._wp
-         zwz(:,:,:) = 0._wp
-         !
-         DO jk = 1, jpk             !==   i- & j-gradient of density   ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) )
-                  zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
-         IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)
-                  zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj)
-               END DO
-            END DO
-         ENDIF
-         IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
+      CALL wrk_alloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv )
+
+      zeps   =  1.e-20_wp        !==   Local constant initialization   ==!
+      z1_16  =  1.0_wp / 16._wp
+      zm1_g  = -1.0_wp / grav
+      zm1_2g = -0.5_wp / grav
+      z1_slpmax = 1._wp / rn_slpmax
+      !
+      zww(:,:,:) = 0._wp
+      zwz(:,:,:) = 0._wp
+      !
+      DO jk = 1, jpk             !==   i- & j-gradient of density   ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) )
+               zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)
+               zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
                IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 
                IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj)
-               END DO
-            END DO
-         ENDIF
-         !
-         !==   Local vertical density gradient at T-point   == !   (evaluated from N^2)
-         ! interior value
-         DO jk = 2, jpkm1
-            !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
-            !                                !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0
-            !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1
-            !                                !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2
-            !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster
-            zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              &
-               &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) )
-         END DO
-         ! surface initialisation 
-         zdzr(:,:,1) = 0._wp 
-         IF ( ln_isfcav ) THEN
-            ! if isf need to overwrite the interior value at at the first ocean point
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zdzr(ji,jj,1:mikt(ji,jj)) = 0._wp
-               END DO
-            END DO
-         END IF
-         !
-         !                          !==   Slopes just below the mixed layer   ==!
-         CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml
-
-
-         ! I.  slopes at u and v point      | uslp = d/di( prd ) / d/dz( prd )
-         ! ===========================      | vslp = d/dj( prd ) / d/dz( prd )
-         !
-         IF ( ln_isfcav ) THEN
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj  ),                   5._wp)
-                  IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji+1,jj  ),                   5._wp)
-                  IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj  ), hmlpt(ji+1,jj  ), 5._wp)
-                  IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj  ),                   5._wp)
-                  IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj+1),                   5._wp)
-                  IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj  ), hmlpt(ji  ,jj+1), 5._wp)
-               ENDDO
-            ENDDO
-         ELSE
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zhmlpu(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji+1,jj  ), 5._wp)
-                  zhmlpv(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji  ,jj+1), 5._wp)
-               ENDDO
-            ENDDO
-         END IF
-         DO jk = 2, jpkm1                            !* Slopes at u and v points
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !                                      ! horizontal and vertical density gradient at u- and v-points
-                  zau = zgru(ji,jj,jk) / e1u(ji,jj)
-                  zav = zgrv(ji,jj,jk) / e2v(ji,jj)
-                  zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) )
-                  zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) )
-                  !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
-                  !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-                  zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau )  )
-                  zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav )  )
-                  !                                      ! uslp and vslp output in zwz and zww, resp.
-                  zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj  ,jk) )
-                  zfj = MAX( omlmask(ji,jj,jk), omlmask(ji  ,jj+1,jk) )
-                  ! thickness of water column between surface and level k at u/v point
-                  zdepu = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji+1,jj  ,jk) )                              &
-                                   - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj  ) ) - fse3u(ji,jj,miku(ji,jj)) )
-                  zdepv = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji  ,jj+1,jk) )                              &
-                                   - 2 * MAX( risfdep(ji,jj), risfdep(ji  ,jj+1) ) - fse3v(ji,jj,mikv(ji,jj)) )
-                  !
-                  zwz(ji,jj,jk) = ( 1. - zfi) * zau / ( zbu - zeps )                                          &
-                     &                 + zfi  * uslpml(ji,jj) * zdepu / zhmlpu(ji,jj)
-                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * wumask(ji,jj,jk)
-                  zww(ji,jj,jk) = ( 1. - zfj) * zav / ( zbv - zeps )                                          &
-                     &                 + zfj  * vslpml(ji,jj) * zdepv / zhmlpv(ji,jj) 
-                  zww(ji,jj,jk) = zww(ji,jj,jk) * wvmask(ji,jj,jk)
-                  
-                 
+            END DO
+         END DO
+      ENDIF
+      !
+      zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2)
+      DO jk = 2, jpkm1
+         !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
+         !                                !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0
+         !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1
+         !                                !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2
+         !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster
+         zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              &
+            &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) )
+      END DO
+      !
+      !                          !==   Slopes just below the mixed layer   ==!
+      CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml
+
+
+      ! I.  slopes at u and v point      | uslp = d/di( prd ) / d/dz( prd )
+      ! ===========================      | vslp = d/dj( prd ) / d/dz( prd )
+      !
+      IF ( ln_isfcav ) THEN
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX(hmlpt(ji,jj), hmlpt(ji+1,jj  ), 5._wp)       &
+                  &                                  - 0.5_wp * ( risfdep(ji,jj) + risfdep(ji+1,jj  ) ) )
+               zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / ( MAX(hmlpt(ji,jj), hmlpt(ji  ,jj+1), 5._wp)       &
+                  &                                  - 0.5_wp * ( risfdep(ji,jj) + risfdep(ji  ,jj+1) ) )
+            END DO
+         END DO
+      ELSE
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji+1,jj  ), 5._wp)
+               zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji  ,jj+1), 5._wp)
+            END DO
+         END DO
+      END IF
+
+      DO jk = 2, jpkm1                            !* Slopes at u and v points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !                                      ! horizontal and vertical density gradient at u- and v-points
+               zau = zgru(ji,jj,jk) * r1_e1u(ji,jj)
+               zav = zgrv(ji,jj,jk) * r1_e2v(ji,jj)
+               zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) )
+               zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) )
+               !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
+               !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbu = MIN(  zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,jk)* ABS( zau )  )
+               zbv = MIN(  zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,jk)* ABS( zav )  )
+               !                                      ! uslp and vslp output in zwz and zww, resp.
+               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
+               zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )
+               ! thickness of water column between surface and level k at u/v point
+               zdepu = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji+1,jj  ,jk) )                            &
+                                - ( risfdep(ji,jj)    + risfdep(ji+1,jj)    ) - e3u_n(ji,jj,miku(ji,jj)) )
+               zdepv = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji,jj+1,jk) )                              &
+                                - ( risfdep(ji,jj)    + risfdep(ji,jj+1)    ) - e3v_n(ji,jj,mikv(ji,jj)) )
+               !
+               zwz(ji,jj,jk) = ( ( 1._wp - zfi) * zau / ( zbu - zeps )                                     &
+                  &                      + zfi  * zdepu * zslpml_hmlpu(ji,jj) ) * umask(ji,jj,jk)
+               zww(ji,jj,jk) = ( ( 1._wp - zfj) * zav / ( zbv - zeps )                                     &
+                  &                      + zfj  * zdepv * zslpml_hmlpv(ji,jj) ) * vmask(ji,jj,jk)
 !!gm  modif to suppress omlmask.... (as in Griffies case)
-!                  !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0.
-!                  zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp )
-!                  zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp )
-!                  zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) )
-!                  zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) )
-!                  zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk)
-!                  zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk)
+!               !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0.
+!               zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp )
+!               zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp )
+!               zci = 0.5 * ( gdept_n(ji+1,jj,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) )
+!               zcj = 0.5 * ( gdept_n(ji,jj+1,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) )
+!               zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk)
 !!gm end modif
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( zwz, 'U', -1. )   ;   CALL lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions
-         !
-         !                                            !* horizontal Shapiro filter
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
-               DO ji = 2, jpim1
-                  uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
-                     &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
-                     &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
-                     &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
-                     &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
-                  vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
-                     &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
-                     &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
-                     &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
-                     &                       + 4.*  zww(ji,jj    ,jk)                       )
-               END DO
-            END DO
-            DO jj = 3, jpj-2                               ! other rows
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
-                     &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
-                     &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
-                     &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
-                     &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
-                  vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
-                     &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
-                     &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)         &
-                     &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
-                     &                       + 4.*  zww(ji,jj    ,jk)                       )
-               END DO
-            END DO
-            !                                        !* decrease along coastal boundaries
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   &
-                     &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp   &
-                     &                            *   umask(ji,jj,jk-1)
-                  vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   &
-                     &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp   &
-                     &                            *   vmask(ji,jj,jk-1)
-               END DO
-            END DO
-         END DO
-
-
-         ! II.  slopes at w point           | wslpi = mij( d/di( prd ) / d/dz( prd )
-         ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd )
-         !
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !                                  !* Local vertical density gradient evaluated from N^2
-                  zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) * wmask(ji,jj,jk)
-                  !                                  !* Slopes at w point
-                  !                                        ! i- & j-gradient of density at w-points
-                  zci = MAX(  umask(ji-1,jj,jk  ) + umask(ji,jj,jk  )           &
-                     &      + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps  ) * e1t(ji,jj)
-                  zcj = MAX(  vmask(ji,jj-1,jk  ) + vmask(ji,jj,jk-1)           &
-                     &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) *  e2t(ji,jj)
-                  zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           &
-                     &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci
-                  zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           &
-                     &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj
-                  !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
-                  !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-                  zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zai )  )
-                  zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj )  )
-                  !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.)
-                  zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0
-                  zck = ( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj), 10._wp )
-                  zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) &
-                     &            + zck * wslpiml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
-                  zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) &
-                     &            + zck * wslpjml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zwz, 'U', -1. )   ;   CALL lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions
+      !
+      !                                            !* horizontal Shapiro filter
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
+            DO ji = 2, jpim1
+               uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
+               vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+         DO jj = 3, jpj-2                               ! other rows
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
+               vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+         !                                        !* decrease along coastal boundaries
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   &
+                  &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp
+               vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   &
+                  &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp
+            END DO
+         END DO
+      END DO
+
+
+      ! II.  slopes at w point           | wslpi = mij( d/di( prd ) / d/dz( prd )
+      ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd )
+      !
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !                                  !* Local vertical density gradient evaluated from N^2
+               zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. )
+               !                                  !* Slopes at w point
+               !                                        ! i- & j-gradient of density at w-points
+               zci = MAX(  umask(ji-1,jj,jk  ) + umask(ji,jj,jk  )           &
+                  &      + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps  ) * e1t(ji,jj)
+               zcj = MAX(  vmask(ji,jj-1,jk  ) + vmask(ji,jj,jk-1)           &
+                  &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) * e2t(ji,jj)
+               zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           &
+                  &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci * wmask (ji,jj,jk)
+               zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           &
+                  &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * wmask (ji,jj,jk)
+               !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+               !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zai )  )
+               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zaj )  )
+               !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.)
+               zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0
+               zck = ( gdepw_n(ji,jj,jk) - gdepw_n(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj) - gdepw_n(ji,jj,mikt(ji,jj)), 10._wp )
+               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
+               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
 
 !!gm  modif to suppress omlmask....  (as in Griffies operator)
-!                  !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0.
-!                  zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp )
-!                  zck = fsdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. )
-!                  zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk)
-!                  zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!               !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0.
+!               zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp )
+!               zck = gdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. )
+!               zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk)
 !!gm end modif
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions
-         !
-         !                                           !* horizontal Shapiro filter
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
-               DO ji = 2, jpim1
-                  zcofw = tmask(ji,jj,jk) * z1_16
-                  wslpi(ji,jj,jk) = (          zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
-                       &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
-                       &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
-                       &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
-                       &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw
-
-                  wslpj(ji,jj,jk) = (          zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
-                       &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
-                       &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
-                       &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
-                       &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw
-               END DO
-            END DO
-            DO jj = 3, jpj-2                               ! other rows
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zcofw = tmask(ji,jj,jk) * z1_16
-                  wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
-                       &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
-                       &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
-                       &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
-                       &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw
-
-                  wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
-                       &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
-                       &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
-                       &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
-                       &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw
-               END DO
-            END DO
-            !                                        !* decrease along coastal boundaries
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   &
-                     &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25
-                  wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * wmask(ji,jj,jk)
-                  wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * wmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-         ! III.  Specific grid points
-         ! ===========================
-         !
-         IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN     !  ORCA_R4 configuration: horizontal diffusion in specific area
-            !                                                    ! Gibraltar Strait
-            ij0 =  50   ;   ij1 =  53
-            ii0 =  69   ;   ii1 =  71   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
-            ij0 =  51   ;   ij1 =  53
-            ii0 =  68   ;   ii1 =  71   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
-            ii0 =  69   ;   ii1 =  71   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
-            ii0 =  69   ;   ii1 =  71   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
-            !
-            !                                                    ! Mediterrannean Sea
-            ij0 =  49   ;   ij1 =  56
-            ii0 =  71   ;   ii1 =  90   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
-            ij0 =  50   ;   ij1 =  56
-            ii0 =  70   ;   ii1 =  90   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
-            ii0 =  71   ;   ii1 =  90   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
-            ii0 =  71   ;   ii1 =  90   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
-         ENDIF
-
-
-         ! IV. Lateral boundary conditions
-         ! ===============================
-         CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )
-         CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )
-
-
-         IF(ln_ctl) THEN
-            CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk)
-            CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk)
-         ENDIF
-         !
-
-      ELSEIF ( lk_vvl ) THEN 
- 
-         IF(lwp) THEN 
-            WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 
-         ENDIF 
-
-         ! geopotential diffusion in s-coordinates on tracers and/or momentum 
-         ! The slopes of s-surfaces are computed at each time step due to vvl 
-         ! The slopes for momentum diffusion are i- or j- averaged of those on tracers 
-
-         ! set the slope of diffusion to the slope of s-surfaces 
-         !      ( c a u t i o n : minus sign as fsdep has positive value ) 
-         DO jj = 2, jpjm1 
-            DO ji = fs_2, fs_jpim1   ! vector opt. 
-               uslp(ji,jj,1) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,1) - fsdept_b(ji ,jj ,1) )  * umask(ji,jj,1) 
-               vslp(ji,jj,1) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,1) - fsdept_b(ji ,jj ,1) )  * vmask(ji,jj,1) 
-               wslpi(ji,jj,1) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,1) - fsdepw_b(ji-1,jj,1) ) * tmask(ji,jj,1) * 0.5 
-               wslpj(ji,jj,1) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,1) - fsdepw_b(ji,jj-1,1) ) * tmask(ji,jj,1) * 0.5 
-            END DO 
-         END DO 
-
-         DO jk = 2, jpk 
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt. 
-                  uslp(ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 
-                  vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 
-                  wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) &
-                    &                              * wmask(ji,jj,jk) * 0.5 
-                  wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) &
-                    &                              * wmask(ji,jj,jk) * 0.5 
-               END DO 
-            END DO 
-         END DO 
-
-         ! Lateral boundary conditions on the slopes 
-         CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. ) 
-         CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. ) 
-  
-         if( kt == nit000 ) then 
-            IF(lwp) WRITE(numout,*) ' max slop: u',SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  & 
-               &                             ' wi', sqrt(MAXVAL(wslpi)), ' wj', sqrt(MAXVAL(wslpj)) 
-         endif 
-  
-         IF(ln_ctl) THEN 
-            CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk) 
-            CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 
-         ENDIF 
-
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions
+      !
+      !                                           !* horizontal Shapiro filter
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
+            DO ji = 2, jpim1
+               zcofw = wmask(ji,jj,jk) * z1_16
+               wslpi(ji,jj,jk) = (         zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                    &               +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                    &               + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                    &               +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                    &               + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw
+
+               wslpj(ji,jj,jk) = (         zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                    &               +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                    &               + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                    &               +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                    &               + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw
+            END DO
+         END DO
+         DO jj = 3, jpj-2                               ! other rows
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcofw = wmask(ji,jj,jk) * z1_16
+               wslpi(ji,jj,jk) = (         zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                    &               +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                    &               + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                    &               +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                    &               + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw
+
+               wslpj(ji,jj,jk) = (         zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                    &               +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                    &               + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                    &               +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                    &               + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw
+            END DO
+         END DO
+         !                                        !* decrease in vicinity of topography
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   &
+                  &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25
+               wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck
+               wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck
+            END DO
+         END DO
+      END DO
+
+      ! IV. Lateral boundary conditions
+      ! ===============================
+      CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )
+      CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk)
+         CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk)
       ENDIF
-      
+      !
       CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv )
-      CALL wrk_dealloc( jpi,jpj,     zhmlpu, zhmlpv)
+      CALL wrk_dealloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv )
       !
       IF( nn_timing == 1 )  CALL timing_stop('ldf_slp')
@@ -470,10 +383,10 @@
 
 
-   SUBROUTINE ldf_slp_grif ( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE ldf_slp_grif  ***
+   SUBROUTINE ldf_slp_triad ( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp_triad  ***
       !!
       !! ** Purpose :   Compute the squared slopes of neutral surfaces (slope
-      !!      of iso-pycnal surfaces referenced locally) (ln_traldf_grif=T)
+      !!      of iso-pycnal surfaces referenced locally) (ln_traldf_triad=T)
       !!      at W-points using the Griffies quarter-cells.
       !!
@@ -490,16 +403,20 @@
       REAL(wp) ::   zfacti, zfactj              ! local scalars
       REAL(wp) ::   znot_thru_surface           ! local scalars
-      REAL(wp) ::   zdit, zdis, zdjt, zdjs, zdkt, zdks, zbu, zbv, zbti, zbtj
+      REAL(wp) ::   zdit, zdis, zdkt, zbu, zbti, zisw
+      REAL(wp) ::   zdjt, zdjs, zdks, zbv, zbtj, zjsw
       REAL(wp) ::   zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_g_raw, zti_g_lim
       REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim
       REAL(wp) ::   zdzrho_raw
+      REAL(wp) ::   zbeta0, ze3_e1, ze3_e2
       REAL(wp), POINTER, DIMENSION(:,:)     ::   z1_mlbw
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalbet
       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients
       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_grif')
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_triad')
       !
       CALL wrk_alloc( jpi,jpj, z1_mlbw )
+      CALL wrk_alloc( jpi,jpj,jpk, zalbet )
       CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
       CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
@@ -519,8 +436,8 @@
                   zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! j-gradient of T & S at v-point
                   zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
-                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,jk,jp_tem) * zdit + rab_b(ji+ip,jj   ,jk,jp_sal) * zdis ) / e1u(ji,jj)
-                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji   ,jj+jp,jk,jp_sal) * zdjs ) / e2v(ji,jj)
-                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign
-                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw )
+                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,jk,jp_tem) * zdit + rab_b(ji+ip,jj   ,jk,jp_sal) * zdis ) * r1_e1u(ji,jj)
+                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji   ,jj+jp,jk,jp_sal) * zdjs ) * r1_e2v(ji,jj)
+                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN(  MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw  )   ! keep the sign
+                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN(  MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw  )
                END DO
             END DO
@@ -533,6 +450,6 @@
                   zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature
                   zdis = gtsu(ji,jj,jp_sal)   ;   zdjs = gtsv(ji,jj,jp_sal)      ! i- & j-gradient of Salinity
-                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,iku,jp_tem) * zdit + rab_b(ji+ip,jj   ,iku,jp_sal) * zdis ) / e1u(ji,jj)
-                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji   ,jj+jp,ikv,jp_sal) * zdjs ) / e2v(ji,jj)
+                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,iku,jp_tem) * zdit + rab_b(ji+ip,jj   ,iku,jp_sal) * zdis ) * r1_e1u(ji,jj)
+                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji   ,jj+jp,ikv,jp_sal) * zdjs ) * r1_e2v(ji,jj)
                   zdxrho(ji+ip,jj   ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign
                   zdyrho(ji   ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw )
@@ -554,6 +471,6 @@
                      zdks = 0._wp
                   ENDIF
-                  zdzrho_raw = ( - rab_b(ji,jj,jk,jp_tem) * zdkt + rab_b(ji,jj,jk,jp_sal) * zdks ) / fse3w(ji,jj,jk+kp)
-                  zdzrho(ji,jj,jk,kp) = - MIN( - repsln, zdzrho_raw )    ! force zdzrho >= repsln
+                  zdzrho_raw = ( - zalbet(ji,jj,jk) * zdkt + zbeta0*zdks ) / e3w_n(ji,jj,jk+kp)
+                  zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw )    ! force zdzrho >= repsln
                  END DO
             END DO
@@ -564,5 +481,5 @@
          DO ji = 1, jpi
             jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth
-            z1_mlbw(ji,jj) = 1._wp / fsdepw(ji,jj,jk)
+            z1_mlbw(ji,jj) = 1._wp / gdepw_n(ji,jj,jk)
          END DO
       END DO
@@ -588,20 +505,22 @@
                   !
                   jk = nmln(ji+ip,jj) + 1
-                  IF( jk .GT. mbkt(ji+ip,jj) ) THEN  !ML reaches bottom
-                    zti_mlb(ji+ip,jj   ,1-ip,kp) = 0.0_wp
-                  ELSE
-                    ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth)
-                    zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      &
-                       &      - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj)  ) * umask(ji,jj,jk)
-                    zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw )
+                  IF( jk > mbkt(ji+ip,jj) ) THEN   ! ML reaches bottom
+                     zti_mlb(ji+ip,jj   ,1-ip,kp) = 0.0_wp
+                  ELSE                             
+                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth)
+                     zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      &
+                        &          - ( gdept_n(ji+1,jj,jk-kp) - gdept_n(ji,jj,jk-kp) ) * r1_e1u(ji,jj)  ) * umask(ji,jj,jk)
+                     ze3_e1    =  e3w_n(ji+ip,jj,jk-kp) * r1_e1u(ji,jj) 
+                     zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1  , ABS( zti_g_raw ) ), zti_g_raw )
                   ENDIF
                   !
                   jk = nmln(ji,jj+jp) + 1
-                  IF( jk .GT. mbkt(ji,jj+jp) ) THEN  !ML reaches bottom
-                    ztj_mlb(ji   ,jj+jp,1-jp,kp) = 0.0_wp
+                  IF( jk >  mbkt(ji,jj+jp) ) THEN  !ML reaches bottom
+                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = 0.0_wp
                   ELSE
-                    ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      &
-                       &      - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk)
-                    ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw )
+                     ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      &
+                        &      - ( gdept_n(ji,jj+1,jk-kp) - gdept_n(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk)
+                     ze3_e2    =  e3w_n(ji,jj+jp,jk-kp) / e2v(ji,jj)
+                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2  , ABS( ztj_g_raw ) ), ztj_g_raw )
                   ENDIF
                END DO
@@ -632,12 +551,16 @@
                      zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                   ! unmasked
                      ztj_raw   = zdyrho(ji   ,jj+jp,jk,1-jp) / zdzrho(ji   ,jj+jp,jk,kp)
-
+                     !
                      ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface
-                     zti_coord = znot_thru_surface * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj)
-                     ztj_coord = znot_thru_surface * ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj)                  ! unmasked
+                     zti_coord = znot_thru_surface * ( gdept_n(ji+1,jj  ,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj)
+                     ztj_coord = znot_thru_surface * ( gdept_n(ji  ,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj)     ! unmasked
                      zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces
                      ztj_g_raw = ztj_raw - ztj_coord
-                     zti_g_lim = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw )
-                     ztj_g_lim = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw )
+                     ! additional limit required in bilaplacian case
+                     ze3_e1    = e3w_n(ji+ip,jj   ,jk+kp) * r1_e1u(ji,jj)
+                     ze3_e2    = e3w_n(ji   ,jj+jp,jk+kp) * r1_e2v(ji,jj)
+                     ! NB: hard coded factor 5 (can be a namelist parameter...)
+                     zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw )
+                     ztj_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2, ABS( ztj_g_raw ) ), ztj_g_raw )
                      !
                      ! Below  ML use limited zti_g as is & mask
@@ -649,8 +572,8 @@
                      zti_g_lim =          ( zfacti   * zti_g_lim                       &
                         &      + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp)   &
-                        &                           * fsdepw(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp)
+                        &                           * gdepw_n(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp)
                      ztj_g_lim =          ( zfactj   * ztj_g_lim                       &
                         &      + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp)   &
-                        &                           * fsdepw(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp)
+                        &                           * gdepw_n(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp)
                      !
                      triadi_g(ji+ip,jj   ,jk,1-ip,kp) = zti_g_lim
@@ -668,24 +591,27 @@
                      !
                      IF( ln_triad_iso ) THEN
-                        zti_raw = zti_lim**2 / zti_raw
-                        ztj_raw = ztj_lim**2 / ztj_raw
+                        zti_raw = zti_lim*zti_lim / zti_raw
+                        ztj_raw = ztj_lim*ztj_lim / ztj_raw
                         zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw )
                         ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw )
-                        zti_lim =           zfacti   * zti_lim                       &
-                        &      + ( 1._wp - zfacti ) * zti_raw
-                        ztj_lim =           zfactj   * ztj_lim                       &
-                        &      + ( 1._wp - zfactj ) * ztj_raw
+                        zti_lim = zfacti * zti_lim + ( 1._wp - zfacti ) * zti_raw
+                        ztj_lim = zfactj * ztj_lim + ( 1._wp - zfactj ) * ztj_raw
                      ENDIF
-                     triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim
-                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim
-                    !
-                     zbu = e1u(ji    ,jj) * e2u(ji   ,jj) * fse3u(ji   ,jj,jk   )
-                     zbv = e1v(ji    ,jj) * e2v(ji   ,jj) * fse3v(ji   ,jj,jk   )
-                     zbti = e1t(ji+ip,jj) * e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp)
-                     zbtj = e1t(ji,jj+jp) * e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp)
-                     !
-                     !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers....  ==> to be checked
-                     wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim**2      ! masked
-                     wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim**2
+                     !                                      ! switching triad scheme 
+                     zisw = (rn_sw_triad - 1._wp ) + rn_sw_triad    &
+                        &            * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - ip ) * SIGN( 1._wp , zdxrho(ji+ip,jj,jk,1-ip) )  )
+                     zjsw = (rn_sw_triad - 1._wp ) + rn_sw_triad    &
+                        &            * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - jp ) * SIGN( 1._wp , zdyrho(ji,jj+jp,jk,1-jp) )  )
+                     !
+                     triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim * zisw
+                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim * zjsw
+                     !
+                     zbu  = e1e2u(ji   ,jj   ) * e3u_n(ji   ,jj   ,jk   )
+                     zbv  = e1e2v(ji   ,jj   ) * e3v_n(ji   ,jj   ,jk   )
+                     zbti = e1e2t(ji+ip,jj   ) * e3w_n(ji+ip,jj   ,jk+kp)
+                     zbtj = e1e2t(ji   ,jj+jp) * e3w_n(ji   ,jj+jp,jk+kp)
+                     !
+                     wslp2(ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim*zti_g_lim      ! masked
+                     wslp2(ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim*ztj_g_lim
                   END DO
                END DO
@@ -699,10 +625,11 @@
       !
       CALL wrk_dealloc( jpi,jpj, z1_mlbw )
+      CALL wrk_dealloc( jpi,jpj,jpk, zalbet )
       CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
       CALL wrk_dealloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
       !
-      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_grif')
-      !
-   END SUBROUTINE ldf_slp_grif
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_triad')
+      !
+   END SUBROUTINE ldf_slp_triad
 
 
@@ -730,5 +657,5 @@
       INTEGER  ::   ji , jj , jk                   ! dummy loop indices
       INTEGER  ::   iku, ikv, ik, ikm1             ! local integers
-      REAL(wp) ::   zeps, zm1_g, zm1_2g            ! local scalars
+      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_slpmax ! local scalars
       REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      -
       REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
@@ -741,4 +668,5 @@
       zm1_g  = -1.0_wp / grav
       zm1_2g = -0.5_wp / grav
+      z1_slpmax = 1._wp / rn_slpmax
       !
       uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp
@@ -752,8 +680,6 @@
             DO ji = 1, jpi
                ik = nmln(ji,jj) - 1
-               IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN
-                  omlmask(ji,jj,jk) = 1._wp
-               ELSE
-                  omlmask(ji,jj,jk) = 0._wp
+               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp
+               ELSE                  ;   omlmask(ji,jj,jk) = 0._wp
                ENDIF
             END DO
@@ -777,15 +703,15 @@
             !
             !                        !- vertical density gradient for u- and v-slopes (from dzr at T-point)
-            iku = MIN(  MAX( miku(ji,jj)+1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1)
-            ikv = MIN(  MAX( mikv(ji,jj)+1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1  )   !
+            iku = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1)
+            ikv = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1  )   !
             zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj  ,iku) )
             zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji  ,jj+1,ikv) )
             !                        !- horizontal density gradient at u- & v-points
-            zau = p_gru(ji,jj,iku) / e1u(ji,jj)
-            zav = p_grv(ji,jj,ikv) / e2v(ji,jj)
+            zau = p_gru(ji,jj,iku) * r1_e1u(ji,jj)
+            zav = p_grv(ji,jj,ikv) * r1_e2v(ji,jj)
             !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0
             !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-            zbu = MIN(  zbu , -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau )  )
-            zbv = MIN(  zbv , -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav )  )
+            zbu = MIN(  zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,iku)* ABS( zau )  )
+            zbv = MIN(  zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,ikv)* ABS( zav )  )
             !                        !- Slope at u- & v-points (uslpml, vslpml)
             uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku)
@@ -803,5 +729,5 @@
             zcj = MAX(   vmask(ji,jj-1,ik  ) + vmask(ji,jj,ik  )           &
                &       + vmask(ji,jj-1,ikm1) + vmask(ji,jj,ikm1) , zeps  ) * e2t(ji,jj)
-            zai =    (   p_gru(ji-1,jj,ik  ) + p_gru(ji,jj,ik)           &
+            zai =    (   p_gru(ji-1,jj,ik  ) + p_gru(ji,jj,ik)             &
                &       + p_gru(ji-1,jj,ikm1) + p_gru(ji,jj,ikm1  )  ) / zci  * tmask(ji,jj,ik)
             zaj =    (   p_grv(ji,jj-1,ik  ) + p_grv(ji,jj,ik  )           &
@@ -809,9 +735,9 @@
             !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0.
             !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-            zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zai )  )
-            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj )  )
+            zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/e3w_n(ji,jj,ik)* ABS( zai )  )
+            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,ik)* ABS( zaj )  )
             !                        !- i- & j-slope at w-points (wslpiml, wslpjml)
-            wslpiml(ji,jj) = zai / ( zbi - zeps ) * wmask (ji,jj,ik)
-            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * wmask (ji,jj,ik)
+            wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik)
+            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik)
          END DO
       END DO
@@ -831,6 +757,5 @@
       !! ** Purpose :   Initialization for the isopycnal slopes computation
       !!
-      !! ** Method  :   read the nammbf namelist and check the parameter
-      !!      values called by tra_dmp at the first timestep (nit000)
+      !! ** Method  :   
       !!----------------------------------------------------------------------
       INTEGER ::   ji, jj, jk   ! dummy loop indices
@@ -845,15 +770,21 @@
          WRITE(numout,*) '~~~~~~~~~~~~'
       ENDIF
-
-      IF( ln_traldf_grif ) THEN        ! Griffies operator : triad of slopes
-         ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr )
-         ALLOCATE( triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1)                      , STAT=ierr )
-         IF( ierr > 0             )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' )
-         !
+      !
+      ALLOCATE( ah_wslp2(jpi,jpj,jpk) , akz(jpi,jpj,jpk) , STAT=ierr )
+      IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate ah_slp2 or akz' )
+      !
+      IF( ln_traldf_triad ) THEN        ! Griffies operator : triad of slopes
+         IF(lwp) WRITE(numout,*) '              Griffies (triad) operator initialisation'
+         ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) ,     &
+            &      triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1) ,     &
+            &      wslp2   (jpi,jpj,jpk)                                         , STAT=ierr )
+         IF( ierr > 0      )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' )
          IF( ln_dynldf_iso )   CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' )
          !
       ELSE                             ! Madec operator : slopes at u-, v-, and w-points
-         ALLOCATE( uslp(jpi,jpj,jpk) , vslp(jpi,jpj,jpk) , wslpi(jpi,jpj,jpk) , wslpj(jpi,jpj,jpk) ,                &
-            &   omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj)   , vslpml(jpi,jpj)    , wslpiml(jpi,jpj)   , wslpjml(jpi,jpj) , STAT=ierr )
+         IF(lwp) WRITE(numout,*) '              Madec operator initialisation'
+         ALLOCATE( omlmask(jpi,jpj,jpk) ,                                                                        &
+            &      uslp(jpi,jpj,jpk) , uslpml(jpi,jpj) , wslpi(jpi,jpj,jpk) , wslpiml(jpi,jpj) ,     &
+            &      vslp(jpi,jpj,jpk) , vslpml(jpi,jpj) , wslpj(jpi,jpj,jpk) , wslpjml(jpi,jpj) , STAT=ierr )
          IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' )
 
@@ -865,26 +796,27 @@
          wslpj(:,:,:) = 0._wp   ;   wslpjml(:,:) = 0._wp
 
-         IF(ln_sco .AND.  (ln_traldf_hor .OR. ln_dynldf_hor )) THEN
-            IF(lwp)   WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces'
-
-            ! geopotential diffusion in s-coordinates on tracers and/or momentum
-            ! The slopes of s-surfaces are computed once (no call to ldfslp in step)
-            ! The slopes for momentum diffusion are i- or j- averaged of those on tracers
-
-            ! set the slope of diffusion to the slope of s-surfaces
-            !      ( c a u t i o n : minus sign as fsdep has positive value )
-            DO jk = 1, jpk
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk)
-                     vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)
-                     wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5
-                     wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5
-                  END DO
-               END DO
-            END DO
-            CALL lbc_lnk( uslp , 'U', -1. )   ;   CALL lbc_lnk( vslp , 'V', -1. )      ! Lateral boundary conditions
-            CALL lbc_lnk( wslpi, 'W', -1. )   ;   CALL lbc_lnk( wslpj, 'W', -1. )
-         ENDIF
+         !!gm I no longer understand this.....
+!!gm         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (.NOT.ln_linssh .AND. ln_rstart) ) THEN
+!            IF(lwp)   WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces'
+!
+!            ! geopotential diffusion in s-coordinates on tracers and/or momentum
+!            ! The slopes of s-surfaces are computed once (no call to ldfslp in step)
+!            ! The slopes for momentum diffusion are i- or j- averaged of those on tracers
+!
+!            ! set the slope of diffusion to the slope of s-surfaces
+!            !      ( c a u t i o n : minus sign as dep has positive value )
+!            DO jk = 1, jpk
+!               DO jj = 2, jpjm1
+!                  DO ji = fs_2, fs_jpim1   ! vector opt.
+!                     uslp (ji,jj,jk) = - ( gdept_n(ji+1,jj,jk) - gdept_n(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
+!                     vslp (ji,jj,jk) = - ( gdept_n(ji,jj+1,jk) - gdept_n(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)
+!                     wslpi(ji,jj,jk) = - ( gdepw_n(ji+1,jj,jk) - gdepw_n(ji-1,jj,jk) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5
+!                     wslpj(ji,jj,jk) = - ( gdepw_n(ji,jj+1,jk) - gdepw_n(ji,jj-1,jk) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5
+!                  END DO
+!               END DO
+!            END DO
+!            CALL lbc_lnk( uslp , 'U', -1. )   ;   CALL lbc_lnk( vslp , 'V', -1. )      ! Lateral boundary conditions
+!            CALL lbc_lnk( wslpi, 'W', -1. )   ;   CALL lbc_lnk( wslpj, 'W', -1. )
+!!gm         ENDIF
       ENDIF
       !
@@ -892,23 +824,4 @@
       !
    END SUBROUTINE ldf_slp_init
-
-#else
-   !!------------------------------------------------------------------------
-   !!   Dummy module :                 NO Rotation of lateral mixing tensor
-   !!------------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_ldfslp = .FALSE.    !: slopes flag
-CONTAINS
-   SUBROUTINE ldf_slp( kt, prd, pn2 )   ! Dummy routine
-      INTEGER, INTENT(in) :: kt
-      REAL, DIMENSION(:,:,:), INTENT(in) :: prd, pn2
-      WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1)
-   END SUBROUTINE ldf_slp
-   SUBROUTINE ldf_slp_grif( kt )        ! Dummy routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'ldf_slp_grif: You should not have seen this print! error?', kt
-   END SUBROUTINE ldf_slp_grif
-   SUBROUTINE ldf_slp_init              ! Dummy routine
-   END SUBROUTINE ldf_slp_init
-#endif
 
    !!======================================================================
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 6808)
@@ -2,37 +2,86 @@
    !!======================================================================
    !!                       ***  MODULE  ldftra  ***
-   !! Ocean physics:  lateral diffusivity coefficient 
+   !! Ocean physics:  lateral diffusivity coefficients 
    !!=====================================================================
-   !! History :        ! 1997-07  (G. Madec)  from inimix.F split in 2 routines
-   !!   NEMO      1.0  ! 2002-09  (G. Madec)  F90: Free form and module
-   !!             2.0  ! 2005-11  (G. Madec)  
+   !! History :       ! 1997-07  (G. Madec)  from inimix.F split in 2 routines
+   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
+   !!            2.0  ! 2005-11  (G. Madec)  
+   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  restructuration/simplification of aht/aeiv specification,
+   !!                 !                                  add velocity dependent coefficient and optional read in file
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   ldf_tra_init : initialization, namelist read, and parameters control
-   !!   ldf_tra_c3d   : 3D eddy viscosity coefficient initialization
-   !!   ldf_tra_c2d   : 2D eddy viscosity coefficient initialization
-   !!   ldf_tra_c1d   : 1D eddy viscosity coefficient initialization
+   !!   ldf_tra      : update lateral eddy diffusivity coefficients at each time step 
+   !!   ldf_eiv_init : initialization of the eiv coeff. from namelist choices 
+   !!   ldf_eiv      : time evolution of the eiv coefficients (function of the growth rate of baroclinic instability)
+   !!   ldf_eiv_trp  : add to the input ocean transport the contribution of the EIV parametrization
+   !!   ldf_eiv_dia  : diagnose the eddy induced velocity from the eiv streamfunction
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
    USE phycst          ! physical constants
-   USE ldftra_oce      ! ocean tracer   lateral physics
-   USE ldfslp          ! ???
+   USE ldfslp          ! lateral diffusion: slope of iso-neutral surfaces
+   USE ldfc1d_c2d      ! lateral diffusion: 1D & 2D cases 
+   USE diaar5, ONLY:   lk_diaar5
+   !
+   USE trc_oce, ONLY: lk_offline ! offline flag
    USE in_out_manager  ! I/O manager
-   USE ioipsl
+   USE iom             ! I/O module for ehanced bottom friction file
    USE lib_mpp         ! distribued memory computing library
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! work arrays
+   USE timing          ! timing
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   ldf_tra_init   ! called by opa.F90
+   PUBLIC   ldf_tra_init   ! called by nemogcm.F90
+   PUBLIC   ldf_tra        ! called by step.F90
+   PUBLIC   ldf_eiv_init   ! called by nemogcm.F90
+   PUBLIC   ldf_eiv        ! called by step.F90
+   PUBLIC   ldf_eiv_trp    ! called by traadv.F90
+   PUBLIC   ldf_eiv_dia    ! called by traldf_iso and traldf_iso_triad.F90
+   
+   !                                   !!* Namelist namtra_ldf : lateral mixing on tracers * 
+   !                                    != Operator type =!
+   LOGICAL , PUBLIC ::   ln_traldf_lap       !: laplacian operator
+   LOGICAL , PUBLIC ::   ln_traldf_blp       !: bilaplacian operator
+   !                                    != Direction of action =!
+   LOGICAL , PUBLIC ::   ln_traldf_lev       !: iso-level direction
+   LOGICAL , PUBLIC ::   ln_traldf_hor       !: horizontal (geopotential) direction
+!  LOGICAL , PUBLIC ::   ln_traldf_iso       !: iso-neutral direction                    (see ldfslp)
+!  LOGICAL , PUBLIC ::   ln_traldf_triad     !: griffies triad scheme                    (see ldfslp)
+   LOGICAL , PUBLIC ::   ln_traldf_msc       !: Method of Stabilizing Correction 
+!  LOGICAL , PUBLIC ::   ln_triad_iso        !: pure horizontal mixing in ML             (see ldfslp)
+!  LOGICAL , PUBLIC ::   ln_botmix_triad     !: mixing on bottom                         (see ldfslp)
+!  REAL(wp), PUBLIC ::   rn_sw_triad         !: =1/0 switching triad / all 4 triads used (see ldfslp)
+!  REAL(wp), PUBLIC ::   rn_slpmax           !: slope limit                              (see ldfslp)
+   !                                    !=  Coefficients =!
+   INTEGER , PUBLIC ::   nn_aht_ijk_t        !: choice of time & space variations of the lateral eddy diffusivity coef.
+   REAL(wp), PUBLIC ::   rn_aht_0            !:   laplacian lateral eddy diffusivity [m2/s]
+   REAL(wp), PUBLIC ::   rn_bht_0            !: bilaplacian lateral eddy diffusivity [m4/s]
+
+   !                                   !!* Namelist namtra_ldfeiv : eddy induced velocity param. *
+   !                                    != Use/diagnose eiv =!
+   LOGICAL , PUBLIC ::   ln_ldfeiv           !: eddy induced velocity flag
+   LOGICAL , PUBLIC ::   ln_ldfeiv_dia       !: diagnose & output eiv streamfunction and velocity (IOM)
+   !                                    != Coefficients =!
+   INTEGER , PUBLIC ::   nn_aei_ijk_t        !: choice of time/space variation of the eiv coeff.
+   REAL(wp), PUBLIC ::   rn_aeiv_0           !: eddy induced velocity coefficient [m2/s]
+   
+   LOGICAL , PUBLIC ::   l_ldftra_time = .FALSE.   !: flag for time variation of the lateral eddy diffusivity coef.
+   LOGICAL , PUBLIC ::   l_ldfeiv_time = .FALSE.   ! flag for time variation of the eiv coef.
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtu, ahtv   !: eddy diffusivity coef. at U- and V-points   [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aeiu, aeiv   !: eddy induced velocity coeff.                [m2/s]
+
+   REAL(wp) ::   r1_4  = 0.25_wp          ! =1/4
+   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! =1/12
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -46,45 +95,49 @@
       !! ** Purpose :   initializations of the tracer lateral mixing coeff.
       !!
-      !! ** Method  :   the Eddy diffusivity and eddy induced velocity ceoff.
-      !!      are defined as follows:
-      !!         default option   : constant coef. aht0, aeiv0 (namelist)
-      !!        'key_traldf_c1d': depth dependent coef. defined in 
-      !!                            in ldf_tra_c1d routine
-      !!        'key_traldf_c2d': latitude and longitude dependent coef.
-      !!                            defined in ldf_tra_c2d routine
-      !!        'key_traldf_c3d': latitude, longitude, depth dependent coef.
-      !!                            defined in ldf_tra_c3d routine
-      !!
-      !!      N.B. User defined include files.  By default, 3d and 2d coef.
-      !!      are set to a constant value given in the namelist and the 1d
-      !!      coefficients are initialized to a hyperbolic tangent vertical
-      !!      profile.
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio               ! temporary integer
-      INTEGER ::   ios                  ! temporary integer
-      LOGICAL ::   ll_print = .FALSE.   ! =T print eddy coef. in numout
-      !! 
-      NAMELIST/namtra_ldf/ ln_traldf_lap  , ln_traldf_bilap,                  &
-         &                 ln_traldf_level, ln_traldf_hor  , ln_traldf_iso,   &
-         &                 ln_traldf_grif , ln_traldf_gdia ,                  &
-         &                 ln_triad_iso   , ln_botmix_grif ,                  &
-         &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0,       &
-         &                 rn_slpmax      , rn_chsmag      ,    rn_smsh,      &
-         &                 rn_aht_m
-      !!----------------------------------------------------------------------
-
-      !  Define the lateral tracer physics parameters
-      ! =============================================
-    
-
+      !! ** Method  : * the eddy diffusivity coef. specification depends on:
+      !!
+      !!    ln_traldf_lap = T     laplacian operator
+      !!    ln_traldf_blp = T   bilaplacian operator
+      !!
+      !!    nn_aht_ijk_t  =  0 => = constant
+      !!                  !
+      !!                  = 10 => = F(z) : constant with a reduction of 1/4 with depth 
+      !!                  !
+      !!                  =-20 => = F(i,j)   = shape read in 'eddy_diffusivity.nc' file
+      !!                  = 20    = F(i,j)   = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case)
+      !!                  = 21    = F(i,j,t) = F(growth rate of baroclinic instability)
+      !!                  !
+      !!                  =-30 => = F(i,j,k)   = shape read in 'eddy_diffusivity.nc' file
+      !!                  = 30    = F(i,j,k)   = 2D (case 20) + decrease with depth (case 10)
+      !!                  = 31    = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator
+      !!                                                          or |u|e^3/12 bilaplacian operator )
+      !!              * initialisation of the eddy induced velocity coefficient by a call to ldf_eiv_init 
+      !!            
+      !! ** action  : ahtu, ahtv initialized once for all or l_ldftra_time set to true
+      !!              aeiu, aeiv initialized once for all or l_ldfeiv_time set to true
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk                ! dummy loop indices
+      INTEGER  ::   ierr, inum, ios   ! local integer
+      REAL(wp) ::   zah0              ! local scalar
+      !
+      NAMELIST/namtra_ldf/ ln_traldf_lap, ln_traldf_blp  ,                   &   ! type of operator
+         &                 ln_traldf_lev, ln_traldf_hor  , ln_traldf_triad,  &   ! acting direction of the operator
+         &                 ln_traldf_iso, ln_traldf_msc  ,  rn_slpmax     ,  &   ! option for iso-neutral operator
+         &                 ln_triad_iso , ln_botmix_triad, rn_sw_triad    ,  &   ! option for triad operator
+         &                 rn_aht_0     , rn_bht_0       , nn_aht_ijk_t          ! lateral eddy coefficient
+      !!----------------------------------------------------------------------
+      !
+      !  Choice of lateral tracer physics
+      ! =================================
+      !
       REWIND( numnam_ref )              ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers
       READ  ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp )
-
+      !
       REWIND( numnam_cfg )              ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers
       READ  ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namtra_ldf )
-
+      !
       IF(lwp) THEN                      ! control print
          WRITE(numout,*)
@@ -92,98 +145,625 @@
          WRITE(numout,*) '~~~~~~~~~~~~ '
          WRITE(numout,*) '   Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)'
-         WRITE(numout,*) '      laplacian operator            ln_traldf_lap   = ', ln_traldf_lap
-         WRITE(numout,*) '      bilaplacian operator          ln_traldf_bilap = ', ln_traldf_bilap
-         WRITE(numout,*) '      iso-level                     ln_traldf_level = ', ln_traldf_level
-         WRITE(numout,*) '      horizontal (geopotential)     ln_traldf_hor   = ', ln_traldf_hor
-         WRITE(numout,*) '      iso-neutral                   ln_traldf_iso   = ', ln_traldf_iso
-         WRITE(numout,*) '      iso-neutral (Griffies)        ln_traldf_grif  = ', ln_traldf_grif
-         WRITE(numout,*) '      Griffies strmfn diagnostics   ln_traldf_gdia  = ', ln_traldf_gdia
-         WRITE(numout,*) '      lateral eddy diffusivity      rn_aht_0        = ', rn_aht_0
-         WRITE(numout,*) '      background hor. diffusivity   rn_ahtb_0       = ', rn_ahtb_0
-         WRITE(numout,*) '      eddy induced velocity coef.   rn_aeiv_0       = ', rn_aeiv_0
-         WRITE(numout,*) '      maximum isoppycnal slope      rn_slpmax       = ', rn_slpmax
-         WRITE(numout,*) '      pure lateral mixing in ML     ln_triad_iso    = ', ln_triad_iso
-         WRITE(numout,*) '      lateral mixing on bottom      ln_botmix_grif  = ', ln_botmix_grif
+         !
+         WRITE(numout,*) '      type :'
+         WRITE(numout,*) '         laplacian operator                      ln_traldf_lap   = ', ln_traldf_lap
+         WRITE(numout,*) '         bilaplacian operator                    ln_traldf_blp   = ', ln_traldf_blp
+         !
+         WRITE(numout,*) '      direction of action :'
+         WRITE(numout,*) '         iso-level                               ln_traldf_lev   = ', ln_traldf_lev
+         WRITE(numout,*) '         horizontal (geopotential)               ln_traldf_hor   = ', ln_traldf_hor
+         WRITE(numout,*) '         iso-neutral Madec operator              ln_traldf_iso   = ', ln_traldf_iso
+         WRITE(numout,*) '         iso-neutral triad operator              ln_traldf_triad = ', ln_traldf_triad
+         WRITE(numout,*) '            iso-neutral (Method of Stab. Corr.)  ln_traldf_msc   = ', ln_traldf_msc
+         WRITE(numout,*) '            maximum isoppycnal slope             rn_slpmax       = ', rn_slpmax
+         WRITE(numout,*) '            pure lateral mixing in ML            ln_triad_iso    = ', ln_triad_iso
+         WRITE(numout,*) '            switching triad or not               rn_sw_triad     = ', rn_sw_triad
+         WRITE(numout,*) '            lateral mixing on bottom             ln_botmix_triad = ', ln_botmix_triad
+         !
+         WRITE(numout,*) '      coefficients :'
+         WRITE(numout,*) '         lateral eddy diffusivity   (lap case)   rn_aht_0        = ', rn_aht_0
+         WRITE(numout,*) '         lateral eddy diffusivity (bilap case)   rn_bht_0        = ', rn_bht_0
+         WRITE(numout,*) '         type of time-space variation            nn_aht_ijk_t    = ', nn_aht_ijk_t
+      ENDIF
+      !
+      !                                ! Parameter control
+      !
+      IF( .NOT.ln_traldf_lap .AND. .NOT.ln_traldf_blp ) THEN
+         IF(lwp) WRITE(numout,*) '   No diffusive operator selected. ahtu and ahtv are not allocated'
+         l_ldftra_time = .FALSE.
+         RETURN
+      ENDIF
+      !
+      IF( ln_traldf_blp .AND. ( ln_traldf_iso .OR. ln_traldf_triad) ) THEN     ! iso-neutral bilaplacian need MSC
+         IF( .NOT.ln_traldf_msc )   CALL ctl_stop( 'tra_ldf_init: iso-neutral bilaplacian requires ln_traldf_msc=.true.' )
+      ENDIF
+      !
+      !  Space/time variation of eddy coefficients 
+      ! ===========================================
+      !                                               ! allocate the aht arrays
+      ALLOCATE( ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , STAT=ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays')
+      !
+      ahtu(:,:,jpk) = 0._wp                           ! last level always 0  
+      ahtv(:,:,jpk) = 0._wp
+      !
+      !                                               ! value of eddy mixing coef.
+      IF    ( ln_traldf_lap ) THEN   ;   zah0 =      rn_aht_0        !   laplacian operator
+      ELSEIF( ln_traldf_blp ) THEN   ;   zah0 = ABS( rn_bht_0 )      ! bilaplacian operator
+      ENDIF
+      !
+      l_ldftra_time = .FALSE.                         ! no time variation except in case defined below
+      !
+      IF( ln_traldf_lap .OR. ln_traldf_blp ) THEN     ! only if a lateral diffusion operator is used
+         !
+         SELECT CASE(  nn_aht_ijk_t  )                   ! Specification of space time variations of ehtu, ahtv
+         !
+         CASE(   0  )      !==  constant  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant = ', rn_aht_0
+            ahtu(:,:,:) = zah0 * umask(:,:,:)
+            ahtv(:,:,:) = zah0 * vmask(:,:,:)
+            !
+         CASE(  10  )      !==  fixed profile  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )'
+            ahtu(:,:,1) = zah0 * umask(:,:,1)                      ! constant surface value
+            ahtv(:,:,1) = zah0 * vmask(:,:,1)
+            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv )
+            !
+         CASE ( -20 )      !== fixed horizontal shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j) read in eddy_diffusivity.nc file'
+            CALL iom_open( 'eddy_diffusivity_2D.nc', inum )
+            CALL iom_get ( inum, jpdom_data, 'ahtu_2D', ahtu(:,:,1) )
+            CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) )
+            CALL iom_close( inum )
+            DO jk = 2, jpkm1
+               ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk)
+               ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk)
+            END DO
+            !
+         CASE(  20  )      !== fixed horizontal shape  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or blp case)'
+            IF( ln_traldf_lap )   CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor
+            IF( ln_traldf_blp )   CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor
+            !
+         CASE(  21  )      !==  time varying 2D field  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, time )'
+            IF(lwp) WRITE(numout,*) '                              = F( growth rate of baroclinic instability )'
+            IF(lwp) WRITE(numout,*) '                              min value = 0.1 * rn_aht_0'
+            IF(lwp) WRITE(numout,*) '                              max value = rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)'
+            IF(lwp) WRITE(numout,*) '                              increased to rn_aht_0 within 20N-20S'
+            !
+            l_ldftra_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90
+            !
+            IF( ln_traldf_blp ) THEN
+               CALL ctl_stop( 'ldf_tra_init: aht=F(growth rate of baroc. insta.) incompatible with bilaplacian operator' )
+            ENDIF
+            !
+         CASE( -30  )      !== fixed 3D shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j,k) read in eddy_diffusivity.nc file'
+            CALL iom_open( 'eddy_diffusivity_3D.nc', inum )
+            CALL iom_get ( inum, jpdom_data, 'ahtu_3D', ahtu )
+            CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv )
+            CALL iom_close( inum )
+            DO jk = 1, jpkm1
+               ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk)
+               ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk)
+            END DO
+            !
+         CASE(  30  )      !==  fixed 3D shape  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth )'
+            IF( ln_traldf_lap )   CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor
+            IF( ln_traldf_blp )   CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor
+            !                                                    ! reduction with depth
+            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv )
+            !
+         CASE(  31  )      !==  time varying 3D field  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth , time )'
+            IF(lwp) WRITE(numout,*) '                                proportional to the velocity : |u|e/12 or |u|e^3/12'
+            !
+            l_ldftra_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90
+            !
+         CASE DEFAULT
+            CALL ctl_stop('ldf_tra_init: wrong choice for nn_aht_ijk_t, the type of space-time variation of aht')
+         END SELECT
+         !
+         IF( ln_traldf_blp .AND. .NOT. l_ldftra_time ) THEN
+            ahtu(:,:,:) = SQRT( ahtu(:,:,:) )
+            ahtv(:,:,:) = SQRT( ahtv(:,:,:) )
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE ldf_tra_init
+
+
+   SUBROUTINE ldf_tra( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_tra  ***
+      !! 
+      !! ** Purpose :   update at kt the tracer lateral mixing coeff. (aht and aeiv)
+      !!
+      !! ** Method  :   time varying eddy diffusivity coefficients:
+      !!
+      !!    nn_aei_ijk_t = 21    aeiu, aeiv = F(i,j,  t) = F(growth rate of baroclinic instability)
+      !!                                                   with a reduction to 0 in vicinity of the Equator
+      !!    nn_aht_ijk_t = 21    ahtu, ahtv = F(i,j,  t) = F(growth rate of baroclinic instability)
+      !!
+      !!                 = 31    ahtu, ahtv = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator
+      !!                                                                     or |u|e^3/12 bilaplacian operator )
+      !!
+      !! ** action  :   ahtu, ahtv   update at each time step   
+      !!                aeiu, aeiv      -       -     -    -   (if ln_ldfeiv=T) 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! time step
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zaht, zaht_min, z1_f20       ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_aei_ijk_t == 21 ) THEN       ! eddy induced velocity coefficients
+         !                                ! =F(growth rate of baroclinic instability)
+         !                                ! max value rn_aeiv_0 ; decreased to 0 within 20N-20S
+         CALL ldf_eiv( kt, rn_aeiv_0, aeiu, aeiv )
+         IF(lwp .AND. kt<=nit000+20 )   WRITE(numout,*) ' kt , ldf_eiv appel', kt
+      ENDIF
+      !
+      SELECT CASE(  nn_aht_ijk_t  )       ! Eddy diffusivity coefficients
+      !
+      CASE(  21  )       !==  time varying 2D field  ==!   = F( growth rate of baroclinic instability )
+         !                                             !   min value rn_aht_0 / 10 
+         !                                             !   max value rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)
+         !                                             !   increase to rn_aht_0 within 20N-20S
+         IF( nn_aei_ijk_t /= 21 ) THEN
+            CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv )
+            IF(lwp .AND. kt<=nit000+20 )   WRITE(numout,*) ' kt , ldf_eiv appel  2', kt
+         ELSE
+            ahtu(:,:,1) = aeiu(:,:,1)
+            ahtv(:,:,1) = aeiv(:,:,1)
+            IF(lwp .AND. kt<=nit000+20 )   WRITE(numout,*) ' kt , ahtu=aeiu', kt
+         ENDIF
+         !
+         z1_f20   = 1._wp / (  2._wp * omega * SIN( rad * 20._wp )  )      ! 1 / ff(20 degrees)   
+         zaht_min = 0.2_wp * rn_aht_0                                      ! minimum value for aht
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zaht = ( 1._wp -  MIN( 1._wp , ABS( ff(ji,jj) * z1_f20 ) ) ) * ( rn_aht_0 - zaht_min )
+               ahtu(ji,jj,1) = (  MAX( zaht_min, ahtu(ji,jj,1) ) + zaht  ) * umask(ji,jj,1)     ! min value zaht_min
+               ahtv(ji,jj,1) = (  MAX( zaht_min, ahtv(ji,jj,1) ) + zaht  ) * vmask(ji,jj,1)     ! increase within 20S-20N
+            END DO
+         END DO
+         DO jk = 2, jpkm1                             ! deeper value = surface value
+            ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk)
+            ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk)
+         END DO
+         !
+      CASE(  31  )       !==  time varying 3D field  ==!   = F( local velocity )
+         IF( ln_traldf_lap     ) THEN          !   laplacian operator |u| e /12
+            DO jk = 1, jpkm1
+               ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12
+               ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12
+            END DO
+         ELSEIF( ln_traldf_blp ) THEN      ! bilaplacian operator      sqrt( |u| e^3 /12 ) = sqrt( |u| e /12 ) * e
+            DO jk = 1, jpkm1
+               ahtu(:,:,jk) = SQRT(  ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12  ) * e1u(:,:)
+               ahtv(:,:,jk) = SQRT(  ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12  ) * e2v(:,:)
+            END DO
+         ENDIF
+         !
+      END SELECT
+      !
+      IF( .NOT.lk_offline ) THEN
+         CALL iom_put( "ahtu_2d", ahtu(:,:,1) )   ! surface u-eddy diffusivity coeff.
+         CALL iom_put( "ahtv_2d", ahtv(:,:,1) )   ! surface v-eddy diffusivity coeff.
+         CALL iom_put( "ahtu_3d", ahtu(:,:,:) )   ! 3D      u-eddy diffusivity coeff.
+         CALL iom_put( "ahtv_3d", ahtv(:,:,:) )   ! 3D      v-eddy diffusivity coeff.
+         !
+!!gm  : THE IF below is to be checked (comes from Seb)
+         IF( ln_ldfeiv ) THEN
+           CALL iom_put( "aeiu_2d", aeiu(:,:,1) )   ! surface u-EIV coeff.
+           CALL iom_put( "aeiv_2d", aeiv(:,:,1) )   ! surface v-EIV coeff.
+           CALL iom_put( "aeiu_3d", aeiu(:,:,:) )   ! 3D      u-EIV coeff.
+           CALL iom_put( "aeiv_3d", aeiv(:,:,:) )   ! 3D      v-EIV coeff.
+         ENDIF     
+      ENDIF
+      !
+   END SUBROUTINE ldf_tra
+
+
+   SUBROUTINE ldf_eiv_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv_init  ***
+      !!
+      !! ** Purpose :   initialization of the eiv coeff. from namelist choices.
+      !!
+      !! ** Method :
+      !!
+      !! ** Action :   aeiu , aeiv   : EIV coeff. at u- & v-points
+      !!               l_ldfeiv_time : =T if EIV coefficients vary with time
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk                ! dummy loop indices
+      INTEGER  ::   ierr, inum, ios   ! local integer
+      !
+      NAMELIST/namtra_ldfeiv/ ln_ldfeiv   , ln_ldfeiv_dia,   &    ! eddy induced velocity (eiv)
+         &                    nn_aei_ijk_t, rn_aeiv_0             ! eiv  coefficient
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namtra_ldfeiv in reference namelist : eddy induced velocity param.
+      READ  ( numnam_ref, namtra_ldfeiv, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namtra_ldfeiv in configuration namelist : eddy induced velocity param.
+      READ  ( numnam_cfg, namtra_ldfeiv, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in configuration namelist', lwp )
+      IF(lwm)  WRITE ( numond, namtra_ldfeiv )
+
+      IF(lwp) THEN                      ! control print
          WRITE(numout,*)
-      ENDIF
-
-      !                                ! convert DOCTOR namelist names into OLD names
-      aht0  = rn_aht_0
-      ahtb0 = rn_ahtb_0
-      aeiv0 = rn_aeiv_0
-
-      !                                ! Parameter control
-
-      ! ... Check consistency for type and direction :
-      !           ==> will be done in traldf module
-
-      ! ... Space variation of eddy coefficients
-      ioptio = 0
-#if defined key_traldf_c3d
-      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth)'
-      ioptio = ioptio + 1
-#endif
-#if defined key_traldf_c2d
-      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude)'
-      ioptio = ioptio + 1
-#endif
-#if defined key_traldf_c1d
-      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )'
-      ioptio = ioptio + 1
-      IF( .NOT. ln_zco )   CALL ctl_stop( 'key_traldf_c1d can only be used in z-coordinate - full step' )
-#endif
-      IF( ioptio == 0 ) THEN
-          IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant (default option)'
-        ELSEIF( ioptio > 1 ) THEN
-           CALL ctl_stop('          use only one of the following keys:',   &
-             &           ' key_traldf_c3d, key_traldf_c2d, key_traldf_c1d' )
-      ENDIF
-
-      IF( ln_traldf_bilap ) THEN
-         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion'
-         IF( aht0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. aht0 must be negative' )
+         WRITE(numout,*) 'ldf_eiv_init : eddy induced velocity parametrization'
+         WRITE(numout,*) '~~~~~~~~~~~~ '
+         WRITE(numout,*) '   Namelist namtra_ldfeiv : '
+         WRITE(numout,*) '      Eddy Induced Velocity (eiv) param.      ln_ldfeiv     = ', ln_ldfeiv
+         WRITE(numout,*) '      eiv streamfunction & velocity diag.     ln_ldfeiv_dia = ', ln_ldfeiv_dia
+         WRITE(numout,*) '      eddy induced velocity coef.             rn_aeiv_0     = ', rn_aeiv_0
+         WRITE(numout,*) '      type of time-space variation            nn_aei_ijk_t  = ', nn_aei_ijk_t
+         WRITE(numout,*)
+      ENDIF
+      !
+      IF( ln_ldfeiv .AND. ln_traldf_blp )   CALL ctl_stop( 'ldf_eiv_init: eddy induced velocity ONLY with laplacian diffusivity' )
+
+      !                                 ! Parameter control
+      l_ldfeiv_time = .FALSE.    
+      !
+      IF( ln_ldfeiv ) THEN                         ! allocate the aei arrays
+         ALLOCATE( aeiu(jpi,jpj,jpk), aeiv(jpi,jpj,jpk), STAT=ierr )
+         IF( ierr /= 0 )   CALL ctl_stop('STOP', 'ldf_eiv: failed to allocate arrays')
+         !
+         SELECT CASE( nn_aei_ijk_t )               ! Specification of space time variations of eaiu, aeiv
+         !
+         CASE(   0  )      !==  constant  ==!
+            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = constant = ', rn_aeiv_0
+            aeiu(:,:,:) = rn_aeiv_0
+            aeiv(:,:,:) = rn_aeiv_0
+            !
+         CASE(  10  )      !==  fixed profile  ==!
+            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = F( depth )'
+            aeiu(:,:,1) = rn_aeiv_0                                ! constant surface value
+            aeiv(:,:,1) = rn_aeiv_0
+            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv )
+            !
+         CASE ( -20 )      !== fixed horizontal shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j) read in eddy_diffusivity_2D.nc file'
+            CALL iom_open ( 'eddy_induced_velocity_2D.nc', inum )
+            CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu(:,:,1) )
+            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) )
+            CALL iom_close( inum )
+            DO jk = 2, jpk
+               aeiu(:,:,jk) = aeiu(:,:,1)
+               aeiv(:,:,jk) = aeiv(:,:,1)
+            END DO
+            !
+         CASE(  20  )      !== fixed horizontal shape  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or bilap case)'
+            CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv )    ! surface value proportional to scale factor
+            !
+         CASE(  21  )       !==  time varying 2D field  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, time )'
+            IF(lwp) WRITE(numout,*) '                              = F( growth rate of baroclinic instability )'
+            !
+            l_ldfeiv_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90
+            !
+         CASE( -30  )      !== fixed 3D shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file'
+            CALL iom_open ( 'eddy_induced_velocity_3D.nc', inum )
+            CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu )
+            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv )
+            CALL iom_close( inum )
+            !
+         CASE(  30  )       !==  fixed 3D shape  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth )'
+            CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv )    ! surface value proportional to scale factor
+            !                                                 ! reduction with depth
+            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv )
+            !
+         CASE DEFAULT
+            CALL ctl_stop('ldf_tra_init: wrong choice for nn_aei_ijk_t, the type of space-time variation of aei')
+         END SELECT
+         !
       ELSE
-         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)'
-         IF( aht0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. aht0 must be positive' )
-      ENDIF
-
-
-      !  Lateral eddy diffusivity and eddy induced velocity coefficients
-      ! ================================================================
-#if defined key_traldf_c3d
-      CALL ldf_tra_c3d( ll_print )      ! aht = 3D coef. = F( longitude, latitude, depth )
-#elif defined key_traldf_c2d
-      CALL ldf_tra_c2d( ll_print )      ! aht = 2D coef. = F( longitude, latitude )
-#elif defined key_traldf_c1d
-      CALL ldf_tra_c1d( ll_print )      ! aht = 1D coef. = F( depth )
-#else
-                                        ! Constant coefficients
-      IF(lwp)WRITE(numout,*)
-      IF(lwp)WRITE(numout,*) '      constant eddy diffusivity coef.   ahtu = ahtv = ahtw = aht0 = ', aht0
-      IF( lk_traldf_eiv ) THEN
-         IF(lwp)WRITE(numout,*) '      constant eddy induced velocity coef.   aeiu = aeiv = aeiw = aeiv0 = ', aeiv0
+          IF(lwp) WRITE(numout,*) '   eddy induced velocity param is NOT used neither diagnosed'
+          ln_ldfeiv_dia = .FALSE.
+      ENDIF
+      !                    
+   END SUBROUTINE ldf_eiv_init
+
+
+   SUBROUTINE ldf_eiv( kt, paei0, paeiu, paeiv )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv  ***
+      !!
+      !! ** Purpose :   Compute the eddy induced velocity coefficient from the
+      !!              growth rate of baroclinic instability.
+      !!
+      !! ** Method  :   coefficient function of the growth rate of baroclinic instability
+      !!
+      !! Reference : Treguier et al. JPO 1997   ; Held and Larichev JAS 1996
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt             ! ocean time-step index
+      REAL(wp)                        , INTENT(inout) ::   paei0          ! max value            [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   paeiu, paeiv   ! eiv coefficient      [m2/s]
+      !
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp) ::   zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei   ! local scalars
+      REAL(wp), DIMENSION(:,:), POINTER ::   zn, zah, zhw, zross, zaeiw   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('ldf_eiv')
+      !
+      CALL wrk_alloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw )
+      !      
+      zn   (:,:) = 0._wp      ! Local initialization
+      zhw  (:,:) = 5._wp
+      zah  (:,:) = 0._wp
+      zross(:,:) = 0._wp
+      !                       ! Compute lateral diffusive coefficient at T-point
+      IF( ln_traldf_triad ) THEN
+         DO jk = 1, jpk
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  ! Take the max of N^2 and zero then take the vertical sum 
+                  ! of the square root of the resulting N^2 ( required to compute 
+                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
+                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
+                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(ji,jj,jk)
+                  ! Compute elements required for the inverse time scale of baroclinic
+                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
+                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+                  ze3w = e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
+                  zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w
+                  zhw(ji,jj) = zhw(ji,jj) + ze3w
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jk = 1, jpk
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  ! Take the max of N^2 and zero then take the vertical sum 
+                  ! of the square root of the resulting N^2 ( required to compute 
+                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
+                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
+                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(ji,jj,jk)
+                  ! Compute elements required for the inverse time scale of baroclinic
+                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
+                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+                  ze3w = e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
+                  zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                     &                            + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w
+                  zhw(ji,jj) = zhw(ji,jj) + ze3w
+               END DO
+            END DO
+         END DO
+      END IF
+
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 )
+            ! Rossby radius at w-point taken < 40km and  > 2km
+            zross(ji,jj) = MAX( MIN( .4 * zn(ji,jj) / zfw, 40.e3 ), 2.e3 )
+            ! Compute aeiw by multiplying Ro^2 and T^-1
+            zaeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1)
+         END DO
+      END DO
+
+!!gm      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2
+!!gm         DO jj = 2, jpjm1
+!!gm            DO ji = fs_2, fs_jpim1   ! vector opt.
+!!gm               ! Take the minimum between aeiw and 1000 m2/s over shelves (depth shallower than 650 m)
+!!gm               IF( mbkt(ji,jj) <= 20 )   zaeiw(ji,jj) = MIN( zaeiw(ji,jj), 1000. )
+!!gm            END DO
+!!gm         END DO
+!!gm      ENDIF
+
+      !                                         !==  Bound on eiv coeff.  ==!
+      z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  )
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zzaei = MIN( 1._wp, ABS( ff(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)       ! tropical decrease
+            zaeiw(ji,jj) = MIN( zzaei , paei0 )                                  ! Max value = paei0
+         END DO
+      END DO
+      CALL lbc_lnk( zaeiw(:,:), 'W', 1. )       ! lateral boundary condition
+      !               
+      DO jj = 2, jpjm1                          !== aei at u- and v-points  ==!
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1)
+            paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1)
+         END DO 
+      END DO 
+      CALL lbc_lnk( paeiu(:,:,1), 'U', 1. )   ;   CALL lbc_lnk( paeiv(:,:,1), 'V', 1. )      ! lateral boundary condition
+
+      DO jk = 2, jpkm1                          !==  deeper values equal the surface one  ==!
+         paeiu(:,:,jk) = paeiu(:,:,1) * umask(:,:,jk)
+         paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk)
+      END DO
+      !  
+      CALL wrk_dealloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('ldf_eiv')
+      !
+   END SUBROUTINE ldf_eiv
+
+
+   SUBROUTINE ldf_eiv_trp( kt, kit000, pun, pvn, pwn, cdtype )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv_trp  ***
+      !! 
+      !! ** Purpose :   add to the input ocean transport the contribution of 
+      !!              the eddy induced velocity parametrization.
+      !!
+      !! ** Method  :   The eddy induced transport is computed from a flux stream-
+      !!              function which depends on the slope of iso-neutral surfaces
+      !!              (see ldf_slp). For example, in the i-k plan : 
+      !!                   psi_uw = mk(aeiu) e2u mi(wslpi)   [in m3/s]
+      !!                   Utr_eiv = - dk[psi_uw]
+      !!                   Vtr_eiv = + di[psi_uw]
+      !!                ln_ldfeiv_dia = T : output the associated streamfunction,
+      !!                                    velocity and heat transport (call ldf_eiv_dia)
+      !!
+      !! ** Action  : pun, pvn increased by the eiv transport
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   kit000   ! first time step index
+      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean transport components   [m3/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean transport components   [m3/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv                [m3/s]
+      !!
+      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
+      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars
+      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zpsi_uw, zpsi_vw
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start( 'ldf_eiv_trp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zpsi_uw, zpsi_vw )
+
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ldf_eiv_trp : eddy induced advection on ', cdtype,' :'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   add to velocity fields the eiv component'
+      ENDIF
+
       
-      ENDIF
-#endif
-
-#if defined key_traldf_smag && ! defined key_traldf_c3d
-        CALL ctl_stop( 'key_traldf_smag can only be used with key_traldf_c3d' )
-#endif
-#if defined key_traldf_smag
-        IF(lwp) WRITE(numout,*)' SMAGORINSKY DIFFUSION'
-        IF(lwp .AND. rn_smsh < 1)  WRITE(numout,*)' only  shear is used '
-        IF(lwp.and.ln_traldf_bilap) CALL ctl_stop(' SMAGORINSKY + BILAPLACIAN - UNSTABLE OR NON_CONSERVATIVE' )
-#endif
-
-      !
-   END SUBROUTINE ldf_tra_init
-
-#if defined key_traldf_c3d
-#   include "ldftra_c3d.h90"
-#elif defined key_traldf_c2d
-#   include "ldftra_c2d.h90"
-#elif defined key_traldf_c1d
-#   include "ldftra_c1d.h90"
-#endif
+      zpsi_uw(:,:, 1 ) = 0._wp   ;   zpsi_vw(:,:, 1 ) = 0._wp
+      zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp
+      !
+      DO jk = 2, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zpsi_uw(ji,jj,jk) = - 0.25_wp * e2u(ji,jj) * ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk) )   &
+                  &                                       * ( aeiu (ji,jj,jk-1) + aeiu (ji  ,jj,jk) ) * umask(ji,jj,jk)
+               zpsi_vw(ji,jj,jk) = - 0.25_wp * e1v(ji,jj) * ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk) )   &
+                  &                                       * ( aeiv (ji,jj,jk-1) + aeiv (ji,jj  ,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.               
+               pun(ji,jj,jk) = pun(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) )
+               pvn(ji,jj,jk) = pvn(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) )
+            END DO
+         END DO
+      END DO
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               pwn(ji,jj,jk) = pwn(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   &
+                  &                             + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) )
+            END DO
+         END DO
+      END DO
+      !
+      !                              ! diagnose the eddy induced velocity and associated heat transport
+      IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zpsi_uw, zpsi_vw )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop( 'ldf_eiv_trp')
+      !
+    END SUBROUTINE ldf_eiv_trp
+
+
+   SUBROUTINE ldf_eiv_dia( psi_uw, psi_vw )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv_dia  ***
+      !!
+      !! ** Purpose :   diagnose the eddy induced velocity and its associated
+      !!              vertically integrated heat transport.
+      !!
+      !! ** Method :
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   psi_uw, psi_vw   ! streamfunction   [m3/s]
+      !
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp) ::   zztmp   ! local scalar
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zw2d   ! 2D workspace
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   zw3d   ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'ldf_eiv_dia')
+      !
+      !                                                  !==  eiv stream function: output  ==!
+      CALL lbc_lnk( psi_uw, 'U', -1. )                         ! lateral boundary condition
+      CALL lbc_lnk( psi_vw, 'V', -1. )
+      !
+!!gm      CALL iom_put( "psi_eiv_uw", psi_uw )                 ! output
+!!gm      CALL iom_put( "psi_eiv_vw", psi_vw )
+      !
+      !                                                  !==  eiv velocities: calculate and output  ==!
+      CALL wrk_alloc( jpi,jpj,jpk,   zw3d )
+      !
+      zw3d(:,:,jpk) = 0._wp                                    ! bottom value always 0
+      !
+      DO jk = 1, jpkm1                                         ! e2u e3u u_eiv = -dk[psi_uw]
+         zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) )
+      END DO
+      CALL iom_put( "uoce_eiv", zw3d )
+      !
+      DO jk = 1, jpkm1                                         ! e1v e3v v_eiv = -dk[psi_vw]
+         zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) )
+      END DO
+      CALL iom_put( "voce_eiv", zw3d )
+      !
+      DO jk = 1, jpkm1                                         ! e1 e2 w_eiv = dk[psix] + dk[psix]
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1  ! vector opt.
+               zw3d(ji,jj,jk) = (  psi_vw(ji,jj,jk) - psi_vw(ji  ,jj-1,jk)    &
+                  &              + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj  ,jk)  ) / e1e2t(ji,jj)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zw3d, 'T', 1. )      ! lateral boundary condition
+      CALL iom_put( "woce_eiv", zw3d )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zw3d )
+      !      
+      !
+      IF( lk_diaar5 ) THEN                               !==  eiv heat transport: calculate and output  ==!
+         CALL wrk_alloc( jpi,jpj,   zw2d )
+         !
+         zztmp = 0.5_wp * rau0 * rcp 
+         zw2d(:,:) = 0._wp 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   &
+                     &                              * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) ) 
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zw2d, 'U', -1. )
+         CALL iom_put( "ueiv_heattr", zw2d )                  ! heat transport in i-direction
+         zw2d(:,:) = 0._wp 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   &
+                     &                              * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji,jj+1,jk,jp_tem) ) 
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zw2d, 'V', -1. )
+         CALL iom_put( "veiv_heattr", zw2d )                  !  heat transport in i-direction
+         !
+         CALL wrk_dealloc( jpi,jpj,   zw2d )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'ldf_eiv_dia')      
+      !
+   END SUBROUTINE ldf_eiv_dia
 
    !!======================================================================
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90	(revision 6807)
+++ 	(revision )
@@ -1,129 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                      ***  ldftra_c1d.h90  ***
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_tra_c1d( ld_print )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldftra_c1d  ***
-      !!              
-      !! ** Purpose :   1D eddy diffusivity coefficient
-      !!
-      !! ** Method  :   1D eddy diffusivity coefficients ( depth )
-      !!       biharmonic operator    : ahtt = defined at T-level
-      !!                                ahtu,ahtv,ahtw never used
-      !!
-      !!       harmonic operator      : ahtt never used
-      !!          -1-  iso-model level: ahtu = ahtv defined at T-level
-      !!                                ahtw never used
-      !!          -2-  isopycnal or   : ahtu = ahtv defined at T-level
-      !!               geopotential     ahtw defined at w-level
-      !!
-      !!       eddy induced velocity
-      !!         always harmonic      : aeiu = aeiv defined at T-level
-      !!				  aeiw defined at w-level
-      !!----------------------------------------------------------------------
-      LOGICAL, INTENT (in) ::   ld_print   ! If true, print arrays in numout
-      !
-      INTEGER  ::   jk   ! dummy loop indices
-      REAL(wp) ::   zkah, zahr, za00 , za01    ! local scalars
-      REAL(wp) ::   zahf, zahs, zahtf, zahts   !   -      -
-      !!----------------------------------------------------------------------
-
-      IF( lk_traldf_eiv ) THEN 
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' ldf_tra_c1d : 1D eddy diffusivity and eddy induced velocity coefficients'
-         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   -- ' 
-         IF(lwp) WRITE(numout,*)
-      ELSE
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' inildf : 1D eddy diffusivity coefficient '
-         IF(lwp) WRITE(numout,*) ' ~~~~~~   -- '
-         IF(lwp) WRITE(numout,*)
-      ENDIF
-
-      ! initialization of the profile
-
-      ! ahts, ahtf: surface and bottom values
-      zahts = aht0
-      zahtf = aht0/4. 
-      ! zkah, zahr: depth of the inflection pt and width of inflection
-      zkah =  -300.
-      zahr =   300.
-      ! computation coefficients
-      za00 = TANH( ( -fsdept(1,1,1  ) - zkah ) / zahr )
-      za01 = TANH( ( -fsdept(1,1,jpk) - zkah ) / zahr )
-      zahf = ( zahts-zahtf ) / ( za00 - za01 )
-      zahs = zahts - zahf * za00
-
-      ! biharmonic operator : (T-point)
-      ! ==================== 
-
-      ! set ahtt at T-level
-      DO jk = 1, jpk
-         ahtt(jk) = zahs + zahf * TANH( (-fsdept(1,1,jk)-zkah) / zahr )
-      END DO
-
-      ! control print
-      IF(lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '         aht profile at T-level : '
-         WRITE(numout,*)
-         WRITE(numout,*) ' level    aht          depth t-level '
-         DO jk = 1, jpk
-            WRITE(numout,'(i6,2f12.4)') jk, ahtt(jk), fsdept(1,1,jk)
-         END DO
-      ENDIF
-
-      ! harmonic operator : (U-, V-, W-points)
-      ! ================== 
-
-      ! set ahtu = ahtv at T-level, and ahtw at w-level
-      DO jk = 1, jpk
-         ahtu(jk) = zahs + zahf * TANH( ( -fsdept(1,1,jk) - zkah ) / zahr )
-         ahtv(jk) = ahtu(jk)
-         ahtw(jk) = zahs + zahf * TANH( ( -fsdepw(1,1,jk) - zkah ) / zahr )
-      END DO
-
-      ! control print
-      IF(lwp .AND. ld_print ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '         aht profile at T-level : '
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' level    aht          depth t-level '
-         DO jk = 1, jpk
-            IF(lwp) WRITE(numout,"(i6,2f12.4)") jk, ahtu(jk), fsdept(1,1,jk)
-         END DO
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '         aht profile at W-level : '
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '  jk      aht          depth w-level '
-         DO jk = 1, jpk
-            IF(lwp)WRITE(numout,"(i6,2f12.4)") jk, ahtw(jk), fsdepw(1,1,jk)
-         END DO
-      ENDIF
-
-# if defined key_traldf_eiv
-      ! set aeiu = aeiv and set aeiw (here same profile as on aht)
-      aeiu(:) = ahtu(:)
-      aeiv(:) = aeiu(:)
-      aeiw(:) = ahtw(:)
-      
-      ! Control print
-      IF(lwp .AND. ld_print ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '         aeiv profile at T-level : '
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '  jk      aeiv           depth t-level '
-         DO jk = 1, jpk
-            IF(lwp) WRITE(numout,"(i6,2f12.4)") jk, aeiu(jk), fsdept(1,1,jk)
-         END DO
-      ENDIF
-#endif
-      !
-   END SUBROUTINE ldf_tra_c1d
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90	(revision 6807)
+++ 	(revision )
@@ -1,162 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                      ***  ldftra_c2d.h90  ***
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_tra_c2d( ld_print )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldftra_c2d  ***
-      !!              
-      !! ** Purpose :   initializations of horizontally non uniform eddy 
-      !!      diffusivity coefficients
-      !!
-      !! ** Method :
-      !!       biharmonic operator    : ahtt = defined at T-level
-      !!                                ahtu,ahtv,ahtw never used
-      !!       harmonic operator (ahtt never used)
-      !!           iso-model level   : ahtu, ahtv defined at u-, v-points
-      !!         isopycnal         : ahtu, ahtv, ahtw defined at u-, v-, w-pts
-      !!         or geopotential   
-      !!       eddy induced velocity
-      !!           always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts
-      !!----------------------------------------------------------------------
-      LOGICAL, INTENT (in) ::   ld_print   ! If true, print arrays in numout
-      !
-      INTEGER ::   ji, jj   ! dummy loop indices
-      REAL(wp) ::   za00, zd_max, zeumax, zevmax, zetmax
-      !!----------------------------------------------------------------------
-
-      IF( lk_traldf_eiv ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' ldf_tra_c2d : 2D eddy diffusivity and eddy'
-         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  induced velocity coefficients'
-      ELSE
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' ldf_tra2d : 2D eddy diffusivity coefficient'
-         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --'
-      ENDIF
-
-      zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
-      IF( lk_mpp ) CALL mpp_max( zd_max )   ! max over the global domain
-
-      ! harmonic operator : (U-, V-, W-points)
-      ! ==================
-      IF( ln_traldf_lap ) THEN
-         !
-         za00 = aht0 / zd_max
-         !
-         DO jj = 1, jpj 
-            DO ji = 1, jpi 
-               zeumax = MAX( e1u(ji,jj), e2u(ji,jj) ) 
-               zevmax = MAX( e1v(ji,jj), e2v(ji,jj) ) 
-               zetmax = MAX( e1t(ji,jj), e2t(ji,jj) )
-               ahtu(ji,jj) = za00 * zeumax ! set ahtu = ahtv at u- and v-points, 
-               ahtv(ji,jj) = za00 * zevmax ! and ahtw at w-point (idem T-point) 
-               ahtw(ji,jj) = za00 * zetmax ! 
-            END DO
-         END DO
-
-         CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( ahtv, 'V', 1. )   ! (no change of sign)
-         CALL lbc_lnk( ahtw, 'W', 1. )
-
-         ! Special case for ORCA R2 and R4 configurations (overwrite the value of ahtu ahtv ahtw)
-         ! ==============================================
-         IF( cp_cfg == "orca" .AND. ( jp_cfg == 2 .OR. jp_cfg == 4 ) )   THEN
-            ahtu(:,:) = aht0              ! set ahtu = ahtv at u- and v-points,
-            ahtv(:,:) = aht0              ! and ahtw at w-point
-            ahtw(:,:) = aht0              ! (here : no space variation)
-            IF(lwp) WRITE(numout,*) '               ORCA R2 or R4 case'
-            IF(lwp) WRITE(numout,*) '               Constant values used for eddy diffusivity coefficients'
-            IF(lwp) WRITE(numout,*) '               Variation lat/lon only for eddy induced velocity coefficients'
-         ENDIF
-
-         ! Control print
-         IF( lwp .AND. ld_print ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahtu array'
-            CALL prihre( ahtu, jpi, jpj, 1, jpi, 1,   &
-               &                         1, jpj, 1, 1.e-3, numout )
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahtv array'
-            CALL prihre( ahtv, jpi, jpj, 1, jpi, 1,   &
-               &                         1, jpj, 1, 1.e-3, numout )
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: ahtw array'
-            CALL prihre( ahtw, jpi, jpj, 1, jpi, 1,   &
-               &                         1, jpj, 1, 1.e-3, numout )
-         ENDIF
-      ENDIF
-      
-      ! biharmonic operator : (T-point)
-      ! ====================
-      IF( ln_traldf_bilap ) THEN
-         ! (USER: modify ahtt following your desiderata)
-         ! Here: ahm is proportional to the cube of the maximum of the gridspacing
-         !       in the to horizontal direction
-
-         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
-         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
-
-         za00 = aht0 / ( zd_max * zd_max * zd_max )
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zetmax = MAX( e1t(ji,jj), e2t(ji,jj) )
-               ahtt(ji,jj) = za00 * zetmax * zetmax * zetmax      ! set ahtt at T-point
-            END DO
-         END DO
-
-         CALL lbc_lnk( ahtt, 'T', 1. )   ! Lateral boundary conditions on ( ahtt )
-
-         ! Control print
-         IF( lwp .AND. ld_print ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'inildf: 2D ahtt array'
-            CALL prihre( ahtt, jpi, jpj, 1, jpi, 1,   &
-               &                         1, jpj, 1, 1.e-3, numout )
-         ENDIF
-      ENDIF
-
-# if defined key_traldf_eiv
-      ! set aeiu = aeiv at u- and v-points, and aeiw at w-point (idem T-point)
-      ! (here no space variation)
-      aeiu(:,:) = aeiv0
-      aeiv(:,:) = aeiv0
-      aeiw(:,:) = aeiv0
-      
-      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN
-         !                                 ! Cancel eiv in Gibraltar strait
-         aeiu( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
-         aeiv( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
-         aeiw( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
-         !                                 ! Cancel eiv in Mediterrannean sea
-         aeiu( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
-         aeiv( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
-         aeiw( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
-      ENDIF
-
-      ! Lateral boundary conditions on ( aeiu, aeiv, aeiw )
-      CALL lbc_lnk( aeiu, 'U', 1. )
-      CALL lbc_lnk( aeiv, 'V', 1. )
-      CALL lbc_lnk( aeiw, 'W', 1. )
-
-      ! Control print
-      IF( lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: aeiu array'
-         CALL prihre(aeiu,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: aeiv array'
-         CALL prihre(aeiv,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: aeiw array'
-         CALL prihre(aeiw,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-      ENDIF
-# endif
-      !
-   END SUBROUTINE ldf_tra_c2d
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90	(revision 6807)
+++ 	(revision )
@@ -1,123 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                        ***  ldftra_c3d.h90  ***
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_tra_c3d( ld_print )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE ldftra_c3d  ***
-      !!                
-      !! ** Purpose :
-      !!     initializations of non uniform horizontal eddy diffusivity coef.
-      !!
-      !! ** Method :
-      !!      3D eddy diffusivity coefficients ( longitude, latitude, depth )
-      !!
-      !!       biharmonic operator    : ahtt = defined at T-level
-      !!                                ahtu,ahtv,ahtw never used
-      !!
-      !!       harmonic operator (ahtt never used)
-      !!         iso-model level   : ahtu, ahtv defined at u-, v-points
-      !!         isopycnal         : ahtu, ahtv, ahtw defined at u-, v-, w-pts
-      !!         or geopotential
-      !!
-      !!       eddy induced velocity
-      !!         always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts
-      !!----------------------------------------------------------------------
-      USE ioipsl
-      !
-      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
-      !!----------------------------------------------------------------------
-
-      IF( lk_traldf_eiv ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' ldf_tra_c3d : 3D eddy diffusivity and eddy induced velocity coefficients'
-         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  '
-         IF(lwp) WRITE(numout,*) '               Coefficients set to constant'
-      ELSE
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' ldf_tra_c3d : 3D eddy diffusivity coefficient'
-         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   -- '
-         IF(lwp) WRITE(numout,*) '               Coefficients set to constant'
-      ENDIF
-
-
-      ! biharmonic operator   (T-point)
-      ! -------------------
-
-      ahtt(:,:,:) = aht0              ! set ahtt at T-point (here no space variation)
-
-      CALL lbc_lnk( ahtt, 'T', 1. )   ! Lateral boundary conditions on ( ahtt )
-
-      IF(lwp .AND. ld_print ) THEN                    ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtt at k = 1'
-         CALL prihre( ahtt(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-3, numout )
-      ENDIF
-
-
-      ! harmonic operator   (U-, V-, W-points)
-      ! ----------------- 
-
-      ahtu(:,:,:) = aht0              ! set ahtu = ahtv at u- and v-points,
-      ahtv(:,:,:) = aht0              ! and ahtw at w-point
-      ahtw(:,:,:) = aht0              ! (here example: no space variation)
-      
-      CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions
-      CALL lbc_lnk( ahtv, 'V', 1. )
-      CALL lbc_lnk( ahtw, 'W', 1. )
-
-      IF(lwp .AND. ld_print ) THEN                    ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtu at k = 1'
-         CALL prihre( ahtu(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-3, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtv at k = 1'
-         CALL prihre( ahtv(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-3, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtw at k = 1'
-         CALL prihre( ahtw(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-3, numout )
-      ENDIF
-
-# if defined key_traldf_eiv
-      aeiu(:,:,:) = aeiv0            ! set aeiu = aeiv at u- and v-points,
-      aeiv(:,:,:) = aeiv0            ! and aeiw at w-point
-      aeiw(:,:,:) = aeiv0            ! (here example: no space variation)
-
-      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN
-         !                                 ! Cancel eiv in Gibraltar strait
-         aeiu( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
-         aeiv( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
-         aeiw( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
-         !                                 ! Cancel eiv in Mediterrannean sea
-         aeiu( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
-         aeiv( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
-         aeiw( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
-      ENDIF
-
-      CALL lbc_lnk( aeiu, 'U', 1. )   ! Lateral boundary conditions 
-      CALL lbc_lnk( aeiv, 'V', 1. )
-      CALL lbc_lnk( aeiw, 'W', 1. )
-      IF(lwp .AND. ld_print ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: aeiu at k = 1'
-         CALL prihre(aeiu(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: aeiv at k = 1'
-         CALL prihre(aeiv(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: aeiw at k = 1'
-         CALL prihre(aeiw(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-      ENDIF
-
-# endif
-   END SUBROUTINE ldf_tra_c3d
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 6807)
+++ 	(revision )
@@ -1,124 +1,0 @@
-MODULE ldftra_oce
-   !!=====================================================================
-   !!                      ***  MODULE  ldftra_oce  ***
-   !! Ocean physics :  lateral tracer mixing coefficient defined in memory 
-   !!=====================================================================
-   !! History :  9.0  !  2002-11  (G. Madec)  Original code
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean parameters
-   USE in_out_manager ! I/O manager
-   USE lib_mpp         ! MPP library
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC ldftra_oce_alloc ! called by nemo_init->nemo_alloc, nemogcm.F90
-
-   !!----------------------------------------------------------------------
-   !! Lateral eddy diffusivity coefficients (tracers)
-   !!----------------------------------------------------------------------
-   !                                     !!* Namelist namtra_ldf : lateral mixing *
-   LOGICAL , PUBLIC ::   ln_traldf_lap    !: laplacian operator
-   LOGICAL , PUBLIC ::   ln_traldf_bilap  !: bilaplacian operator
-   LOGICAL , PUBLIC ::   ln_traldf_level  !: iso-level direction
-   LOGICAL , PUBLIC ::   ln_traldf_hor    !: horizontal (geopotential) direction
-   LOGICAL , PUBLIC ::   ln_traldf_iso    !: iso-neutral direction
-   LOGICAL , PUBLIC ::   ln_traldf_grif   !: griffies skew flux
-   LOGICAL , PUBLIC ::   ln_traldf_gdia   !: griffies skew flux streamfunction diagnostics
-   REAL(wp), PUBLIC ::   rn_aht_0         !: lateral eddy diffusivity (m2/s)
-   REAL(wp), PUBLIC ::   rn_ahtb_0        !: lateral background eddy diffusivity (m2/s)
-   REAL(wp), PUBLIC ::   rn_aeiv_0        !: eddy induced velocity coefficient (m2/s)
-   REAL(wp), PUBLIC ::   rn_slpmax        !: slope limit
-   REAL(wp), PUBLIC ::   rn_chsmag        !:  multiplicative factor in Smagorinsky diffusivity
-   REAL(wp), PUBLIC ::   rn_smsh          !:  Smagorinsky diffusivity: = 0 - use only sheer
-   REAL(wp), PUBLIC ::   rn_aht_m         !:  upper limit or stability criteria for lateral eddy diffusivity (m2/s)
-
-   REAL(wp), PUBLIC ::   aht0, ahtb0, aeiv0         !!: OLD namelist names
-
-   LOGICAL , PUBLIC ::   ln_triad_iso    !: calculate triads twice
-   LOGICAL , PUBLIC ::   ln_botmix_grif  !: mixing on bottom
-   LOGICAL , PUBLIC ::   l_grad_zps      = .FALSE.   !: special treatment for Horz Tgradients w partial steps 
-
-   REAL(wp), PUBLIC ::   rldf                        !: multiplicative factor of diffusive coefficient
-                                                     !: Needed to define the ratio between passive and active tracer diffusion coef. 
-
-#if defined key_traldf_c3d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtt, ahtu, ahtv, ahtw   !: ** 3D coefficients ** at T-,U-,V-,W-points
-#elif defined key_traldf_c2d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ahtt, ahtu, ahtv, ahtw   !: ** 2D coefficients ** at T-,U-,V-,W-points
-#elif defined key_traldf_c1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   ahtt, ahtu, ahtv, ahtw   !: ** 1D coefficients ** at T-,U-,V-,W-points
-#else
-   REAL(wp), PUBLIC                                      ::   ahtt, ahtu, ahtv, ahtw   !: ** 0D coefficients ** at T-,U-,V-,W-points
-#endif
-
-#if defined key_traldf_eiv
-   !!----------------------------------------------------------------------
-   !!   'key_traldf_eiv'                              eddy induced velocity
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER               ::   lk_traldf_eiv   = .TRUE.   !: eddy induced velocity flag
-   
-   !                                                                              !!! eddy coefficients at U-, V-, W-points  [m2/s]
-# if defined key_traldf_c3d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aeiu , aeiv , aeiw   !: ** 3D coefficients **
-# elif defined key_traldf_c2d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   aeiu , aeiv , aeiw   !: ** 2D coefficients **
-# elif defined key_traldf_c1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   aeiu , aeiv , aeiw   !: ** 1D coefficients **
-# else
-   REAL(wp), PUBLIC                                      ::   aeiu , aeiv , aeiw   !: ** 0D coefficients **
-# endif
-# if defined key_diaeiv
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   u_eiv, v_eiv, w_eiv   !: eddy induced velocity [m/s]
-# endif
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :                           NO eddy induced velocity
-   !!----------------------------------------------------------------------
-   LOGICAL , PUBLIC, PARAMETER ::   lk_traldf_eiv   = .FALSE.   !: eddy induced velocity flag
-   REAL(wp), PUBLIC            ::   aeiu, aeiv, aeiw            !: eddy induced coef. (not used)
-#endif
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION ldftra_oce_alloc()
-     !!----------------------------------------------------------------------
-      !!                 ***  FUNCTION ldftra_oce_alloc  ***
-     !!----------------------------------------------------------------------
-     INTEGER, DIMENSION(3) :: ierr
-     !!----------------------------------------------------------------------
-     ierr(:) = 0
-
-#if defined key_traldf_c3d
-      ALLOCATE( ahtt(jpi,jpj,jpk) , ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , ahtw(jpi,jpj,jpk) , STAT=ierr(1) )
-#elif defined key_traldf_c2d
-      ALLOCATE( ahtt(jpi,jpj    ) , ahtu(jpi,jpj    ) , ahtv(jpi,jpj    ) , ahtw(jpi,jpj    ) , STAT=ierr(1) )
-#elif defined key_traldf_c1d
-      ALLOCATE( ahtt(        jpk) , ahtu(        jpk) , ahtv(        jpk) , ahtw(        jpk) , STAT=ierr(1) )
-#endif
-      !
-#if defined key_traldf_eiv
-# if defined key_traldf_c3d
-      ALLOCATE( aeiu(jpi,jpj,jpk) , aeiv(jpi,jpj,jpk) , aeiw(jpi,jpj,jpk) , STAT=ierr(2) )
-# elif defined key_traldf_c2d
-      ALLOCATE( aeiu(jpi,jpj    ) , aeiv(jpi,jpj    ) , aeiw(jpi,jpj    ) , STAT=ierr(2) )
-# elif defined key_traldf_c1d
-      ALLOCATE( aeiu(        jpk) , aeiv(        jpk) , aeiw(        jpk) , STAT=ierr(2) )
-# endif
-# if defined key_diaeiv
-      ALLOCATE( u_eiv(jpi,jpj,jpk), v_eiv(jpi,jpj,jpk), w_eiv(jpi,jpj,jpk), STAT=ierr(3))
-# endif
-#endif
-      ldftra_oce_alloc = MAXVAL( ierr )
-      IF( ldftra_oce_alloc /= 0 )   CALL ctl_warn('ldftra_oce_alloc: failed to allocate arrays')
-      !
-   END FUNCTION ldftra_oce_alloc
-
-   !!=====================================================================
-END MODULE ldftra_oce
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90	(revision 6807)
+++ 	(revision )
@@ -1,210 +1,0 @@
-MODULE ldftra_smag
-   !!======================================================================
-   !!                     ***  MODULE  ldftrasmag  ***
-   !! Ocean physics:  variable eddy induced velocity coefficients
-   !!======================================================================
-#if   defined key_traldf_smag   &&   defined key_traldf_c3d
-   !!----------------------------------------------------------------------
-   !!   'key_traldf_smag'      and           smagorinsky  diffusivity
-   !!   'key_traldf_c3d'                    3D tracer lateral  mixing coef.
-   !!----------------------------------------------------------------------
-   !!   ldf_eiv      : compute the eddy induced velocity coefficients
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE sbcrnf          ! river runoffs
-   USE ldftra_oce      ! ocean tracer   lateral physics
-   USE phycst          ! physical constants
-   USE ldfslp          ! iso-neutral slopes
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE iom
-   USE wrk_nemo
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC ldf_tra_smag               ! routine called by step.F90
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
- 
-
-
-
-  !!----------------------------------------------------------------------
-  !!                        ***  ldf_tra_smag.F90  ***
-  !!----------------------------------------------------------------------
-
-
-   SUBROUTINE ldf_tra_smag( kt )
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_tra_smag  ***
-      !!                   
-      !! ** Purpose :   initializations of the horizontal ocean physics
-      !!
-      !! ** Method  :   3D eddy viscosity coef. 
-      !!    M.Griffies, R.Hallberg AMS, 2000
-      !!  for laplacian:
-      !!   Asmag=(C/pi)^2*dx*dy sqrt(D^2), C=1 for tracers, C=3-4 for viscosity
-      !!   D^2= rm_smsh*(du/dx-dv/dy)^2+(dv/dx+du/dy)^2 for Cartesian coordinates
-      !!  IF rm_smsh = 0 , only shear is used, recommended for tidal flows
-      !!  in general case du/dx ==> e2 d(u/e2)/dx;  du/dy ==> e1 d(u/e1)/dy; 
-      !!                  dv/dx ==> e2 d(v/e2)/dx;  dv/dy ==> e1 d(v/e1)/dy
-      !!  for bilaplacian: now this option is deleted as unstable or non-conservative
-      !!   - delta{Bsmag (delta(T)} = -Bsmag* delta{delta(T)} - delta(Bsmag)*delta( T )
-      !!  second term is of arbitrary sign on the edge of fronts and can induce instability 
-      !!   Bsmag=Asmag*dx*dy/8
-      !!  
-      !!       laplacian operator   : ahm1, ahm2 defined at T- and F-points
-      !!                              ahm3, ahm4 never used
-      !!       bilaplacian operator : ahm1, ahm2 never used
-      !!                           :  ahm3, ahm4 defined at U- and V-points
-      !!       ??? explanation of the default is missing
-      !!  last modified : Maria Luneva, October 2012
-      !!----------------------------------------------------------------------
-      !!
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE ioipsl
-      REAL ( wp), POINTER , DIMENSION (:,:) :: zux, zvx , zuy , zvy 
-      REAL ( wp), POINTER , DIMENSION (:,:) :: zue1, zue2 , zve1 , zve2 
-      INTEGER, INTENT( in )                 ::   kt                             ! ocean time-step inedx
-      !! * Arguments
-      INTEGER                               :: ji,jj,jk
-
-      REAL (wp)                             ::     zdeltau, zdeltav, zhsmag ,zsmsh    ! temporary scalars
-      
-      CALL wrk_alloc (jpi,jpj,zux, zvx , zuy , zvy )
-      CALL wrk_alloc (jpi,jpj,zue1, zue2 , zve1 , zve2 )
-      !!----------------------------------------------------------------------
-      IF(  kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' ldf_tra_smag : 3D eddy smagorinsky diffusivity '
-         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  '
-         IF(lwp) WRITE(numout,*) '               Coefficients are computed'
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*)
-      ENDIF
-
-      zhsmag = rn_chsmag
-      zsmsh  = rn_smsh 
-      zux(:,:)=0._wp ; zuy(:,:)=0._wp ; zvx(:,:)=0._wp ; zvy(:,:)=0._wp
-
-      ! -------------------
-      ahtt(:,:,:) = rn_aht_0
-       IF( ln_traldf_bilap ) THEN
-        IF( lwp .AND. kt == nit000) WRITE(numout,* )'ldf_tra_smag :no bilaplacian Smagorinsky diffusivity'
-        IF( lwp .AND. kt == nit000) WRITE(numout,* )'ldf_tra_smag :bilaplacian diffusivity set to constant'  
-       ENDIF
-
-
-
-      ! harmonic operator   (U-, V-, W-points)
-      ! ----------------- 
-
-      ahtu(:,:,:) = rn_aht_0                  ! set ahtu , ahtv at u- and v-points,
-      ahtv(:,:,:) = rn_aht_0                  ! and ahtw at w-point
-      ahtw(:,:,:) = rn_aht_0                  ! (here example: no space variation)
-      
-      IF( ln_traldf_lap ) THEN
-
-         DO jk=1,jpk
-
-           zue2(:,:)=un(:,:,jk)/e2u(:,:)
-           zve1(:,:)=vn(:,:,jk)/e1v(:,:)
-           zue1(:,:)=un(:,:,jk)/e1u(:,:)
-           zve2(:,:)=vn(:,:,jk)/e2v(:,:)
-
-
-           DO jj=2,jpj
-            DO ji=2,jpi
-            zux(ji,jj)=(zue2(ji,jj)-zue2(ji-1,jj))/e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) * zsmsh 
-            zvy(ji,jj)=(zve1(ji,jj)-zve1(ji,jj-1))/e2t(ji,jj)*e1t(ji,jj)*tmask(ji,jj,jk) * zsmsh 
-            ENDDO
-           ENDDO
-
-           DO jj=1,jpjm1
-            DO ji=1,jpim1
-            zuy(ji,jj)=(zue1(ji,jj+1)-zue1(ji,jj))/e2f(ji,jj)*e1f(ji,jj)*fmask(ji,jj,jk)
-            zvx(ji,jj)=(zve2(ji+1,jj)-zve2(ji,jj))/e1f(ji,jj)*e2f(ji,jj)*fmask(ji,jj,jk)
-            ENDDO
-           ENDDO
-
-
-          DO jj=2,jpjm1
-           DO ji=2,jpim1
-           zdeltau=2._wp/( e1u(ji,jj)**(-2)+e2u(ji,jj)**(-2) )
-           zdeltav=2._wp/( e1v(ji,jj)**(-2)+e2v(ji,jj)**(-2) )
-
-           ahtu(ji,jj,jk)=MAX( rn_aht_0 , (zhsmag/rpi)**2*zdeltau*                                &
-                          SQRT(0.25_wp*( zux(ji,jj)+zux(ji+1,jj)-zvy(ji,jj)-zvy(ji+1,jj) )**2+    &
-                               0.25_wp*( zuy(ji,jj)+zuy(ji,jj-1)+zvx(ji,jj)+zvx(ji,jj-1)  )**2) )
-
-           ahtv(ji,jj,jk)=MAX( rn_aht_0 ,  (zhsmag/rpi)**2*zdeltav*                               &
-                          SQRT(0.25_wp*( zux(ji,jj)+zux(ji,jj+1)-zvy(ji,jj)-zvy(ji,jj+1) )**2+    &
-                               0.25_wp*( zuy(ji,jj)+zuy(ji-1,jj)+zvx(ji-1,jj)+zvx(ji,jj)  )**2) )
-
-
-         !!! stability criteria: aht<delta**2/(4*dt)   dt=2*rdt , positiveness require aht<delta**2/(8*dt)
-             ahtu(ji,jj,jk)=MIN(ahtu(ji,jj,jk),zdeltau/(16*rdt) ,rn_aht_m)
-             ahtv(ji,jj,jk)=MIN(ahtv(ji,jj,jk),zdeltav/(16*rdt) ,rn_aht_m)
-         ! so...
-
-
-            ENDDO
-           ENDDO
-         ENDDO
-        ENDIF
-            ahtu(:,:,jpk) = ahtu(:,:,jpkm1)
-            ahtv(:,:,jpk) = ahtv(:,:,jpkm1)
-        CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions
-        CALL lbc_lnk( ahtv, 'V', 1. )
-
-IF(  kt == nit000 ) THEN
-
-      IF(lwp ) THEN                    ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtu at k = 1'
-         CALL prihre( ahtu(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-1, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtv at k = 1'
-         CALL prihre( ahtv(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-1, numout )
-         WRITE(numout,*)
-         WRITE(numout,*) 'inildf: ahtw at k = 1'
-         CALL prihre( ahtw(:,:,1), jpi, jpj, 1, jpi, 1,   &
-            &                                1, jpj, 1, 1.e-1, numout )
-      ENDIF
-ENDIF
-
-      CALL wrk_dealloc ( jpi,jpj,zux, zvx , zuy , zvy     )
-      CALL wrk_dealloc ( jpi,jpj,zue1, zue2 , zve1 , zve2 )
-
-
-END SUBROUTINE ldf_tra_smag
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Dummy module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE ldf_tra_smag( kt )       ! Empty routine
-      WRITE(*,*) 'ldf_dyn_smag: You should not have seen this print! error? check keys ldf:c3d+smag', kt
-   END SUBROUTINE ldf_tra_smag
-#endif
-
-END MODULE ldftra_smag
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90	(revision 6807)
+++ 	(revision )
@@ -1,36 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                    *** ldftra_substitute.h90  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute fsaht. the eddy diffusivity coeff.
-   !!      with a constant or 1D or 2D or 3D array, using CPP macro.
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-#if defined key_traldf_c3d
-!   'key_traldf_c3d' :                 aht: 3D coefficient
-#       define   fsahtt(i,j,k)   rldf * ahtt(i,j,k)
-#       define   fsahtu(i,j,k)   rldf * ahtu(i,j,k)
-#       define   fsahtv(i,j,k)   rldf * ahtv(i,j,k)
-#       define   fsahtw(i,j,k)   rldf * ahtw(i,j,k)
-#elif defined key_traldf_c2d
-!   'key_traldf_c2d' :                 aht: 2D coefficient
-#       define   fsahtt(i,j,k)   rldf * ahtt(i,j)
-#       define   fsahtu(i,j,k)   rldf * ahtu(i,j)
-#       define   fsahtv(i,j,k)   rldf * ahtv(i,j)
-#       define   fsahtw(i,j,k)   rldf * ahtw(i,j)
-#elif defined key_traldf_c1d
-!   'key_traldf_c1d' :                aht: 1D coefficient
-#       define   fsahtt(i,j,k)   rldf * ahtt(k)
-#       define   fsahtu(i,j,k)   rldf * ahtu(k)
-#       define   fsahtv(i,j,k)   rldf * ahtv(k)
-#       define   fsahtw(i,j,k)   rldf * ahtw(k)
-#else
-!   Default option :             aht: Constant coefficient
-#      define   fsahtt(i,j,k)   rldf * aht0
-#      define   fsahtu(i,j,k)   rldf * aht0
-#      define   fsahtv(i,j,k)   rldf * aht0
-#      define   fsahtw(i,j,k)   rldf * aht0
-#endif
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 6808)
@@ -7,13 +7,12 @@
 
    !!----------------------------------------------------------------------
-   !!   'key_diaobs' : Switch on the observation diagnostic computation
-   !!----------------------------------------------------------------------
    !!   dia_obs_init : Reading and prepare observations
    !!   dia_obs      : Compute model equivalent to observations
    !!   dia_obs_wri  : Write observational diagnostics
+   !!   calc_date    : Compute the date of timestep in YYYYMMDD.HHMMSS format
    !!   ini_date     : Compute the initial date YYYYMMDD.HHMMSS
    !!   fin_date     : Compute the final date YYYYMMDD.HHMMSS
    !!----------------------------------------------------------------------
-   !! * Modules used   
+   !! * Modules used
    USE wrk_nemo                 ! Memory Allocation
    USE par_kind                 ! Precision variables
@@ -21,11 +20,8 @@
    USE par_oce
    USE dom_oce                  ! Ocean space and time domain variables
-   USE obs_fbm, ONLY: ln_cl4    ! Class 4 diagnostic switch
-   USE obs_read_prof            ! Reading and allocation of observations (Coriolis)
-   USE obs_read_sla             ! Reading and allocation of SLA observations  
-   USE obs_read_sst             ! Reading and allocation of SST observations  
+   USE obs_read_prof            ! Reading and allocation of profile obs
+   USE obs_read_surf            ! Reading and allocation of surface obs
+   USE obs_sstbias              ! Bias correction routine for SST 
    USE obs_readmdt              ! Reading and allocation of MDT for SLA.
-   USE obs_read_seaice          ! Reading and allocation of Sea Ice observations  
-   USE obs_read_vel             ! Reading and allocation of velocity component observations
    USE obs_prep                 ! Preparation of obs. (grid search etc).
    USE obs_oper                 ! Observation operators
@@ -34,9 +30,5 @@
    USE obs_read_altbias         ! Bias treatment for altimeter
    USE obs_profiles_def         ! Profile data definitions
-   USE obs_profiles             ! Profile data storage
    USE obs_surf_def             ! Surface data definitions
-   USE obs_sla                  ! SLA data storage
-   USE obs_sst                  ! SST data storage
-   USE obs_seaice               ! Sea Ice data storage
    USE obs_types                ! Definitions for observation types
    USE mpp_map                  ! MPP mapping
@@ -50,65 +42,34 @@
       &   dia_obs,      &  ! Compute model equivalent to observations
       &   dia_obs_wri,  &  ! Write model equivalent to observations
-      &   dia_obs_dealloc  ! Deallocate dia_obs data
-
-   !! * Shared Module variables
-   LOGICAL, PUBLIC, PARAMETER :: &
-#if defined key_diaobs
-      & lk_diaobs = .TRUE.   !: Logical switch for observation diangostics
-#else
-      & lk_diaobs = .FALSE.  !: Logical switch for observation diangostics
-#endif
+      &   dia_obs_dealloc, &  ! Deallocate dia_obs data
+      &   calc_date           ! Compute the date of a timestep
 
    !! * Module variables
-   LOGICAL, PUBLIC :: ln_t3d         !: Logical switch for temperature profiles
-   LOGICAL, PUBLIC :: ln_s3d         !: Logical switch for salinity profiles
-   LOGICAL, PUBLIC :: ln_ena         !: Logical switch for the ENACT data set
-   LOGICAL, PUBLIC :: ln_cor         !: Logical switch for the Coriolis data set
-   LOGICAL, PUBLIC :: ln_profb       !: Logical switch for profile feedback datafiles
-   LOGICAL, PUBLIC :: ln_sla         !: Logical switch for sea level anomalies 
-   LOGICAL, PUBLIC :: ln_sladt       !: Logical switch for SLA from AVISO files
-   LOGICAL, PUBLIC :: ln_slafb       !: Logical switch for SLA from feedback files
-   LOGICAL, PUBLIC :: ln_sst         !: Logical switch for sea surface temperature
-   LOGICAL, PUBLIC :: ln_reysst      !: Logical switch for Reynolds sea surface temperature
-   LOGICAL, PUBLIC :: ln_ghrsst      !: Logical switch for GHRSST data
-   LOGICAL, PUBLIC :: ln_sstfb       !: Logical switch for SST from feedback files
-   LOGICAL, PUBLIC :: ln_seaice      !: Logical switch for sea ice concentration
-   LOGICAL, PUBLIC :: ln_vel3d       !: Logical switch for velocity component (u,v) observations
-   LOGICAL, PUBLIC :: ln_velavcur    !: Logical switch for raw daily averaged netCDF current meter vel. data 
-   LOGICAL, PUBLIC :: ln_velhrcur    !: Logical switch for raw high freq netCDF current meter vel. data 
-   LOGICAL, PUBLIC :: ln_velavadcp   !: Logical switch for raw daily averaged netCDF ADCP vel. data 
-   LOGICAL, PUBLIC :: ln_velhradcp   !: Logical switch for raw high freq netCDF ADCP vel. data 
-   LOGICAL, PUBLIC :: ln_velfb       !: Logical switch for velocities from feedback files
-   LOGICAL, PUBLIC :: ln_ssh         !: Logical switch for sea surface height
-   LOGICAL, PUBLIC :: ln_sss         !: Logical switch for sea surface salinity
-   LOGICAL, PUBLIC :: ln_sstnight    !: Logical switch for night mean SST observations
-   LOGICAL, PUBLIC :: ln_nea         !: Remove observations near land
-   LOGICAL, PUBLIC :: ln_altbias     !: Logical switch for altimeter bias  
-   LOGICAL, PUBLIC :: ln_ignmis      !: Logical switch for ignoring missing files
-   LOGICAL, PUBLIC :: ln_s_at_t      !: Logical switch to compute model S at T observations
-
-   REAL(KIND=dp), PUBLIC :: dobsini   !: Observation window start date YYYYMMDD.HHMMSS
-   REAL(KIND=dp), PUBLIC :: dobsend   !: Observation window end date YYYYMMDD.HHMMSS
-  
-   INTEGER, PUBLIC :: n1dint       !: Vertical interpolation method
-   INTEGER, PUBLIC :: n2dint       !: Horizontal interpolation method 
-
+   LOGICAL, PUBLIC :: ln_diaobs   !: Logical switch for the obs operator
+   LOGICAL :: ln_sstnight         !: Logical switch for night mean SST obs
+   
+   INTEGER :: nn_1dint       !: Vertical interpolation method
+   INTEGER :: nn_2dint       !: Horizontal interpolation method
    INTEGER, DIMENSION(imaxavtypes) :: &
-      & endailyavtypes !: ENACT data types which are daily average
-
-   INTEGER, PARAMETER :: MaxNumFiles = 1000
-   LOGICAL, DIMENSION(MaxNumFiles) :: &
-      & ln_profb_ena, & !: Is the feedback files from ENACT data ?
-   !                    !: If so use endailyavtypes
-      & ln_profb_enatim !: Change tim for 820 enact data set.
-   
-   LOGICAL, DIMENSION(MaxNumFiles) :: &
-      & ln_velfb_av   !: Is the velocity feedback files daily average?
-   LOGICAL, DIMENSION(:), ALLOCATABLE :: &
-      & ld_enact     !: Profile data is ENACT so use endailyavtypes
-   LOGICAL, DIMENSION(:), ALLOCATABLE :: &
-      & ld_velav     !: Velocity data is daily averaged
-   LOGICAL, DIMENSION(:), ALLOCATABLE :: &
-      & ld_sstnight  !: SST observation corresponds to night mean
+      & nn_profdavtypes      !: Profile data types representing a daily average
+   INTEGER :: nproftypes     !: Number of profile obs types
+   INTEGER :: nsurftypes     !: Number of surface obs types
+   INTEGER, DIMENSION(:), ALLOCATABLE :: &
+      & nvarsprof, &         !: Number of profile variables
+      & nvarssurf            !: Number of surface variables
+   INTEGER, DIMENSION(:), ALLOCATABLE :: &
+      & nextrprof, &         !: Number of profile extra variables
+      & nextrsurf            !: Number of surface extra variables
+   INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sstbias_type !SST bias type    
+   TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: &
+      & surfdata, &          !: Initial surface data
+      & surfdataqc           !: Surface data after quality control
+   TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: &
+      & profdata, &          !: Initial profile data
+      & profdataqc           !: Profile data after quality control
+
+   CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE :: &
+      & cobstypesprof, &     !: Profile obs types
+      & cobstypessurf        !: Surface obs types
 
    !!----------------------------------------------------------------------
@@ -135,4 +96,6 @@
       !!        !  06-10  (A. Weaver) Cleaning and add controls
       !!        !  07-03  (K. Mogensen) General handling of profiles
+      !!        !  14-08  (J.While) Incorporated SST bias correction  
+      !!        !  15-02  (M. Martin) Simplification of namelist and code
       !!----------------------------------------------------------------------
 
@@ -140,184 +103,208 @@
 
       !! * Local declarations
-      CHARACTER(len=128) :: enactfiles(MaxNumFiles)
-      CHARACTER(len=128) :: coriofiles(MaxNumFiles)
-      CHARACTER(len=128) :: profbfiles(MaxNumFiles)
-      CHARACTER(len=128) :: sstfiles(MaxNumFiles)      
-      CHARACTER(len=128) :: sstfbfiles(MaxNumFiles) 
-      CHARACTER(len=128) :: slafilesact(MaxNumFiles)      
-      CHARACTER(len=128) :: slafilespas(MaxNumFiles)      
-      CHARACTER(len=128) :: slafbfiles(MaxNumFiles)
-      CHARACTER(len=128) :: seaicefiles(MaxNumFiles)           
-      CHARACTER(len=128) :: velcurfiles(MaxNumFiles)  
-      CHARACTER(len=128) :: veladcpfiles(MaxNumFiles)    
-      CHARACTER(len=128) :: velavcurfiles(MaxNumFiles)
-      CHARACTER(len=128) :: velhrcurfiles(MaxNumFiles)
-      CHARACTER(len=128) :: velavadcpfiles(MaxNumFiles)
-      CHARACTER(len=128) :: velhradcpfiles(MaxNumFiles)
-      CHARACTER(len=128) :: velfbfiles(MaxNumFiles)
-      CHARACTER(LEN=128) :: reysstname
-      CHARACTER(LEN=12)  :: reysstfmt
-      CHARACTER(LEN=128) :: bias_file
-      CHARACTER(LEN=20)  :: datestr=" ", timestr=" "
-      NAMELIST/namobs/ln_ena, ln_cor, ln_profb, ln_t3d, ln_s3d,       &
-         &            ln_sla, ln_sladt, ln_slafb,                     &
-         &            ln_ssh, ln_sst, ln_sstfb, ln_sss, ln_nea,       &
-         &            enactfiles, coriofiles, profbfiles,             &
-         &            slafilesact, slafilespas, slafbfiles,           &
-         &            sstfiles, sstfbfiles,                           &
-         &            ln_seaice, seaicefiles,                         &
-         &            dobsini, dobsend, n1dint, n2dint,               &
-         &            nmsshc, mdtcorr, mdtcutoff,                     &
-         &            ln_reysst, ln_ghrsst, reysstname, reysstfmt,    &
-         &            ln_sstnight,                                    &
+      INTEGER, PARAMETER :: &
+         & jpmaxnfiles = 1000    ! Maximum number of files for each obs type
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & ifilesprof, &         ! Number of profile files
+         & ifilessurf            ! Number of surface files
+      INTEGER :: ios             ! Local integer output status for namelist read
+      INTEGER :: jtype           ! Counter for obs types
+      INTEGER :: jvar            ! Counter for variables
+      INTEGER :: jfile           ! Counter for files
+
+      CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: &
+         & cn_profbfiles, &      ! T/S profile input filenames
+         & cn_sstfbfiles, &      ! Sea surface temperature input filenames
+         & cn_slafbfiles, &      ! Sea level anomaly input filenames
+         & cn_sicfbfiles, &      ! Seaice concentration input filenames
+         & cn_velfbfiles, &      ! Velocity profile input filenames
+         & cn_sstbias_files      ! SST bias input filenames
+      CHARACTER(LEN=128) :: &
+         & cn_altbiasfile        ! Altimeter bias input filename
+      CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: &
+         & clproffiles, &        ! Profile filenames
+         & clsurffiles           ! Surface filenames
+
+      LOGICAL :: ln_t3d          ! Logical switch for temperature profiles
+      LOGICAL :: ln_s3d          ! Logical switch for salinity profiles
+      LOGICAL :: ln_sla          ! Logical switch for sea level anomalies 
+      LOGICAL :: ln_sst          ! Logical switch for sea surface temperature
+      LOGICAL :: ln_sic          ! Logical switch for sea ice concentration
+      LOGICAL :: ln_vel3d        ! Logical switch for velocity (u,v) obs
+      LOGICAL :: ln_nea          ! Logical switch to remove obs near land
+      LOGICAL :: ln_altbias      ! Logical switch for altimeter bias
+      LOGICAL :: ln_sstbias     !: Logical switch for bias corection of SST 
+      LOGICAL :: ln_ignmis       ! Logical switch for ignoring missing files
+      LOGICAL :: ln_s_at_t       ! Logical switch to compute model S at T obs
+      LOGICAL :: llvar1          ! Logical for profile variable 1
+      LOGICAL :: llvar2          ! Logical for profile variable 1
+      LOGICAL :: llnightav       ! Logical for calculating night-time averages
+      LOGICAL, DIMENSION(jpmaxnfiles) :: lmask ! Used for finding number of sstbias files
+
+      REAL(dp) :: rn_dobsini     ! Obs window start date YYYYMMDD.HHMMSS
+      REAL(dp) :: rn_dobsend     ! Obs window end date   YYYYMMDD.HHMMSS
+      REAL(wp), POINTER, DIMENSION(:,:) :: &
+         & zglam1, &             ! Model longitudes for profile variable 1
+         & zglam2                ! Model longitudes for profile variable 2
+      REAL(wp), POINTER, DIMENSION(:,:) :: &
+         & zgphi1, &             ! Model latitudes for profile variable 1
+         & zgphi2                ! Model latitudes for profile variable 2
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: &
+         & zmask1, &             ! Model land/sea mask associated with variable 1
+         & zmask2                ! Model land/sea mask associated with variable 2
+
+      NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla,              &
+         &            ln_sst, ln_sic, ln_vel3d,                       &
+         &            ln_altbias, ln_nea, ln_grid_global,             &
          &            ln_grid_search_lookup,                          &
-         &            grid_search_file, grid_search_res,              &
-         &            ln_grid_global, bias_file, ln_altbias,          &
-         &            endailyavtypes, ln_s_at_t, ln_profb_ena,        &
-         &            ln_vel3d, ln_velavcur, velavcurfiles,           &
-         &            ln_velhrcur, velhrcurfiles,                     &
-         &            ln_velavadcp, velavadcpfiles,                   &
-         &            ln_velhradcp, velhradcpfiles,                   &
-         &            ln_velfb, velfbfiles, ln_velfb_av,              &
-         &            ln_profb_enatim, ln_ignmis, ln_cl4
-
-      INTEGER :: jprofset
-      INTEGER :: jveloset
-      INTEGER :: jvar
-      INTEGER :: jnumenact
-      INTEGER :: jnumcorio
-      INTEGER :: jnumprofb
-      INTEGER :: jnumslaact
-      INTEGER :: jnumslapas
-      INTEGER :: jnumslafb
-      INTEGER :: jnumsst
-      INTEGER :: jnumsstfb
-      INTEGER :: jnumseaice
-      INTEGER :: jnumvelavcur
-      INTEGER :: jnumvelhrcur  
-      INTEGER :: jnumvelavadcp
-      INTEGER :: jnumvelhradcp   
-      INTEGER :: jnumvelfb
-      INTEGER :: ji
-      INTEGER :: jset
-      INTEGER :: ios                 ! Local integer output status for namelist read
-      LOGICAL :: lmask(MaxNumFiles), ll_u3d, ll_v3d
+         &            ln_ignmis, ln_s_at_t, ln_sstnight,              &
+         &            cn_profbfiles, cn_slafbfiles,                   &
+         &            cn_sstfbfiles, cn_sicfbfiles,                   &
+         &            cn_velfbfiles, cn_altbiasfile,                  &
+         &            cn_gridsearchfile, rn_gridsearchres,            &
+         &            rn_dobsini, rn_dobsend, nn_1dint, nn_2dint,     &
+         &            nn_msshc, rn_mdtcorr, rn_mdtcutoff,             &
+         &            nn_profdavtypes, ln_sstbias, cn_sstbias_files
+
+      INTEGER :: jnumsstbias
+      CALL wrk_alloc( jpi, jpj, zglam1 )
+      CALL wrk_alloc( jpi, jpj, zglam2 )
+      CALL wrk_alloc( jpi, jpj, zgphi1 )
+      CALL wrk_alloc( jpi, jpj, zgphi2 )
+      CALL wrk_alloc( jpi, jpj, jpk, zmask1 )
+      CALL wrk_alloc( jpi, jpj, jpk, zmask2 )
 
       !-----------------------------------------------------------------------
       ! Read namelist parameters
       !-----------------------------------------------------------------------
-
-      enactfiles(:) = ''
-      coriofiles(:) = ''
-      profbfiles(:) = ''
-      slafilesact(:) = ''
-      slafilespas(:) = ''
-      slafbfiles(:) = ''
-      sstfiles(:)   = ''
-      sstfbfiles(:) = ''
-      seaicefiles(:) = ''
-      velcurfiles(:) = ''
-      veladcpfiles(:) = ''
-      velavcurfiles(:) = ''
-      velhrcurfiles(:) = ''
-      velavadcpfiles(:) = ''
-      velhradcpfiles(:) = ''
-      velfbfiles(:) = ''
-      velcurfiles(:) = ''
-      veladcpfiles(:) = ''
-      endailyavtypes(:) = -1
-      endailyavtypes(1) = 820
-      ln_profb_ena(:) = .FALSE.
-      ln_profb_enatim(:) = .TRUE.
-      ln_velfb_av(:) = .FALSE.
-      ln_ignmis = .FALSE.
       
-      CALL ini_date( dobsini )
-      CALL fin_date( dobsend )
- 
-      ! Read Namelist namobs : control observation diagnostics
-      REWIND( numnam_ref )              ! Namelist namobs in reference namelist : Diagnostic: control observation
+      !Initalise all values in namelist arrays
+      ALLOCATE(sstbias_type(jpmaxnfiles))
+      ! Some namelist arrays need initialising
+      cn_profbfiles(:) = ''
+      cn_slafbfiles(:) = ''
+      cn_sstfbfiles(:) = ''
+      cn_sicfbfiles(:) = ''
+      cn_velfbfiles(:) = ''
+      cn_sstbias_files(:) = ''
+      nn_profdavtypes(:) = -1
+
+      CALL ini_date( rn_dobsini )
+      CALL fin_date( rn_dobsend )
+
+      ! Read namelist namobs : control observation diagnostics
+      REWIND( numnam_ref )   ! Namelist namobs in reference namelist
       READ  ( numnam_ref, namobs, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in reference namelist', lwp )
 
-      REWIND( numnam_cfg )              ! Namelist namobs in configuration namelist : Diagnostic: control observation
+      REWIND( numnam_cfg )   ! Namelist namobs in configuration namelist
       READ  ( numnam_cfg, namobs, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namobs )
 
-      ! Count number of files for each type
-      IF (ln_ena) THEN
-         lmask(:) = .FALSE.
-         WHERE (enactfiles(:) /= '') lmask(:) = .TRUE.
-         jnumenact = COUNT(lmask)
-      ENDIF
-      IF (ln_cor) THEN
-         lmask(:) = .FALSE.
-         WHERE (coriofiles(:) /= '') lmask(:) = .TRUE.
-         jnumcorio = COUNT(lmask)
-      ENDIF
-      IF (ln_profb) THEN
-         lmask(:) = .FALSE.
-         WHERE (profbfiles(:) /= '') lmask(:) = .TRUE.
-         jnumprofb = COUNT(lmask)
-      ENDIF
-      IF (ln_sladt) THEN
-         lmask(:) = .FALSE.
-         WHERE (slafilesact(:) /= '') lmask(:) = .TRUE.
-         jnumslaact = COUNT(lmask)
-         lmask(:) = .FALSE.
-         WHERE (slafilespas(:) /= '') lmask(:) = .TRUE.
-         jnumslapas = COUNT(lmask)
-      ENDIF
-      IF (ln_slafb) THEN
-         lmask(:) = .FALSE.
-         WHERE (slafbfiles(:) /= '') lmask(:) = .TRUE.
-         jnumslafb = COUNT(lmask)
-         lmask(:) = .FALSE.
-      ENDIF
-      IF (ln_ghrsst) THEN
-         lmask(:) = .FALSE.
-         WHERE (sstfiles(:) /= '') lmask(:) = .TRUE.
-         jnumsst = COUNT(lmask)
+      IF ( .NOT. ln_diaobs ) THEN
+         IF(lwp) WRITE(numout,cform_war)
+         IF(lwp) WRITE(numout,*)' ln_diaobs is set to false so not calling dia_obs'
+         RETURN
+      ENDIF
+      
+      !-----------------------------------------------------------------------
+      ! Set up list of observation types to be used
+      ! and the files associated with each type
+      !-----------------------------------------------------------------------
+
+      nproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d /) )
+      nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic /) )
+
+      IF (ln_sstbias) THEN 
+         lmask(:) = .FALSE. 
+         WHERE (cn_sstbias_files(:) /= '') lmask(:) = .TRUE. 
+         jnumsstbias = COUNT(lmask) 
+         lmask(:) = .FALSE. 
       ENDIF      
-      IF (ln_sstfb) THEN
-         lmask(:) = .FALSE.
-         WHERE (sstfbfiles(:) /= '') lmask(:) = .TRUE.
-         jnumsstfb = COUNT(lmask)
-         lmask(:) = .FALSE.
-      ENDIF
-      IF (ln_seaice) THEN
-         lmask(:) = .FALSE.
-         WHERE (seaicefiles(:) /= '') lmask(:) = .TRUE.
-         jnumseaice = COUNT(lmask)
-      ENDIF
-      IF (ln_velavcur) THEN
-         lmask(:) = .FALSE.
-         WHERE (velavcurfiles(:) /= '') lmask(:) = .TRUE.
-         jnumvelavcur = COUNT(lmask)
-      ENDIF
-      IF (ln_velhrcur) THEN
-         lmask(:) = .FALSE.
-         WHERE (velhrcurfiles(:) /= '') lmask(:) = .TRUE.
-         jnumvelhrcur = COUNT(lmask)
-      ENDIF
-      IF (ln_velavadcp) THEN
-         lmask(:) = .FALSE.
-         WHERE (velavadcpfiles(:) /= '') lmask(:) = .TRUE.
-         jnumvelavadcp = COUNT(lmask)
-      ENDIF
-      IF (ln_velhradcp) THEN
-         lmask(:) = .FALSE.
-         WHERE (velhradcpfiles(:) /= '') lmask(:) = .TRUE.
-         jnumvelhradcp = COUNT(lmask)
-      ENDIF
-      IF (ln_velfb) THEN
-         lmask(:) = .FALSE.
-         WHERE (velfbfiles(:) /= '') lmask(:) = .TRUE.
-         jnumvelfb = COUNT(lmask)
-         lmask(:) = .FALSE.
-      ENDIF
-      
-      ! Control print
+
+      IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN
+         IF(lwp) WRITE(numout,cform_war)
+         IF(lwp) WRITE(numout,*) ' ln_diaobs is set to true, but all obs operator logical flags', &
+            &                    ' ln_t3d, ln_s3d, ln_sla, ln_sst, ln_sic, ln_vel3d', &
+            &                    ' are set to .FALSE. so turning off calls to dia_obs'
+         nwarn = nwarn + 1
+         ln_diaobs = .FALSE.
+         RETURN
+      ENDIF
+
+      IF ( nproftypes > 0 ) THEN
+
+         ALLOCATE( cobstypesprof(nproftypes) )
+         ALLOCATE( ifilesprof(nproftypes) )
+         ALLOCATE( clproffiles(nproftypes,jpmaxnfiles) )
+
+         jtype = 0
+         IF (ln_t3d .OR. ln_s3d) THEN
+            jtype = jtype + 1
+            clproffiles(jtype,:) = cn_profbfiles(:)
+            cobstypesprof(jtype) = 'prof  '
+            ifilesprof(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clproffiles(jtype,jfile)) /= '' ) &
+                  ifilesprof(jtype) = ifilesprof(jtype) + 1
+            END DO
+         ENDIF
+         IF (ln_vel3d) THEN
+            jtype = jtype + 1
+            clproffiles(jtype,:) = cn_velfbfiles(:)
+            cobstypesprof(jtype) = 'vel   '
+            ifilesprof(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clproffiles(jtype,jfile)) /= '' ) &
+                  ifilesprof(jtype) = ifilesprof(jtype) + 1
+            END DO
+         ENDIF
+
+      ENDIF
+
+      IF ( nsurftypes > 0 ) THEN
+
+         ALLOCATE( cobstypessurf(nsurftypes) )
+         ALLOCATE( ifilessurf(nsurftypes) )
+         ALLOCATE( clsurffiles(nsurftypes, jpmaxnfiles) )
+
+         jtype = 0
+         IF (ln_sla) THEN
+            jtype = jtype + 1
+            clsurffiles(jtype,:) = cn_slafbfiles(:)
+            cobstypessurf(jtype) = 'sla   '
+            ifilessurf(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) &
+                  ifilessurf(jtype) = ifilessurf(jtype) + 1
+            END DO
+         ENDIF
+         IF (ln_sst) THEN
+            jtype = jtype + 1
+            clsurffiles(jtype,:) = cn_sstfbfiles(:)
+            cobstypessurf(jtype) = 'sst   '
+            ifilessurf(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) &
+                  ifilessurf(jtype) = ifilessurf(jtype) + 1
+            END DO
+         ENDIF
+#if defined key_lim2 || defined key_lim3
+         IF (ln_sic) THEN
+            jtype = jtype + 1
+            clsurffiles(jtype,:) = cn_sicfbfiles(:)
+            cobstypessurf(jtype) = 'sic   '
+            ifilessurf(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) &
+                  ifilessurf(jtype) = ifilessurf(jtype) + 1
+            END DO
+         ENDIF
+#endif
+
+      ENDIF
+
+      !Write namelist settings to stdout
       IF(lwp) THEN
          WRITE(numout,*)
@@ -325,138 +312,55 @@
          WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) '          Namelist namobs : set observation diagnostic parameters' 
-         WRITE(numout,*) '             Logical switch for T profile observations          ln_t3d = ', ln_t3d
-         WRITE(numout,*) '             Logical switch for S profile observations          ln_s3d = ', ln_s3d
-         WRITE(numout,*) '             Logical switch for ENACT insitu data set           ln_ena = ', ln_ena
-         WRITE(numout,*) '             Logical switch for Coriolis insitu data set        ln_cor = ', ln_cor
-         WRITE(numout,*) '             Logical switch for feedback insitu data set      ln_profb = ', ln_profb
-         WRITE(numout,*) '             Logical switch for SLA observations                ln_sla = ', ln_sla
-         WRITE(numout,*) '             Logical switch for AVISO SLA data                ln_sladt = ', ln_sladt
-         WRITE(numout,*) '             Logical switch for feedback SLA data             ln_slafb = ', ln_slafb
-         WRITE(numout,*) '             Logical switch for SSH observations                ln_ssh = ', ln_ssh
-         WRITE(numout,*) '             Logical switch for SST observations                ln_sst = ', ln_sst
-         WRITE(numout,*) '             Logical switch for Reynolds observations        ln_reysst = ', ln_reysst    
-         WRITE(numout,*) '             Logical switch for GHRSST observations          ln_ghrsst = ', ln_ghrsst
-         WRITE(numout,*) '             Logical switch for feedback SST data             ln_sstfb = ', ln_sstfb
-         WRITE(numout,*) '             Logical switch for night-time SST obs         ln_sstnight = ', ln_sstnight
-         WRITE(numout,*) '             Logical switch for SSS observations                ln_sss = ', ln_sss
-         WRITE(numout,*) '             Logical switch for Sea Ice observations         ln_seaice = ', ln_seaice
-         WRITE(numout,*) '             Logical switch for velocity observations         ln_vel3d = ', ln_vel3d
-         WRITE(numout,*) '             Logical switch for velocity daily av. cur.    ln_velavcur = ', ln_velavcur
-         WRITE(numout,*) '             Logical switch for velocity high freq. cur.   ln_velhrcur = ', ln_velhrcur
-         WRITE(numout,*) '             Logical switch for velocity daily av. ADCP   ln_velavadcp = ', ln_velavadcp
-         WRITE(numout,*) '             Logical switch for velocity high freq. ADCP  ln_velhradcp = ', ln_velhradcp
-         WRITE(numout,*) '             Logical switch for feedback velocity data        ln_velfb = ', ln_velfb
-         WRITE(numout,*) '             Global distribtion of observations         ln_grid_global = ',ln_grid_global
-         WRITE(numout,*) &
-   '             Logical switch for obs grid search w/lookup table  ln_grid_search_lookup = ',ln_grid_search_lookup
+         WRITE(numout,*) '             Logical switch for T profile observations                ln_t3d = ', ln_t3d
+         WRITE(numout,*) '             Logical switch for S profile observations                ln_s3d = ', ln_s3d
+         WRITE(numout,*) '             Logical switch for SLA observations                      ln_sla = ', ln_sla
+         WRITE(numout,*) '             Logical switch for SST observations                      ln_sst = ', ln_sst
+         WRITE(numout,*) '             Logical switch for Sea Ice observations                  ln_sic = ', ln_sic
+         WRITE(numout,*) '             Logical switch for velocity observations               ln_vel3d = ', ln_vel3d
+         WRITE(numout,*) '             Global distribution of observations              ln_grid_global = ',ln_grid_global
+         WRITE(numout,*) '             Logical switch for SST bias correction         ln_sstbias = ', ln_sstbias 
+         WRITE(numout,*) '             Logical switch for obs grid search lookup ln_grid_search_lookup = ',ln_grid_search_lookup
          IF (ln_grid_search_lookup) &
-            WRITE(numout,*) '             Grid search lookup file header       grid_search_file = ', grid_search_file
-         IF (ln_ena) THEN
-            DO ji = 1, jnumenact
-               WRITE(numout,'(1X,2A)') '             ENACT input observation file name          enactfiles = ', &
-                  TRIM(enactfiles(ji))
+            WRITE(numout,*) '             Grid search lookup file header                cn_gridsearchfile = ', cn_gridsearchfile
+         WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS               rn_dobsini = ', rn_dobsini
+         WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS                 rn_dobsend = ', rn_dobsend
+         WRITE(numout,*) '             Type of vertical interpolation method                  nn_1dint = ', nn_1dint
+         WRITE(numout,*) '             Type of horizontal interpolation method                nn_2dint = ', nn_2dint
+         WRITE(numout,*) '             Rejection of observations near land switch               ln_nea = ', ln_nea
+         WRITE(numout,*) '             MSSH correction scheme                                 nn_msshc = ', nn_msshc
+         WRITE(numout,*) '             MDT  correction                                      rn_mdtcorr = ', rn_mdtcorr
+         WRITE(numout,*) '             MDT cutoff for computed correction                 rn_mdtcutoff = ', rn_mdtcutoff
+         WRITE(numout,*) '             Logical switch for alt bias                          ln_altbias = ', ln_altbias
+         WRITE(numout,*) '             Logical switch for ignoring missing files             ln_ignmis = ', ln_ignmis
+         WRITE(numout,*) '             Daily average types                             nn_profdavtypes = ', nn_profdavtypes
+         WRITE(numout,*) '             Logical switch for night-time SST obs               ln_sstnight = ', ln_sstnight
+         WRITE(numout,*) '          Number of profile obs types: ',nproftypes
+
+         IF ( nproftypes > 0 ) THEN
+            DO jtype = 1, nproftypes
+               DO jfile = 1, ifilesprof(jtype)
+                  WRITE(numout,'(1X,2A)') '             '//cobstypesprof(jtype)//' input observation file names  = ', &
+                     TRIM(clproffiles(jtype,jfile))
+               END DO
             END DO
          ENDIF
-         IF (ln_cor) THEN
-            DO ji = 1, jnumcorio
-               WRITE(numout,'(1X,2A)') '             Coriolis input observation file name       coriofiles = ', &
-                  TRIM(coriofiles(ji))
+
+         WRITE(numout,*)'          Number of surface obs types: ',nsurftypes
+         IF ( nsurftypes > 0 ) THEN
+            DO jtype = 1, nsurftypes
+               DO jfile = 1, ifilessurf(jtype)
+                  WRITE(numout,'(1X,2A)') '             '//cobstypessurf(jtype)//' input observation file names  = ', &
+                     TRIM(clsurffiles(jtype,jfile))
+               END DO
             END DO
          ENDIF
-         IF (ln_profb) THEN
-            DO ji = 1, jnumprofb
-               IF (ln_profb_ena(ji)) THEN
-                  WRITE(numout,'(1X,2A)') '       Enact feedback input observation file name       profbfiles = ', &
-                     TRIM(profbfiles(ji))
-               ELSE
-                  WRITE(numout,'(1X,2A)') '             Feedback input observation file name       profbfiles = ', &
-                     TRIM(profbfiles(ji))
-               ENDIF
-               WRITE(numout,'(1X,2A)') '       Enact feedback input time setting switch    ln_profb_enatim = ', ln_profb_enatim(ji)
-            END DO
-         ENDIF
-         IF (ln_sladt) THEN
-            DO ji = 1, jnumslaact
-               WRITE(numout,'(1X,2A)') '             Active SLA input observation file name    slafilesact = ', &
-                  TRIM(slafilesact(ji))
-            END DO
-            DO ji = 1, jnumslapas
-               WRITE(numout,'(1X,2A)') '             Passive SLA input observation file name   slafilespas = ', &
-                  TRIM(slafilespas(ji))
-            END DO
-         ENDIF
-         IF (ln_slafb) THEN
-            DO ji = 1, jnumslafb
-               WRITE(numout,'(1X,2A)') '             Feedback SLA input observation file name   slafbfiles = ', &
-                  TRIM(slafbfiles(ji))
-            END DO
-         ENDIF
-         IF (ln_ghrsst) THEN
-            DO ji = 1, jnumsst
-               WRITE(numout,'(1X,2A)') '             GHRSST input observation file name           sstfiles = ', &
-                  TRIM(sstfiles(ji))
-            END DO
-         ENDIF
-         IF (ln_sstfb) THEN
-            DO ji = 1, jnumsstfb
-               WRITE(numout,'(1X,2A)') '             Feedback SST input observation file name   sstfbfiles = ', &
-                  TRIM(sstfbfiles(ji))
-            END DO
-         ENDIF
-         IF (ln_seaice) THEN
-            DO ji = 1, jnumseaice
-               WRITE(numout,'(1X,2A)') '             Sea Ice input observation file name       seaicefiles = ', &
-                  TRIM(seaicefiles(ji))
-            END DO
-         ENDIF
-         IF (ln_velavcur) THEN
-            DO ji = 1, jnumvelavcur
-               WRITE(numout,'(1X,2A)') '             Vel. cur. daily av. input file name     velavcurfiles = ', &
-                  TRIM(velavcurfiles(ji))
-            END DO
-         ENDIF
-         IF (ln_velhrcur) THEN
-            DO ji = 1, jnumvelhrcur
-               WRITE(numout,'(1X,2A)') '             Vel. cur. high freq. input file name    velhvcurfiles = ', &
-                  TRIM(velhrcurfiles(ji))
-            END DO
-         ENDIF
-         IF (ln_velavadcp) THEN
-            DO ji = 1, jnumvelavadcp
-               WRITE(numout,'(1X,2A)') '             Vel. ADCP daily av. input file name    velavadcpfiles = ', &
-                  TRIM(velavadcpfiles(ji))
-            END DO
-         ENDIF
-         IF (ln_velhradcp) THEN
-            DO ji = 1, jnumvelhradcp
-               WRITE(numout,'(1X,2A)') '             Vel. ADCP high freq. input file name   velhvadcpfiles = ', &
-                  TRIM(velhradcpfiles(ji))
-            END DO
-         ENDIF
-         IF (ln_velfb) THEN
-            DO ji = 1, jnumvelfb
-               IF (ln_velfb_av(ji)) THEN
-                  WRITE(numout,'(1X,2A)') '             Vel. feedback daily av. input file name    velfbfiles = ', &
-                     TRIM(velfbfiles(ji))
-               ELSE
-                  WRITE(numout,'(1X,2A)') '             Vel. feedback input observation file name  velfbfiles = ', &
-                     TRIM(velfbfiles(ji))
-               ENDIF
-            END DO
-         ENDIF
-         WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS        dobsini = ', dobsini
-         WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS          dobsend = ', dobsend
-         WRITE(numout,*) '             Type of vertical interpolation method          n1dint = ', n1dint
-         WRITE(numout,*) '             Type of horizontal interpolation method        n2dint = ', n2dint
-         WRITE(numout,*) '             Rejection of observations near land swithch    ln_nea = ', ln_nea
-         WRITE(numout,*) '             MSSH correction scheme                         nmsshc = ', nmsshc
-         WRITE(numout,*) '             MDT  correction                               mdtcorr = ', mdtcorr
-         WRITE(numout,*) '             MDT cutoff for computed correction          mdtcutoff = ', mdtcutoff
-         WRITE(numout,*) '             Logical switch for alt bias                ln_altbias = ', ln_altbias
-         WRITE(numout,*) '             Logical switch for ignoring missing files   ln_ignmis = ', ln_ignmis
-         WRITE(numout,*) '             ENACT daily average types                             = ',endailyavtypes
-
-      ENDIF
-      
+         WRITE(numout,*) '~~~~~~~~~~~~'
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Obs operator parameter checking and initialisations
+      !-----------------------------------------------------------------------
+
       IF ( ln_vel3d .AND. ( .NOT. ln_grid_global ) ) THEN
          CALL ctl_stop( 'Velocity data only works with ln_grid_global=.true.' )
@@ -464,505 +368,135 @@
       ENDIF
 
-      CALL obs_typ_init
-      
-      CALL mppmap_init
-      
-      ! Parameter control
-#if defined key_diaobs
-      IF ( ( .NOT. ln_t3d ).AND.( .NOT. ln_s3d ).AND.( .NOT. ln_sla ).AND. &
-         & ( .NOT. ln_vel3d ).AND.                                         &
-         & ( .NOT. ln_ssh ).AND.( .NOT. ln_sst ).AND.( .NOT. ln_sss ).AND. &
-         & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ) ) THEN
-         IF(lwp) WRITE(numout,cform_war)
-         IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', &
-            &                    ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d are all set to .FALSE.'
-         nwarn = nwarn + 1
-      ENDIF
-#endif
-
-      CALL obs_grid_setup( )
-      IF ( ( n1dint < 0 ).OR.( n1dint > 1 ) ) THEN
+      IF ( ln_grid_global ) THEN
+         CALL ctl_warn( 'ln_grid_global=T may cause memory issues when used with a large number of processors' )
+      ENDIF
+
+      IF ( ( nn_1dint < 0 ) .OR. ( nn_1dint > 1 ) ) THEN
          CALL ctl_stop(' Choice of vertical (1D) interpolation method', &
             &                    ' is not available')
       ENDIF
-      IF ( ( n2dint < 0 ).OR.( n2dint > 4 ) ) THEN
+
+      IF ( ( nn_2dint < 0 ) .OR. ( nn_2dint > 4 ) ) THEN
          CALL ctl_stop(' Choice of horizontal (2D) interpolation method', &
             &                    ' is not available')
       ENDIF
 
+      CALL obs_typ_init
+      IF(ln_grid_global) THEN
+         CALL mppmap_init
+      ENDIF
+
+      CALL obs_grid_setup( )
+
       !-----------------------------------------------------------------------
       ! Depending on switches read the various observation types
       !-----------------------------------------------------------------------
-      !  - Temperature/salinity profiles
-
-      IF ( ln_t3d .OR. ln_s3d ) THEN
-
-         ! Set the number of variables for profiles to 2 (T and S)
-         nprofvars = 2
-         ! Set the number of extra variables for profiles to 1 (insitu temp).
-         nprofextr = 1
-
-         ! Count how may insitu data sets we have and allocate data.
-         jprofset = 0
-         IF ( ln_ena ) jprofset = jprofset + 1
-         IF ( ln_cor ) jprofset = jprofset + 1
-         IF ( ln_profb ) jprofset = jprofset + jnumprofb
-         nprofsets = jprofset
-         IF ( nprofsets > 0 ) THEN
-            ALLOCATE(ld_enact(nprofsets))
-            ALLOCATE(profdata(nprofsets))
-            ALLOCATE(prodatqc(nprofsets))
-         ENDIF
-
-         jprofset = 0
-          
-         ! ENACT insitu data
-
-         IF ( ln_ena ) THEN
-
-            jprofset = jprofset + 1
-            
-            ld_enact(jprofset) = .TRUE.
-
-            CALL obs_rea_pro_dri( 1, profdata(jprofset),          &
-               &                  jnumenact, enactfiles(1:jnumenact), &
-               &                  nprofvars, nprofextr,        &
-               &                  nitend-nit000+2,             &
-               &                  dobsini, dobsend, ln_t3d, ln_s3d, &
-               &                  ln_ignmis, ln_s_at_t, .TRUE., .FALSE., &
-               &                  kdailyavtypes = endailyavtypes )
-
-            DO jvar = 1, 2
-
-               CALL obs_prof_staend( profdata(jprofset), jvar )
-
+
+      IF ( nproftypes > 0 ) THEN
+
+         ALLOCATE(profdata(nproftypes))
+         ALLOCATE(profdataqc(nproftypes))
+         ALLOCATE(nvarsprof(nproftypes))
+         ALLOCATE(nextrprof(nproftypes))
+
+         DO jtype = 1, nproftypes
+
+            nvarsprof(jtype) = 2
+            IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN
+               nextrprof(jtype) = 1
+               llvar1 = ln_t3d
+               llvar2 = ln_s3d
+               zglam1 = glamt
+               zgphi1 = gphit
+               zmask1 = tmask
+               zglam2 = glamt
+               zgphi2 = gphit
+               zmask2 = tmask
+            ENDIF
+            IF ( TRIM(cobstypesprof(jtype)) == 'vel' )  THEN
+               nextrprof(jtype) = 2
+               llvar1 = ln_vel3d
+               llvar2 = ln_vel3d
+               zglam1 = glamu
+               zgphi1 = gphiu
+               zmask1 = umask
+               zglam2 = glamv
+               zgphi2 = gphiv
+               zmask2 = vmask
+            ENDIF
+
+            !Read in profile or profile obs types
+            CALL obs_rea_prof( profdata(jtype), ifilesprof(jtype),       &
+               &               clproffiles(jtype,1:ifilesprof(jtype)), &
+               &               nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, &
+               &               rn_dobsini, rn_dobsend, llvar1, llvar2, &
+               &               ln_ignmis, ln_s_at_t, .FALSE., &
+               &               kdailyavtypes = nn_profdavtypes )
+
+            DO jvar = 1, nvarsprof(jtype)
+               CALL obs_prof_staend( profdata(jtype), jvar )
             END DO
 
-            CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
-               &              ln_t3d, ln_s3d, ln_nea, &
-               &              kdailyavtypes=endailyavtypes )
-            
-         ENDIF
-
-         ! Coriolis insitu data
-
-         IF ( ln_cor ) THEN
-           
-            jprofset = jprofset + 1
-
-            ld_enact(jprofset) = .FALSE.
-
-            CALL obs_rea_pro_dri( 2, profdata(jprofset),          &
-               &                  jnumcorio, coriofiles(1:jnumcorio), &
-               &                  nprofvars, nprofextr,        &
-               &                  nitend-nit000+2,             &
-               &                  dobsini, dobsend, ln_t3d, ln_s3d, &
-               &                  ln_ignmis, ln_s_at_t, .FALSE., .FALSE. )
-
-            DO jvar = 1, 2
-
-               CALL obs_prof_staend( profdata(jprofset), jvar )
-
-            END DO
-
-            CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
-                 &            ln_t3d, ln_s3d, ln_nea )
-            
-         ENDIF
- 
-         ! Feedback insitu data
-
-         IF ( ln_profb ) THEN
-           
-            DO jset = 1, jnumprofb
-               
-               jprofset = jprofset + 1
-               ld_enact (jprofset) = ln_profb_ena(jset)
-
-               CALL obs_rea_pro_dri( 0, profdata(jprofset),          &
-                  &                  1, profbfiles(jset:jset), &
-                  &                  nprofvars, nprofextr,        &
-                  &                  nitend-nit000+2,             &
-                  &                  dobsini, dobsend, ln_t3d, ln_s3d, &
-                  &                  ln_ignmis, ln_s_at_t, &
-                  &                  ld_enact(jprofset).AND.&
-                  &                  ln_profb_enatim(jset), &
-                  &                  .FALSE., kdailyavtypes = endailyavtypes )
-               
-               DO jvar = 1, 2
-                  
-                  CALL obs_prof_staend( profdata(jprofset), jvar )
-                  
-               END DO
-               
-               IF ( ld_enact(jprofset) ) THEN
-                  CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
-                     &              ln_t3d, ln_s3d, ln_nea, &
-                     &              kdailyavtypes = endailyavtypes )
-               ELSE
-                  CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
-                     &              ln_t3d, ln_s3d, ln_nea )
-               ENDIF
-               
-            END DO
-
-         ENDIF
-
-      ENDIF
-
-      !  - Sea level anomalies
-      IF ( ln_sla ) THEN
-        ! Set the number of variables for sla to 1
-         nslavars = 1
-
-         ! Set the number of extra variables for sla to 2
-         nslaextr = 2
+            CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), &
+               &               llvar1, llvar2, &
+               &               jpi, jpj, jpk, &
+               &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  &
+               &               ln_nea, kdailyavtypes = nn_profdavtypes )
+
+         END DO
+
+         DEALLOCATE( ifilesprof, clproffiles )
+
+      ENDIF
+
+      IF ( nsurftypes > 0 ) THEN
+
+         ALLOCATE(surfdata(nsurftypes))
+         ALLOCATE(surfdataqc(nsurftypes))
+         ALLOCATE(nvarssurf(nsurftypes))
+         ALLOCATE(nextrsurf(nsurftypes))
+
+         DO jtype = 1, nsurftypes
+
+            nvarssurf(jtype) = 1
+            nextrsurf(jtype) = 0
+            llnightav = .FALSE.
+            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2
+            IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) llnightav = ln_sstnight
+
+            !Read in surface obs types
+            CALL obs_rea_surf( surfdata(jtype), ifilessurf(jtype), &
+               &               clsurffiles(jtype,1:ifilessurf(jtype)), &
+               &               nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, &
+               &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav )
          
-         ! Set the number of sla data sets to 2
-         nslasets = 0
-         IF ( ln_sladt ) THEN
-            nslasets = nslasets + 2
-         ENDIF
-         IF ( ln_slafb ) THEN
-            nslasets = nslasets + jnumslafb
-         ENDIF
          
-         ALLOCATE(sladata(nslasets))
-         ALLOCATE(sladatqc(nslasets))
-         sladata(:)%nsurf=0
-         sladatqc(:)%nsurf=0
-
-         nslasets = 0
-
-         ! AVISO SLA data
-
-         IF ( ln_sladt ) THEN
-
-            ! Active SLA observations
-            
-            nslasets = nslasets + 1
-            
-            CALL obs_rea_sla( 1, sladata(nslasets), jnumslaact, &
-               &              slafilesact(1:jnumslaact), &
-               &              nslavars, nslaextr, nitend-nit000+2, &
-               &              dobsini, dobsend, ln_ignmis, .FALSE. )
-            CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), &
-               &              ln_sla, ln_nea )
-            
-            ! Passive SLA observations
-            
-            nslasets = nslasets + 1
-            
-            CALL obs_rea_sla( 1, sladata(nslasets), jnumslapas, &
-               &              slafilespas(1:jnumslapas), &
-               &              nslavars, nslaextr, nitend-nit000+2, &
-               &              dobsini, dobsend, ln_ignmis, .FALSE. )
-            
-            CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), &
-               &              ln_sla, ln_nea )
-
-         ENDIF
-         
-         ! Feedback SLA data
-
-         IF ( ln_slafb ) THEN
-
-            DO jset = 1, jnumslafb
-            
-               nslasets = nslasets + 1
-            
-               CALL obs_rea_sla( 0, sladata(nslasets), 1, &
-                  &              slafbfiles(jset:jset), &
-                  &              nslavars, nslaextr, nitend-nit000+2, &
-                  &              dobsini, dobsend, ln_ignmis, .FALSE. )
-               CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), &
-                  &              ln_sla, ln_nea )
-
-            END DO               
-
-         ENDIF
-         
-         CALL obs_rea_mdt( nslasets, sladatqc, n2dint )
-            
-         ! read in altimeter bias
-         
-         IF ( ln_altbias ) THEN     
-            CALL obs_rea_altbias ( nslasets, sladatqc, n2dint, bias_file )
-         ENDIF
-     
-      ENDIF
-
-      !  - Sea surface height
-      IF ( ln_ssh ) THEN
-         IF(lwp) WRITE(numout,*) ' SSH currently not available'
-      ENDIF
-
-      !  - Sea surface temperature
-      IF ( ln_sst ) THEN
-
-         ! Set the number of variables for sst to 1
-         nsstvars = 1
-
-         ! Set the number of extra variables for sst to 0
-         nsstextr = 0
-
-         nsstsets = 0
-
-         IF (ln_reysst) nsstsets = nsstsets + 1
-         IF (ln_ghrsst) nsstsets = nsstsets + 1
-         IF ( ln_sstfb ) THEN
-            nsstsets = nsstsets + jnumsstfb
-         ENDIF
-
-         ALLOCATE(sstdata(nsstsets))
-         ALLOCATE(sstdatqc(nsstsets))
-         ALLOCATE(ld_sstnight(nsstsets))
-         sstdata(:)%nsurf=0
-         sstdatqc(:)%nsurf=0    
-         ld_sstnight(:)=.false.
-
-         nsstsets = 0
-
-         IF (ln_reysst) THEN
-
-            nsstsets = nsstsets + 1
-
-            ld_sstnight(nsstsets) = ln_sstnight
-
-            CALL obs_rea_sst_rey( reysstname, reysstfmt, sstdata(nsstsets), &
-               &                  nsstvars, nsstextr, &
-               &                  nitend-nit000+2, dobsini, dobsend )
-            CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, &
-               &              ln_nea )
-
-        ENDIF
-        
-        IF (ln_ghrsst) THEN
-        
-            nsstsets = nsstsets + 1
-
-            ld_sstnight(nsstsets) = ln_sstnight
-          
-            CALL obs_rea_sst( 1, sstdata(nsstsets), jnumsst, &
-               &              sstfiles(1:jnumsst), &
-               &              nsstvars, nsstextr, nitend-nit000+2, &
-               &              dobsini, dobsend, ln_ignmis, .FALSE. )
-            CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, &
-               &              ln_nea )
-
-        ENDIF
-               
-         ! Feedback SST data
-
-         IF ( ln_sstfb ) THEN
-
-            DO jset = 1, jnumsstfb
-            
-               nsstsets = nsstsets + 1
-
-               ld_sstnight(nsstsets) = ln_sstnight
-            
-               CALL obs_rea_sst( 0, sstdata(nsstsets), 1, &
-                  &              sstfbfiles(jset:jset), &
-                  &              nsstvars, nsstextr, nitend-nit000+2, &
-                  &              dobsini, dobsend, ln_ignmis, .FALSE. )
-               CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), &
-                  &              ln_sst, ln_nea )
-
-            END DO               
-
-         ENDIF
-
-      ENDIF
-
-      !  - Sea surface salinity
-      IF ( ln_sss ) THEN
-         IF(lwp) WRITE(numout,*) ' SSS currently not available'
-      ENDIF
-
-      !  - Sea Ice Concentration
-      
-      IF ( ln_seaice ) THEN
-
-         ! Set the number of variables for seaice to 1
-         nseaicevars = 1
-
-         ! Set the number of extra variables for seaice to 0
-         nseaiceextr = 0
-         
-         ! Set the number of data sets to 1
-         nseaicesets = 1
-
-         ALLOCATE(seaicedata(nseaicesets))
-         ALLOCATE(seaicedatqc(nseaicesets))
-         seaicedata(:)%nsurf=0
-         seaicedatqc(:)%nsurf=0
-
-         CALL obs_rea_seaice( 1, seaicedata(nseaicesets), jnumseaice, &
-            &                 seaicefiles(1:jnumseaice), &
-            &                 nseaicevars, nseaiceextr, nitend-nit000+2, &
-            &                 dobsini, dobsend, ln_ignmis, .FALSE. )
-
-         CALL obs_pre_seaice( seaicedata(nseaicesets), seaicedatqc(nseaicesets), &
-            &                 ln_seaice, ln_nea )
- 
-      ENDIF
-
-      IF (ln_vel3d) THEN
-
-         ! Set the number of variables for profiles to 2 (U and V)
-         nvelovars = 2
-
-         ! Set the number of extra variables for profiles to 2 to store 
-         ! rotation parameters
-         nveloextr = 2
-
-         jveloset = 0
-         
-         IF ( ln_velavcur ) jveloset = jveloset + 1
-         IF ( ln_velhrcur ) jveloset = jveloset + 1
-         IF ( ln_velavadcp ) jveloset = jveloset + 1
-         IF ( ln_velhradcp ) jveloset = jveloset + 1
-         IF (ln_velfb) jveloset = jveloset + jnumvelfb
-
-         nvelosets = jveloset
-         IF ( nvelosets > 0 ) THEN
-            ALLOCATE( velodata(nvelosets) )
-            ALLOCATE( veldatqc(nvelosets) )
-            ALLOCATE( ld_velav(nvelosets) )
-         ENDIF
-         
-         jveloset = 0
-         
-         ! Daily averaged data
-
-         IF ( ln_velavcur ) THEN
-            
-            jveloset = jveloset + 1
-            
-            ld_velav(jveloset) = .TRUE.
-            
-            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavcur, &
-               &                  velavcurfiles(1:jnumvelavcur), &
-               &                  nvelovars, nveloextr, &
-               &                  nitend-nit000+2,              &
-               &                  dobsini, dobsend, ln_ignmis, &
-               &                  ld_velav(jveloset), &
-               &                  .FALSE. )
-            
-            DO jvar = 1, 2
-               CALL obs_prof_staend( velodata(jveloset), jvar )
-            END DO
-            
-            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
-               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
-            
-         ENDIF
-
-         ! High frequency data
-
-         IF ( ln_velhrcur ) THEN
-            
-            jveloset = jveloset + 1
-            
-            ld_velav(jveloset) = .FALSE.
-               
-            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhrcur, &
-               &                  velhrcurfiles(1:jnumvelhrcur), &
-               &                  nvelovars, nveloextr, &
-               &                  nitend-nit000+2,              &
-               &                  dobsini, dobsend, ln_ignmis, &
-               &                  ld_velav(jveloset), &
-               &                  .FALSE. )
-            
-            DO jvar = 1, 2
-               CALL obs_prof_staend( velodata(jveloset), jvar )
-            END DO
-            
-            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
-               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
-            
-         ENDIF
-
-         ! Daily averaged data
-
-         IF ( ln_velavadcp ) THEN
-            
-            jveloset = jveloset + 1
-            
-            ld_velav(jveloset) = .TRUE.
-            
-            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavadcp, &
-               &                  velavadcpfiles(1:jnumvelavadcp), &
-               &                  nvelovars, nveloextr, &
-               &                  nitend-nit000+2,              &
-               &                  dobsini, dobsend, ln_ignmis, &
-               &                  ld_velav(jveloset), &
-               &                  .FALSE. )
-            
-            DO jvar = 1, 2
-               CALL obs_prof_staend( velodata(jveloset), jvar )
-            END DO
-            
-            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
-               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
-            
-         ENDIF
-
-         ! High frequency data
-
-         IF ( ln_velhradcp ) THEN
-            
-            jveloset = jveloset + 1
-            
-            ld_velav(jveloset) = .FALSE.
-               
-            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhradcp, &
-               &                  velhradcpfiles(1:jnumvelhradcp), &
-               &                  nvelovars, nveloextr, &
-               &                  nitend-nit000+2,              &
-               &                  dobsini, dobsend, ln_ignmis, &
-               &                  ld_velav(jveloset), &
-               &                  .FALSE. )
-            
-            DO jvar = 1, 2
-               CALL obs_prof_staend( velodata(jveloset), jvar )
-            END DO
-            
-            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
-               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
-            
-         ENDIF
-
-         IF ( ln_velfb ) THEN
-
-            DO jset = 1, jnumvelfb
-            
-               jveloset = jveloset + 1
-
-               ld_velav(jveloset) = ln_velfb_av(jset)
-               
-               CALL obs_rea_vel_dri( 0, velodata(jveloset), 1, &
-                  &                  velfbfiles(jset:jset), &
-                  &                  nvelovars, nveloextr, &
-                  &                  nitend-nit000+2,              &
-                  &                  dobsini, dobsend, ln_ignmis, &
-                  &                  ld_velav(jveloset), &
-                  &                  .FALSE. )
-               
-               DO jvar = 1, 2
-                  CALL obs_prof_staend( velodata(jveloset), jvar )
-               END DO
-               
-               CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
-                  &              ln_vel3d, ln_nea, ld_velav(jveloset) )
-
-
-            END DO
-            
-         ENDIF
-
-      ENDIF
-     
+            CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea )
+
+            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN
+               CALL obs_rea_mdt( surfdataqc(jtype), nn_2dint )
+               IF ( ln_altbias ) CALL obs_rea_altbias ( surfdataqc(jtype), nn_2dint, cn_altbiasfile )
+            ENDIF
+            IF ( TRIM(cobstypessurf(jtype)) == 'sst' .AND. ln_sstbias ) THEN
+               !Read in bias field and correct SST.
+               IF ( jnumsstbias == 0 ) CALL ctl_stop("ln_sstbias set,"// &
+                                                     "  but no bias"// &
+                                                     " files to read in")   
+                  CALL obs_app_sstbias( surfdataqc(jtype), nn_2dint, &
+                                        jnumsstbias, cn_sstbias_files(1:jnumsstbias) )
+            ENDIF
+         END DO
+
+         DEALLOCATE( ifilessurf, clsurffiles )
+
+      ENDIF
+
+      CALL wrk_dealloc( jpi, jpj, zglam1 )
+      CALL wrk_dealloc( jpi, jpj, zglam2 )
+      CALL wrk_dealloc( jpi, jpj, zgphi1 )
+      CALL wrk_dealloc( jpi, jpj, zgphi2 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zmask1 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zmask2 )
+
    END SUBROUTINE dia_obs_init
 
@@ -974,13 +508,9 @@
       !!
       !! ** Method  : Call the observation operators on each time step to
-      !!              compute the model equivalent of the following date:
-      !!               - T profiles
-      !!               - S profiles
-      !!               - Sea surface height (referenced to a mean)
-      !!               - Sea surface temperature
-      !!               - Sea surface salinity
-      !!               - Velocity component (U,V) profiles
-      !!
-      !! ** Action  : 
+      !!              compute the model equivalent of the following data:
+      !!               - Profile data, currently T/S or U/V
+      !!               - Surface data, currently SST, SLA or sea-ice concentration.
+      !!
+      !! ** Action  :
       !!
       !! History :
@@ -991,22 +521,26 @@
       !!        !  07-04  (G. Smith) Generalized surface operators
       !!        !  08-10  (M. Valdivieso) obs operator for velocity profiles
+      !!        !  14-08  (J. While) observation operator for profiles in 
+      !!                             generalised vertical coordinates
+      !!        !  15-08  (M. Martin) Combined surface/profile routines.
       !!----------------------------------------------------------------------
       !! * Modules used
       USE dom_oce, ONLY : &             ! Ocean space and time domain variables
-         & rdt,           &                       
-         & gdept_1d,       &             
-         & tmask, umask, vmask                            
+         & gdept_n,       &      
+         & gdept_1d      
       USE phycst, ONLY : &              ! Physical constants
          & rday                         
       USE oce, ONLY : &                 ! Ocean dynamics and tracers variables
          & tsn,  &             
-         & un, vn,  &
-         & sshn
+         & un, vn, &
+         & sshn  
+      USE phycst, ONLY : &         ! Physical constants
+         & rday
 #if defined  key_lim3
-      USE ice, ONLY : &                     ! LIM Ice model variables
+      USE ice, ONLY : &            ! LIM3 Ice model variables
          & frld
 #endif
 #if defined key_lim2
-      USE ice_2, ONLY : &                     ! LIM Ice model variables
+      USE ice_2, ONLY : &          ! LIM2 Ice model variables
          & frld
 #endif
@@ -1014,18 +548,38 @@
 
       !! * Arguments
-      INTEGER, INTENT(IN) :: kstp                         ! Current timestep
+      INTEGER, INTENT(IN) :: kstp  ! Current timestep
       !! * Local declarations
-      INTEGER :: idaystp                ! Number of timesteps per day
-      INTEGER :: jprofset               ! Profile data set loop variable
-      INTEGER :: jslaset                ! SLA data set loop variable
-      INTEGER :: jsstset                ! SST data set loop variable
-      INTEGER :: jseaiceset             ! sea ice data set loop variable
-      INTEGER :: jveloset               ! velocity profile data loop variable
-      INTEGER :: jvar                   ! Variable number    
+      INTEGER :: idaystp           ! Number of timesteps per day
+      INTEGER :: jtype             ! Data loop variable
+      INTEGER :: jvar              ! Variable number
+      INTEGER :: ji, jj            ! Loop counters
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: &
+         & zprofvar1, &            ! Model values for 1st variable in a prof ob
+         & zprofvar2               ! Model values for 2nd variable in a prof ob
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: &
+         & zprofmask1, &           ! Mask associated with zprofvar1
+         & zprofmask2              ! Mask associated with zprofvar2
+      REAL(wp), POINTER, DIMENSION(:,:) :: &
+         & zsurfvar                ! Model values equivalent to surface ob.
+      REAL(wp), POINTER, DIMENSION(:,:) :: &
+         & zglam1,    &            ! Model longitudes for prof variable 1
+         & zglam2,    &            ! Model longitudes for prof variable 2
+         & zgphi1,    &            ! Model latitudes for prof variable 1
+         & zgphi2                  ! Model latitudes for prof variable 2
 #if ! defined key_lim2 && ! defined key_lim3
-      REAL(wp), POINTER, DIMENSION(:,:) :: frld   
+      REAL(wp), POINTER, DIMENSION(:,:) :: frld
 #endif
-      CHARACTER(LEN=20) :: datestr=" ",timestr=" "
- 
+      LOGICAL :: llnightav        ! Logical for calculating night-time average
+
+      !Allocate local work arrays
+      CALL wrk_alloc( jpi, jpj, jpk, zprofvar1 )
+      CALL wrk_alloc( jpi, jpj, jpk, zprofvar2 )
+      CALL wrk_alloc( jpi, jpj, jpk, zprofmask1 )
+      CALL wrk_alloc( jpi, jpj, jpk, zprofmask2 )
+      CALL wrk_alloc( jpi, jpj, zsurfvar )
+      CALL wrk_alloc( jpi, jpj, zglam1 )
+      CALL wrk_alloc( jpi, jpj, zglam2 )
+      CALL wrk_alloc( jpi, jpj, zgphi1 )
+      CALL wrk_alloc( jpi, jpj, zgphi2 )
 #if ! defined key_lim2 && ! defined key_lim3
       CALL wrk_alloc(jpi,jpj,frld) 
@@ -1047,76 +601,112 @@
 #endif
       !-----------------------------------------------------------------------
-      ! Depending on switches call various observation operators
-      !-----------------------------------------------------------------------
-
-      !  - Temperature/salinity profiles
-      IF ( ln_t3d .OR. ln_s3d ) THEN
-         DO jprofset = 1, nprofsets
-            IF ( ld_enact(jprofset) ) THEN
-               CALL obs_pro_opt( prodatqc(jprofset),                     &
-                  &              kstp, jpi, jpj, jpk, nit000, idaystp,   &
-                  &              tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal),   &
-                  &              gdept_1d, tmask, n1dint, n2dint,        &
-                  &              kdailyavtypes = endailyavtypes )
+      ! Call the profile and surface observation operators
+      !-----------------------------------------------------------------------
+
+      IF ( nproftypes > 0 ) THEN
+
+         DO jtype = 1, nproftypes
+
+            SELECT CASE ( TRIM(cobstypesprof(jtype)) )
+            CASE('prof')
+               zprofvar1(:,:,:) = tsn(:,:,:,jp_tem)
+               zprofvar2(:,:,:) = tsn(:,:,:,jp_sal)
+               zprofmask1(:,:,:) = tmask(:,:,:)
+               zprofmask2(:,:,:) = tmask(:,:,:)
+               zglam1(:,:) = glamt(:,:)
+               zglam2(:,:) = glamt(:,:)
+               zgphi1(:,:) = gphit(:,:)
+               zgphi2(:,:) = gphit(:,:)
+            CASE('vel')
+               zprofvar1(:,:,:) = un(:,:,:)
+               zprofvar2(:,:,:) = vn(:,:,:)
+               zprofmask1(:,:,:) = umask(:,:,:)
+               zprofmask2(:,:,:) = vmask(:,:,:)
+               zglam1(:,:) = glamu(:,:)
+               zglam2(:,:) = glamv(:,:)
+               zgphi1(:,:) = gphiu(:,:)
+               zgphi2(:,:) = gphiv(:,:)
+            END SELECT
+
+            IF( ln_zco .OR. ln_zps ) THEN 
+               CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk,  &
+                  &               nit000, idaystp,                         &
+                  &               zprofvar1, zprofvar2,                    &
+                  &               gdept_1d, zprofmask1, zprofmask2,        &
+                  &               zglam1, zglam2, zgphi1, zgphi2,          &
+                  &               nn_1dint, nn_2dint,                      &
+                  &               kdailyavtypes = nn_profdavtypes )
+            ELSE IF(TRIM(cobstypesprof(jtype)) == 'prof') THEN
+               !TG - THIS NEEDS MODIFICATION TO MATCH SIMPLIFICATION
+               CALL obs_pro_sco_opt( profdataqc(jtype),                    & 
+                  &              kstp, jpi, jpj, jpk, nit000, idaystp,   & 
+                  &              zprofvar1, zprofvar2,                   & 
+                  &              gdept_n(:,:,:), gdepw_n(:,:,:),           &
+                  &              tmask, nn_1dint, nn_2dint,              & 
+                  &              kdailyavtypes = nn_profdavtypes ) 
             ELSE
-               CALL obs_pro_opt( prodatqc(jprofset),                     &
-                  &              kstp, jpi, jpj, jpk, nit000, idaystp,   &
-                  &              tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal),   &
-                  &              gdept_1d, tmask, n1dint, n2dint              )
+               CALL ctl_stop('DIA_OBS: Generalised vertical interpolation not'// &
+                         'yet working for velocity data (turn off velocity observations')
             ENDIF
+
          END DO
-      ENDIF
-
-      !  - Sea surface anomaly
-      IF ( ln_sla ) THEN
-         DO jslaset = 1, nslasets
-            CALL obs_sla_opt( sladatqc(jslaset),            &
-               &              kstp, jpi, jpj, nit000, sshn, &
-               &              tmask(:,:,1), n2dint )
-         END DO         
-      ENDIF
-
-      !  - Sea surface temperature
-      IF ( ln_sst ) THEN
-         DO jsstset = 1, nsstsets
-            CALL obs_sst_opt( sstdatqc(jsstset),                &
-               &              kstp, jpi, jpj, nit000, idaystp,  &
-               &              tsn(:,:,1,jp_tem), tmask(:,:,1),  &
-               &              n2dint, ld_sstnight(jsstset) )
+
+      ENDIF
+
+      IF ( nsurftypes > 0 ) THEN
+
+         DO jtype = 1, nsurftypes
+
+            SELECT CASE ( TRIM(cobstypessurf(jtype)) )
+            CASE('sst')
+               zsurfvar(:,:) = tsn(:,:,1,jp_tem)
+               llnightav = ln_sstnight
+            CASE('sla')
+               zsurfvar(:,:) = sshn(:,:)
+               llnightav = .FALSE.
+#if defined key_lim2 || defined key_lim3
+            CASE('sic')
+               IF ( kstp == 0 ) THEN
+                  IF ( lwp .AND. surfdataqc(jtype)%nsstpmpp(1) > 0 ) THEN
+                     CALL ctl_warn( 'Sea-ice not initialised on zeroth '// &
+                        &           'time-step but some obs are valid then.' )
+                     WRITE(numout,*)surfdataqc(jtype)%nsstpmpp(1), &
+                        &           ' sea-ice obs will be missed'
+                  ENDIF
+                  surfdataqc(jtype)%nsurfup = surfdataqc(jtype)%nsurfup + &
+                     &                        surfdataqc(jtype)%nsstp(1)
+                  CYCLE
+               ELSE
+                  zsurfvar(:,:) = 1._wp - frld(:,:)
+               ENDIF
+
+               llnightav = .FALSE.
+#endif
+            END SELECT
+
+            CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj,       &
+               &               nit000, idaystp, zsurfvar, tmask(:,:,1), &
+               &               nn_2dint, llnightav )
+
          END DO
-      ENDIF
-
-      !  - Sea surface salinity
-      IF ( ln_sss ) THEN
-         IF(lwp) WRITE(numout,*) ' SSS currently not available'
-      ENDIF
-
-#if defined key_lim2 || defined key_lim3
-      IF ( ln_seaice ) THEN
-         DO jseaiceset = 1, nseaicesets
-            CALL obs_seaice_opt( seaicedatqc(jseaiceset),      &
-               &              kstp, jpi, jpj, nit000, 1.-frld, &
-               &              tmask(:,:,1), n2dint )
-         END DO
-      ENDIF      
+
+      ENDIF
+
+      CALL wrk_dealloc( jpi, jpj, jpk, zprofvar1 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zprofvar2 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zprofmask1 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zprofmask2 )
+      CALL wrk_dealloc( jpi, jpj, zsurfvar )
+      CALL wrk_dealloc( jpi, jpj, zglam1 )
+      CALL wrk_dealloc( jpi, jpj, zglam2 )
+      CALL wrk_dealloc( jpi, jpj, zgphi1 )
+      CALL wrk_dealloc( jpi, jpj, zgphi2 )
+#if ! defined key_lim2 && ! defined key_lim3
+      CALL wrk_dealloc(jpi,jpj,frld)
 #endif
 
-      !  - Velocity profiles
-      IF ( ln_vel3d ) THEN
-         DO jveloset = 1, nvelosets
-           ! zonal component of velocity
-           CALL obs_vel_opt( veldatqc(jveloset), kstp, jpi, jpj, jpk, &
-              &              nit000, idaystp, un, vn, gdept_1d, umask, vmask, &
-                             n1dint, n2dint, ld_velav(jveloset) )
-         END DO
-      ENDIF
-
-#if ! defined key_lim2 && ! defined key_lim3
-      CALL wrk_dealloc(jpi,jpj,frld) 
-#endif
-
    END SUBROUTINE dia_obs
-  
-   SUBROUTINE dia_obs_wri 
+
+   SUBROUTINE dia_obs_wri
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE dia_obs_wri  ***
@@ -1126,5 +716,5 @@
       !! ** Method  : Call observation diagnostic output routines
       !!
-      !! ** Action  : 
+      !! ** Action  :
       !!
       !! History :
@@ -1134,258 +724,76 @@
       !!        !  07-03  (K. Mogensen) General handling of profiles
       !!        !  08-09  (M. Valdivieso) Velocity component (U,V) profiles
-      !!----------------------------------------------------------------------
+      !!        !  15-08  (M. Martin) Combined writing for prof and surf types
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE obs_rot_vel          ! Rotation of velocities
+
       IMPLICIT NONE
 
       !! * Local declarations
-
-      INTEGER :: jprofset                 ! Profile data set loop variable
-      INTEGER :: jveloset                 ! Velocity data set loop variable
-      INTEGER :: jslaset                  ! SLA data set loop variable
-      INTEGER :: jsstset                  ! SST data set loop variable
-      INTEGER :: jseaiceset               ! Sea Ice data set loop variable
-      INTEGER :: jset
-      INTEGER :: jfbini
-      CHARACTER(LEN=20) :: datestr=" ",timestr=" "
-      CHARACTER(LEN=10) :: cdtmp
+      INTEGER :: jtype                    ! Data set loop variable
+      INTEGER :: jo, jvar, jk
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zu, &
+         & zv
+
       !-----------------------------------------------------------------------
       ! Depending on switches call various observation output routines
       !-----------------------------------------------------------------------
 
-      !  - Temperature/salinity profiles
-
-      IF( ln_t3d .OR. ln_s3d ) THEN
-
-         ! Copy data from prodatqc to profdata structures
-         DO jprofset = 1, nprofsets
-
-            CALL obs_prof_decompress( prodatqc(jprofset), &
-                 &                    profdata(jprofset), .TRUE., numout )
+      IF ( nproftypes > 0 ) THEN
+
+         DO jtype = 1, nproftypes
+
+            IF ( TRIM(cobstypesprof(jtype)) == 'vel' ) THEN
+
+               ! For velocity data, rotate the model velocities to N/S, E/W
+               ! using the compressed data structure.
+               ALLOCATE( &
+                  & zu(profdataqc(jtype)%nvprot(1)), &
+                  & zv(profdataqc(jtype)%nvprot(2))  &
+                  & )
+
+               CALL obs_rotvel( profdataqc(jtype), nn_2dint, zu, zv )
+
+               DO jo = 1, profdataqc(jtype)%nprof
+                  DO jvar = 1, 2
+                     DO jk = profdataqc(jtype)%npvsta(jo,jvar), profdataqc(jtype)%npvend(jo,jvar)
+
+                        IF ( jvar == 1 ) THEN
+                           profdataqc(jtype)%var(jvar)%vmod(jk) = zu(jk)
+                        ELSE
+                           profdataqc(jtype)%var(jvar)%vmod(jk) = zv(jk)
+                        ENDIF
+
+                     END DO
+                  END DO
+               END DO
+
+               DEALLOCATE( zu )
+               DEALLOCATE( zv )
+
+            END IF
+
+            CALL obs_prof_decompress( profdataqc(jtype), &
+               &                      profdata(jtype), .TRUE., numout )
+
+            CALL obs_wri_prof( profdata(jtype) )
 
          END DO
 
-         ! Write the profiles.
-
-         jprofset = 0
-
-         ! ENACT insitu data
-
-         IF ( ln_ena ) THEN
-           
-            jprofset = jprofset + 1
-
-            CALL obs_wri_p3d( 'enact', profdata(jprofset) )
-
-         ENDIF
-
-         ! Coriolis insitu data
-
-         IF ( ln_cor ) THEN
-            
-            jprofset = jprofset + 1
-
-            CALL obs_wri_p3d( 'corio', profdata(jprofset) )
-            
-         ENDIF
-         
-         ! Feedback insitu data
-
-         IF ( ln_profb ) THEN
-
-            jfbini = jprofset + 1
-
-            DO jprofset = jfbini, nprofsets
-               
-               jset = jprofset - jfbini + 1
-               WRITE(cdtmp,'(A,I2.2)')'profb_',jset
-               CALL obs_wri_p3d( cdtmp, profdata(jprofset) )
-
-            END DO
-
-         ENDIF
-
-      ENDIF
-
-      !  - Sea surface anomaly
-      IF ( ln_sla ) THEN
-
-         ! Copy data from sladatqc to sladata structures
-         DO jslaset = 1, nslasets
-
-              CALL obs_surf_decompress( sladatqc(jslaset), &
-                 &                    sladata(jslaset), .TRUE., numout )
+      ENDIF
+
+      IF ( nsurftypes > 0 ) THEN
+
+         DO jtype = 1, nsurftypes
+
+            CALL obs_surf_decompress( surfdataqc(jtype), &
+               &                      surfdata(jtype), .TRUE., numout )
+
+            CALL obs_wri_surf( surfdata(jtype) )
 
          END DO
 
-         jslaset = 0 
-
-         ! Write the AVISO SLA data
-
-         IF ( ln_sladt ) THEN
-            
-            jslaset = 1
-            CALL obs_wri_sla( 'aviso_act', sladata(jslaset) )
-            jslaset = 2
-            CALL obs_wri_sla( 'aviso_pas', sladata(jslaset) )
-
-         ENDIF
-
-         IF ( ln_slafb ) THEN
-            
-            jfbini = jslaset + 1
-
-            DO jslaset = jfbini, nslasets
-               
-               jset = jslaset - jfbini + 1
-               WRITE(cdtmp,'(A,I2.2)')'slafb_',jset
-               CALL obs_wri_sla( cdtmp, sladata(jslaset) )
-
-            END DO
-
-         ENDIF
-
-      ENDIF
-
-      !  - Sea surface temperature
-      IF ( ln_sst ) THEN
-
-         ! Copy data from sstdatqc to sstdata structures
-         DO jsstset = 1, nsstsets
-     
-              CALL obs_surf_decompress( sstdatqc(jsstset), &
-                 &                    sstdata(jsstset), .TRUE., numout )
-
-         END DO
-
-         jsstset = 0 
-
-         ! Write the AVISO SST data
-
-         IF ( ln_reysst ) THEN
-            
-            jsstset = jsstset + 1
-            CALL obs_wri_sst( 'reynolds', sstdata(jsstset) )
-
-         ENDIF
-
-         IF ( ln_ghrsst ) THEN
-            
-            jsstset = jsstset + 1
-            CALL obs_wri_sst( 'ghr', sstdata(jsstset) )
-
-         ENDIF
-
-         IF ( ln_sstfb ) THEN
-            
-            jfbini = jsstset + 1
-
-            DO jsstset = jfbini, nsstsets
-               
-               jset = jsstset - jfbini + 1
-               WRITE(cdtmp,'(A,I2.2)')'sstfb_',jset
-               CALL obs_wri_sst( cdtmp, sstdata(jsstset) )
-
-            END DO
-
-         ENDIF
-
-      ENDIF
-
-      !  - Sea surface salinity
-      IF ( ln_sss ) THEN
-         IF(lwp) WRITE(numout,*) ' SSS currently not available'
-      ENDIF
-
-      !  - Sea Ice Concentration
-      IF ( ln_seaice ) THEN
-
-         ! Copy data from seaicedatqc to seaicedata structures
-         DO jseaiceset = 1, nseaicesets
-
-              CALL obs_surf_decompress( seaicedatqc(jseaiceset), &
-                 &                    seaicedata(jseaiceset), .TRUE., numout )
-
-         END DO
-
-         ! Write the Sea Ice data
-         DO jseaiceset = 1, nseaicesets
-      
-            WRITE(cdtmp,'(A,I2.2)')'seaicefb_',jseaiceset
-            CALL obs_wri_seaice( cdtmp, seaicedata(jseaiceset) )
-
-         END DO
-
-      ENDIF
-      
-      ! Velocity data
-      IF( ln_vel3d ) THEN
-
-         ! Copy data from veldatqc to velodata structures
-         DO jveloset = 1, nvelosets
-
-            CALL obs_prof_decompress( veldatqc(jveloset), &
-                 &                    velodata(jveloset), .TRUE., numout )
-
-         END DO
-
-         ! Write the profiles.
-
-         jveloset = 0
-
-         ! Daily averaged data
-
-         IF ( ln_velavcur ) THEN
-            
-            jveloset = jveloset + 1
-
-            CALL obs_wri_vel( 'velavcurr', velodata(jveloset), n2dint )
-
-         ENDIF
-
-         ! High frequency data
-
-         IF ( ln_velhrcur ) THEN
-            
-            jveloset = jveloset + 1
-
-            CALL obs_wri_vel( 'velhrcurr', velodata(jveloset), n2dint )
-
-         ENDIF
-
-         ! Daily averaged data
-
-         IF ( ln_velavadcp ) THEN
-            
-            jveloset = jveloset + 1
-
-            CALL obs_wri_vel( 'velavadcp', velodata(jveloset), n2dint )
-
-         ENDIF
-
-         ! High frequency data
-
-         IF ( ln_velhradcp ) THEN
-            
-            jveloset = jveloset + 1
-            
-            CALL obs_wri_vel( 'velhradcp', velodata(jveloset), n2dint )
-               
-         ENDIF
-
-         ! Feedback velocity data
-
-         IF ( ln_velfb ) THEN
-
-            jfbini = jveloset + 1
-
-            DO jveloset = jfbini, nvelosets
-               
-               jset = jveloset - jfbini + 1
-               WRITE(cdtmp,'(A,I2.2)')'velfb_',jset
-               CALL obs_wri_vel( cdtmp, velodata(jveloset), n2dint )
-
-            END DO
-
-         ENDIF
-         
       ENDIF
 
@@ -1405,41 +813,27 @@
       !!
       !!----------------------------------------------------------------------
-      !! obs_grid deallocation
+      ! obs_grid deallocation
       CALL obs_grid_deallocate
 
-      !! diaobs deallocation
-      IF ( nprofsets > 0 ) THEN
-          DEALLOCATE(ld_enact, &
-                  &  profdata, &
-                  &  prodatqc)
-      END IF
-      IF ( ln_sla ) THEN
-          DEALLOCATE(sladata, &
-                  &  sladatqc)
-      END IF
-      IF ( ln_seaice ) THEN
-          DEALLOCATE(sladata, &
-                  &  sladatqc)
-      END IF
-      IF ( ln_sst ) THEN
-          DEALLOCATE(sstdata, &
-                  &  sstdatqc)
-      END IF
-      IF ( ln_vel3d ) THEN
-          DEALLOCATE(ld_velav, &
-                  &  velodata, &
-                  &  veldatqc)
-      END IF
+      ! diaobs deallocation
+      IF ( nproftypes > 0 ) &
+         &   DEALLOCATE( cobstypesprof, profdata, profdataqc, nvarsprof, nextrprof )
+
+      IF ( nsurftypes > 0 ) &
+         &   DEALLOCATE( cobstypessurf, surfdata, surfdataqc, nvarssurf, nextrsurf )
+
    END SUBROUTINE dia_obs_dealloc
 
-   SUBROUTINE ini_date( ddobsini )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE ini_date  ***
+   SUBROUTINE calc_date( kstp, ddobs )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE calc_date  ***
       !!          
-      !! ** Purpose : Get initial data in double precision YYYYMMDD.HHMMSS format
-      !!
-      !! ** Method  : Get initial data in double precision YYYYMMDD.HHMMSS format
-      !!
-      !! ** Action  : Get initial data in double precision YYYYMMDD.HHMMSS format
+      !! ** Purpose : Get date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Method  : Get date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Action  : Get date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Action  : Get initial date in double precision YYYYMMDD.HHMMSS format
       !!
       !! History :
@@ -1449,9 +843,8 @@
       !!        !  06-10  (G. Smith) Calculates initial date the same as method for final date
       !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2
+      !!        !  2014-09  (D. Lea) New generic routine now deals with arbitrary initial time of day
       !!----------------------------------------------------------------------
       USE phycst, ONLY : &            ! Physical constants
          & rday
-!      USE daymod, ONLY : &            ! Time variables
-!         & nmonth_len           
       USE dom_oce, ONLY : &           ! Ocean space and time domain variables
          & rdt
@@ -1460,5 +853,6 @@
 
       !! * Arguments
-      REAL(KIND=dp), INTENT(OUT) :: ddobsini                         ! Initial date in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(OUT) :: ddobs                        ! Date in YYYYMMDD.HHMMSS
+      INTEGER :: kstp
 
       !! * Local declarations
@@ -1468,6 +862,6 @@
       INTEGER :: ihou
       INTEGER :: imin
-      INTEGER :: imday         ! Number of days in month.
-      REAL(KIND=wp) :: zdayfrc ! Fraction of day
+      INTEGER :: imday       ! Number of days in month.
+      REAL(wp) :: zdayfrc    ! Fraction of day
 
       INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
@@ -1475,27 +869,33 @@
       !!----------------------------------------------------------------------
       !! Initial date initialization (year, month, day, hour, minute)
-      !! (This assumes that the initial date is for 00z))
       !!----------------------------------------------------------------------
       iyea =   ndate0 / 10000
       imon = ( ndate0 - iyea * 10000 ) / 100
       iday =   ndate0 - iyea * 10000 - imon * 100
-      ihou = 0
-      imin = 0
+      ihou =   nn_time0 / 100
+      imin = ( nn_time0 - ihou * 100 ) 
 
       !!----------------------------------------------------------------------
       !! Compute number of days + number of hours + min since initial time
       !!----------------------------------------------------------------------
-      iday = iday + ( nit000 -1 ) * rdt / rday
-      zdayfrc = ( nit000 -1 ) * rdt / rday
+      zdayfrc = kstp * rdt / rday
       zdayfrc = zdayfrc - aint(zdayfrc)
-      ihou = int( zdayfrc * 24 )
-      imin = int( (zdayfrc * 24 - ihou) * 60 )
-
-      !!-----------------------------------------------------------------------
-      !! Convert number of days (iday) into a real date
-      !!----------------------------------------------------------------------
+      imin = imin + int( zdayfrc * 24 * 60 ) 
+      DO WHILE (imin >= 60) 
+        imin=imin-60
+        ihou=ihou+1
+      END DO
+      DO WHILE (ihou >= 24)
+        ihou=ihou-24
+        iday=iday+1
+      END DO 
+      iday = iday + kstp * rdt / rday 
+
+      !-----------------------------------------------------------------------
+      ! Convert number of days (iday) into a real date
+      !----------------------------------------------------------------------
 
       CALL calc_month_len( iyea, imonth_len )
-      
+
       DO WHILE ( iday > imonth_len(imon) )
          iday = iday - imonth_len(imon)
@@ -1508,22 +908,21 @@
       END DO
 
-      !!----------------------------------------------------------------------
-      !! Convert it into YYYYMMDD.HHMMSS format.
-      !!----------------------------------------------------------------------
-      ddobsini = iyea * 10000_dp + imon * 100_dp + &
-         &       iday + ihou * 0.01_dp + imin * 0.0001_dp
-
-
-   END SUBROUTINE ini_date
-
-   SUBROUTINE fin_date( ddobsfin )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE fin_date  ***
+      !----------------------------------------------------------------------
+      ! Convert it into YYYYMMDD.HHMMSS format.
+      !----------------------------------------------------------------------
+      ddobs = iyea * 10000_dp + imon * 100_dp + &
+         &    iday + ihou * 0.01_dp + imin * 0.0001_dp
+
+   END SUBROUTINE calc_date
+
+   SUBROUTINE ini_date( ddobsini )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ini_date  ***
       !!          
-      !! ** Purpose : Get final data in double precision YYYYMMDD.HHMMSS format
-      !!
-      !! ** Method  : Get final data in double precision YYYYMMDD.HHMMSS format
-      !!
-      !! ** Action  : Get final data in double precision YYYYMMDD.HHMMSS format
+      !! ** Purpose : Get initial date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
       !!
       !! History :
@@ -1532,70 +931,42 @@
       !!        !  06-10  (A. Weaver) Cleaning
       !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2
-      !!----------------------------------------------------------------------
-      USE phycst, ONLY : &            ! Physical constants
-         & rday
-!      USE daymod, ONLY : &            ! Time variables
-!         & nmonth_len                
-      USE dom_oce, ONLY : &           ! Ocean space and time domain variables
-         & rdt
+      !!        !  2014-09  (D. Lea) Change to call generic routine calc_date
+      !!----------------------------------------------------------------------
 
       IMPLICIT NONE
 
       !! * Arguments
-      REAL(KIND=dp), INTENT(OUT) :: ddobsfin                   ! Final date in YYYYMMDD.HHMMSS
-
-      !! * Local declarations
-      INTEGER :: iyea        ! date - (year, month, day, hour, minute)
-      INTEGER :: imon
-      INTEGER :: iday
-      INTEGER :: ihou
-      INTEGER :: imin
-      INTEGER :: imday         ! Number of days in month.
-      REAL(KIND=wp) :: zdayfrc       ! Fraction of day
-         
-      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
-            
-      !-----------------------------------------------------------------------
-      ! Initial date initialization (year, month, day, hour, minute)
-      ! (This assumes that the initial date is for 00z)
-      !-----------------------------------------------------------------------
-      iyea =   ndate0 / 10000
-      imon = ( ndate0 - iyea * 10000 ) / 100
-      iday =   ndate0 - iyea * 10000 - imon * 100
-      ihou = 0
-      imin = 0
-      
-      !-----------------------------------------------------------------------
-      ! Compute number of days + number of hours + min since initial time
-      !-----------------------------------------------------------------------
-      iday    = iday +  nitend  * rdt / rday
-      zdayfrc =  nitend  * rdt / rday
-      zdayfrc = zdayfrc - AINT( zdayfrc )
-      ihou    = INT( zdayfrc * 24 )
-      imin    = INT( ( zdayfrc * 24 - ihou ) * 60 )
-
-      !-----------------------------------------------------------------------
-      ! Convert number of days (iday) into a real date
-      !----------------------------------------------------------------------
-
-      CALL calc_month_len( iyea, imonth_len )
-      
-      DO WHILE ( iday > imonth_len(imon) )
-         iday = iday - imonth_len(imon)
-         imon = imon + 1 
-         IF ( imon > 12 ) THEN
-            imon = 1
-            iyea = iyea + 1
-            CALL calc_month_len( iyea, imonth_len )  ! update month lengths
-         ENDIF
-      END DO
-
-      !-----------------------------------------------------------------------
-      ! Convert it into YYYYMMDD.HHMMSS format
-      !-----------------------------------------------------------------------
-      ddobsfin = iyea * 10000_dp + imon * 100_dp    + iday &
-         &     + ihou * 0.01_dp  + imin * 0.0001_dp
-
-    END SUBROUTINE fin_date
-    
+      REAL(KIND=dp), INTENT(OUT) :: ddobsini                   ! Initial date in YYYYMMDD.HHMMSS
+
+      CALL calc_date( nit000 - 1, ddobsini )
+
+   END SUBROUTINE ini_date
+
+   SUBROUTINE fin_date( ddobsfin )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE fin_date  ***
+      !!          
+      !! ** Purpose : Get final date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen)  Original code
+      !!        !  06-05  (K. Mogensen)  Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2
+      !!        !  2014-09  (D. Lea) Change to call generic routine calc_date
+      !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      REAL(dp), INTENT(OUT) :: ddobsfin ! Final date in YYYYMMDD.HHMMSS
+
+      CALL calc_date( nitend, ddobsfin )
+
+   END SUBROUTINE fin_date
+   
 END MODULE diaobs
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90	(revision 6808)
@@ -45,8 +45,4 @@
    INTEGER, PARAMETER    :: fbimdi = -99999   !: Integers
    REAL(fbsp), PARAMETER :: fbrmdi =  99999   !: Reals
-
-   ! Output stream choice
-   LOGICAL               :: ln_cl4 = .FALSE.  !: Logical switch for
-                                              !: class 4 file outputs
  
    ! Main data structure for observation feedback data.
@@ -1030,31 +1026,4 @@
 
    SUBROUTINE write_obfbdata( cdfilename, fbdata )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE write_obfbdata  ***
-      !!
-      !! ** Purpose :   Write an obfbdata structure into a netCDF file.
-      !!
-      !! ** Method  :   Decides which output wrapper to use. 
-      !!
-      !! ** Action  : 
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=*) :: cdfilename ! Output filename
-      TYPE(obfbdata)   :: fbdata     ! obsfbdata structure
-#if defined key_offobsoper
-      IF (ln_cl4) THEN
-          ! Class 4 file output stream
-          CALL write_obfbdata_cl( cdfilename, fbdata )
-      ELSE
-#endif
-          ! Standard feedback file output stream
-          CALL write_obfbdata_fb( cdfilename, fbdata )
-#if defined key_offobsoper
-      ENDIF
-#endif
-   END SUBROUTINE write_obfbdata
-
-   SUBROUTINE write_obfbdata_fb( cdfilename, fbdata )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE write_obfbdata  ***
@@ -1555,237 +1524,5 @@
 
       
-   END SUBROUTINE write_obfbdata_fb
-
-#if defined key_offobsoper
-   SUBROUTINE write_obfbdata_cl(cdfilename, fbdata)
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE write_obfbdata_cl  ***
-      !!
-      !! ** Purpose : Write an obfbdata structure into a class 4 file.
-      !!
-      !! ** Method  : 1. Allocate memory needed by ooo_write
-      !!              2. Map obfbdata into allocated memory
-      !!              3. Pass mapped data to ooo_write
-      !!              4. Deallocate memory
-      !!----------------------------------------------------------------------
-      USE dom_oce, ONLY: narea
-      USE ooo_write
-      USE ooo_data
-      !! * Arguments
-      CHARACTER(len=*) :: cdfilename ! Feedback filename
-      TYPE(obfbdata)   :: fbdata     ! obsfbdata structure
-      !! * Local variables
-      CHARACTER(len=17), PARAMETER :: cpname = 'write_obfbdata_cl'
-      CHARACTER(len=64) :: &
-              & cdate, &   !: class 4 file validity date 
-              & cconf, &   !: model configuration
-              & csys, &    !: model system
-              & ccont, &   !: contact email
-              & cinst, &   !: institution
-              & cversion   !: model version
-      CHARACTER(len=8) :: &
-              & ckind      !: observation kind
-      CHARACTER(len=3) :: cfield
-      INTEGER :: kobs, &   !: number of observations
-              &  kvars, &  !: number of physical variables
-              &  kdeps, &  !: number of observed depths
-              &  kfcst, &  !: number of forecasts
-              &  kifcst, & !: current forecast number
-              &  kproc     !: processor number
-      INTEGER, DIMENSION(:, :, :), ALLOCATABLE :: &
-              &  kqc       !: quality control counterpart
-      INTEGER(KIND=2), DIMENSION(:, :, :), ALLOCATABLE :: &
-              &  k2qc       !: quality control counterpart
-      REAL(kind=fbdp) :: &
-              &  pmodjuld  !: model Julian day
-      REAL(kind=fbdp), DIMENSION(:), ALLOCATABLE :: &
-              &  plead, &  !: forecast lead time
-              &  plam, &   !: longitude of observation
-              &  pphi, &   !: latitude of observation
-              &  ptim      !: time of observation
-      REAL(kind=fbdp), DIMENSION(:, :), ALLOCATABLE :: &
-              &  pdep      !: depths of observations
-      REAL(kind=fbdp), DIMENSION(:, :, :), ALLOCATABLE :: &
-              &  pob, &    !: observation counterpart
-              &  pextra    !: extra field counterpart
-      REAL(kind=fbdp), DIMENSION(:, :, :), ALLOCATABLE :: &
-              &  pmod      !: model counterpart
-      CHARACTER(len=128) :: &
-              &  clfilename  !: class 4 file name
-      CHARACTER(len=128), DIMENSION(:), ALLOCATABLE :: &
-              &  ctype       !: Instrument type
-      CHARACTER(len=nf90_max_name) :: &
-              & cdtmp        !: NetCDF variable name
-      CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: &
-              &  cwmo, &     !: Instrument WMO ID
-              &  cunit, &    !: Instrument WMO ID
-              &  cvarname    !: Instrument WMO ID
-      INTEGER :: &
-              &  idep, &     !: Loop variable
-              &  ivar, &     !: Loop variable
-              &  iobs, &     !: Loop variable
-              &  ii, &       !: Loop variable
-              &  ij, &       !: Loop variable
-              &  ik, &       !: Loop variable
-              &  il          !: Loop variable
-      cconf = TRIM(cl4_cfg)
-      csys = TRIM(cl4_sys)
-      cversion = TRIM(cl4_vn)
-      ccont = TRIM(cl4_contact)
-      cinst = TRIM(cl4_inst)
-      cdate = TRIM(cl4_date)
-      CALL locate_kind(cdfilename, ckind)
-      kproc = narea
-      kfcst = cl4_fcst_len
-      kobs = fbdata%nobs
-      kdeps = fbdata%nlev
-      kvars = fbdata%nvar
-      IF (kobs .GT. 0) THEN
-         ALLOCATE(plam(kobs), &
-               &  pphi(kobs), &
-               &  ptim(kobs), &
-               &  plead(kfcst), &
-               &  pdep(kdeps, kobs), &
-               &  kqc(kdeps, kvars, kobs), &
-               &  k2qc(kdeps, kvars, kobs), &
-               &  pob(kdeps, kvars, kobs), &
-               &  pmod(kdeps, kvars, kobs), &
-               &  pextra(kdeps, kvars, kobs), &
-               &  ctype(kobs), &
-               &  cwmo(kobs), &
-               &  cunit(kvars), &
-               &  cvarname(kvars))
-         plam(:) = fbdata%plam(:)
-         pphi(:) = fbdata%pphi(:)
-         ptim(:) = fbdata%ptim(:)
-         pdep(:, :) = fbdata%pdep(:, :)
-         kqc(:,:,:) = 1.
-         DO ii = 1, kvars
-            cvarname(ii)  = fbdata%cname(ii)
-            cunit(ii)     = fbdata%cobunit(ii)
-         END DO
-
-         ! Quality control algorithm
-         k2qc(:,:,:) = NF90_FILL_SHORT
-         DO idep = 1,kdeps
-            DO ivar = 1, kvars
-               DO iobs = 1, kobs
-                  ! 1 symbolises good for fbdata
-                  ! fbimdi symbolises that qc has not been set
-                  ! Essentially, if any fbdata flag is not an element of {1, fbimdi}
-                  ! then set the class 4 flag to bad.
-                  ! Note: fbdata%ioqc is marked good if zero.
-                  IF (((fbdata%ioqc(iobs) /= 0) .AND. &
-                            & (fbdata%ioqc(iobs) /= fbimdi)) .OR. &
-                    & ((fbdata%ipqc(iobs) /= 1) .AND. &
-                            & (fbdata%ipqc(iobs) /= fbimdi)) .OR. &
-                    & ((fbdata%idqc(idep,iobs) /= 1) .AND. &
-                            & (fbdata%idqc(idep,iobs) /= fbimdi)) .OR. &
-                    & ((fbdata%ivqc(iobs,ivar) /= 1) .AND. &
-                            & (fbdata%ivqc(iobs,ivar) /= fbimdi)) .OR. &
-                    & ((fbdata%ivlqc(idep,iobs,ivar) /= 1) .AND. &
-                            & (fbdata%ivlqc(idep,iobs,ivar) /= fbimdi)) .OR. &
-                    & ((fbdata%itqc(iobs) /= 1) .AND. &
-                            & (fbdata%itqc(iobs) /= fbimdi))) THEN
-                     ! 1 symbolises bad for class 4 file
-                     k2qc(idep, ivar, iobs) = 1
-                  ELSE
-                     ! 0 symbolises good for class 4 file
-                     k2qc(idep, ivar, iobs) = 0
-                  END IF 
-               END DO
-            END DO
-         END DO
-
-         ! Permute observation dimensions
-         pob(:,:,:) = RESHAPE(fbdata%pob, (/kdeps, kvars, kobs/), &
-                            & ORDER=(/1, 3, 2/))
-
-         ! Explicit model counterpart dimension permutation
-         ! 1,2,3,4 --> 1,4,2,3
-         pmod(:,:,:) = fbrmdi
-         ij = cl4_fcst_idx(jimatch)
-         DO ii = 1,kdeps
-            DO ik = 1, kvars
-               DO il = 1, kobs
-                  pmod(ii,ik,il) = fbdata%padd(ii,il,1,ik)
-               END DO
-            END DO
-         END DO
-
-         ! Extra fields set to missing for now
-         pextra(:,:,:) = fbrmdi
-
-         ! Lead time of class 4 file is a global parameter
-         plead = cl4_leadtime(1:cl4_fcst_len)
-
-         ! Model Julian day
-         pmodjuld = cl4_modjuld
-
-         ! Observation types
-         ctype(:) = 'X'
-         DO ii = 1,kobs
-            ctype(ii) = fbdata%cdtyp(ii)
-         END DO
-
-         ! World Meteorology Organisation codes
-         cwmo(:) = fbdata%cdwmo(:)
-
-         ! Initialise class 4 file
-         CALL ooo_wri_init(cconf, csys, ckind, cversion, ccont, cinst, cdate, &
-                         & kproc, kobs, kvars, kdeps, kfcst, &
-                         & clfilename)
-
-         ! Write standard variables
-         CALL ooo_wri_default(clfilename, kobs, kvars, kfcst, kdeps, &
-                            & ctype, cwmo, cunit, cvarname, &
-                            & plam, pphi, pdep, ptim, pob, plead, &
-                            & k2qc, pmodjuld)
-         !! Write to optional variables
-         cdtmp = cl4_vars(jimatch)
-         IF ( (TRIM(cdtmp) == "forecast") .OR. &
-              (TRIM(cdtmp) == "persistence") ) THEN
-            !! 4D variables
-            CALL ooo_wri_extra(clfilename, TRIM(cdtmp), kdeps, kfcst, &
-                            &  kvars, kobs, (/ 1,ij,1,1 /), (/ kdeps,1,kvars,kobs /), pmod)
-         ELSE
-            !! 3D variables
-            CALL ooo_wri_extra(clfilename, TRIM(cdtmp), kdeps, &
-                            &  kvars, kobs, (/ 1,1,1 /), (/ kdeps,kvars,kobs /), pmod)
-         ENDIF
-
-         DEALLOCATE(plam, pphi, ptim, pdep, plead, kqc, k2qc, &
-                  & pob, pmod, pextra, ctype, cwmo, &
-                  & cunit, cvarname)
-      END IF
-   END SUBROUTINE write_obfbdata_cl
-#endif
-
-#if defined key_offobsoper
-   SUBROUTINE locate_kind(cdfilename, ckind)
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE locate_kind  ***
-      !!
-      !! ** Purpose : Detect which kind of class 4 file is being produced.
-      !!
-      !! ** Method  : 1. Inspect cdfilename for observation kind.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=*) :: cdfilename ! Feedback filename
-      CHARACTER(len=8) :: ckind
-      IF (cdfilename(1:3) == 'sst') THEN
-         ckind = 'SST'
-      ELSE IF (cdfilename(1:3) == 'sla') THEN
-         ckind = 'SLA'
-      ELSE IF (cdfilename(1:3) == 'pro') THEN
-         ckind = 'profile'
-      ELSE IF (cdfilename(1:3) == 'ena') THEN
-         ckind = 'profile'
-      ELSE IF (cdfilename(1:3) == 'sea') THEN
-         ckind = 'seaice'
-      ELSE
-         ckind = 'unknown'
-      END IF
-   END SUBROUTINE locate_kind
-#endif
+   END SUBROUTINE write_obfbdata
 
    SUBROUTINE putvaratt_obfbdata( idfile, idvar, cdlongname, cdunits, &
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90	(revision 6808)
@@ -325,5 +325,5 @@
          CALL obs_mpp_max_integer( kobsj, kobs )
       ELSE
-         CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs )
+         CALL obs_mpp_find_obs_proc( kproc, kobs )
       ENDIF
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 6808)
@@ -52,5 +52,5 @@
 
    !! Default values
-   REAL, PUBLIC :: grid_search_res = 0.5    ! Resolution of grid
+   REAL, PUBLIC :: rn_gridsearchres = 0.5   ! Resolution of grid
    INTEGER, PRIVATE :: gsearch_nlons_def    ! Num of longitudes
    INTEGER, PRIVATE :: gsearch_nlats_def    ! Num of latitudes
@@ -83,5 +83,5 @@
    LOGICAL, PUBLIC :: ln_grid_global         ! Use global distribution of observations
    CHARACTER(LEN=44), PUBLIC :: &
-      & grid_search_file    ! file name head for grid search lookup 
+      & cn_gridsearchfile    ! file name head for grid search lookup 
 
    !!----------------------------------------------------------------------
@@ -613,5 +613,5 @@
          CALL obs_mpp_max_integer( kobsj, kobs )
       ELSE
-         CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs )
+         CALL obs_mpp_find_obs_proc( kproc, kobs )
       ENDIF
 
@@ -690,12 +690,12 @@
          
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*)'Grid search resolution : ', grid_search_res
-         
-         gsearch_nlons_def  = NINT( 360.0_wp / grid_search_res ) 
-         gsearch_nlats_def  = NINT( 180.0_wp / grid_search_res )
-         gsearch_lonmin_def = -180.0_wp + 0.5_wp * grid_search_res
-         gsearch_latmin_def =  -90.0_wp + 0.5_wp * grid_search_res
-         gsearch_dlon_def   = grid_search_res
-         gsearch_dlat_def   = grid_search_res
+         IF(lwp) WRITE(numout,*)'Grid search resolution : ', rn_gridsearchres
+         
+         gsearch_nlons_def  = NINT( 360.0_wp / rn_gridsearchres ) 
+         gsearch_nlats_def  = NINT( 180.0_wp / rn_gridsearchres )
+         gsearch_lonmin_def = -180.0_wp + 0.5_wp * rn_gridsearchres
+         gsearch_latmin_def =  -90.0_wp + 0.5_wp * rn_gridsearchres
+         gsearch_dlon_def   = rn_gridsearchres
+         gsearch_dlat_def   = rn_gridsearchres
          
          IF (lwp) THEN
@@ -710,8 +710,8 @@
          IF ( ln_grid_global ) THEN
             WRITE(cfname, FMT="(A,'_',A)") &
-               &          TRIM(grid_search_file), 'global.nc'
+               &          TRIM(cn_gridsearchfile), 'global.nc'
          ELSE
             WRITE(cfname, FMT="(A,'_',I4.4,'of',I4.4,'by',I4.4,'.nc')") &
-               &          TRIM(grid_search_file), nproc, jpni, jpnj
+               &          TRIM(cn_gridsearchfile), nproc, jpni, jpnj
          ENDIF
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90	(revision 6808)
@@ -35,5 +35,5 @@
 CONTAINS
 
-   SUBROUTINE obs_int_comm_3d( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+   SUBROUTINE obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, &
       &                        pval, pgval, kproc )
       !!----------------------------------------------------------------------
@@ -57,4 +57,6 @@
       INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil
       INTEGER, INTENT(IN) :: kobs      ! Local number of observations
+      INTEGER, INTENT(IN) :: kpi       ! Number of points in i direction
+      INTEGER, INTENT(IN) :: kpj       ! Number of points in j direction
       INTEGER, INTENT(IN) :: kpk       ! Number of levels
       INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
@@ -63,5 +65,5 @@
       INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
          & kproc            ! Precomputed processor for each i,j,iobs points
-      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::&
          & pval             ! Local 3D array to extract data from
       REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
@@ -73,10 +75,10 @@
          IF (PRESENT(kproc)) THEN
 
-            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, &
+            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, &
                &                         kgrdj, pval, pgval, kproc=kproc )
 
          ELSE
 
-            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, &
+            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, &
                &                         kgrdj, pval, pgval )
 
@@ -85,5 +87,5 @@
       ELSE
 
-         CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+         CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, &
             &                        pval, pgval )
 
@@ -92,5 +94,5 @@
    END SUBROUTINE obs_int_comm_3d
 
-   SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, kgrdi, kgrdj, pval, pgval, &
+   SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, kpi, kpj, kgrdi, kgrdj, pval, pgval, &
       &                        kproc )
       !!----------------------------------------------------------------------
@@ -111,4 +113,6 @@
       INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil
       INTEGER, INTENT(IN) :: kobs          ! Local number of observations
+      INTEGER, INTENT(IN) :: kpi          ! Number of model grid points in i direction
+      INTEGER, INTENT(IN) :: kpj          ! Number of model grid points in j direction
       INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
          & kgrdi, &         ! i,j indicies for each stencil
@@ -116,5 +120,5 @@
       INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
          & kproc            ! Precomputed processor for each i,j,iobs points
-      REAL(KIND=wp), DIMENSION(jpi,jpj), INTENT(IN) ::&
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) ::&
          & pval             ! Local 3D array to extra data from
       REAL(KIND=wp), DIMENSION(kptsi,kptsj,kobs), INTENT(OUT) ::&
@@ -136,9 +140,9 @@
       IF (PRESENT(kproc)) THEN
 
-         CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, &
+         CALL obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, 1, kgrdi, kgrdj, zval, &
             &                  zgval, kproc=kproc )
       ELSE
 
-         CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, &
+         CALL obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, 1, kgrdi, kgrdj, zval, &
             &                  zgval )
 
@@ -154,5 +158,5 @@
    END SUBROUTINE obs_int_comm_2d
 
-   SUBROUTINE obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+   SUBROUTINE obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, &
       &                               pval, pgval, kproc )
       !!----------------------------------------------------------------------
@@ -174,4 +178,6 @@
       INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil
       INTEGER, INTENT(IN) :: kobs      ! Local number of observations
+      INTEGER, INTENT(IN) :: kpi       ! Number of model points in i direction
+      INTEGER, INTENT(IN) :: kpj       ! Number of model points in j direction
       INTEGER, INTENT(IN) :: kpk       ! Number of levels
       INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
@@ -180,5 +186,5 @@
       INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
          & kproc            ! Precomputed processor for each i,j,iobs points
-      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::&
          & pval             ! Local 3D array to extract data from
       REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
@@ -207,11 +213,11 @@
 
       ! Check valid points
-      
+
       IF ( ( MAXVAL(kgrdi) > jpiglo ) .OR. ( MINVAL(kgrdi) < 1 ) .OR. &
          & ( MAXVAL(kgrdj) > jpjglo ) .OR. ( MINVAL(kgrdj) < 1 ) ) THEN
-         
+
          CALL ctl_stop( 'Error in obs_int_comm_3d_global', &
             &           'Point outside global domain' )
-         
+
       ENDIF
 
@@ -323,5 +329,5 @@
    END SUBROUTINE obs_int_comm_3d_global
    
-   SUBROUTINE obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+   SUBROUTINE obs_int_comm_3d_local( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, &
       &                              pval, pgval )
       !!----------------------------------------------------------------------
@@ -343,9 +349,11 @@
       INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil
       INTEGER, INTENT(IN) :: kobs         ! Local number of observations
+      INTEGER, INTENT(IN) :: kpi          ! Number of model points in i direction
+      INTEGER, INTENT(IN) :: kpj          ! Number of model points in j direction
       INTEGER, INTENT(IN) :: kpk          ! Number of levels
       INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
          & kgrdi, &         ! i,j indicies for each stencil
          & kgrdj
-      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::&
          & pval             ! Local 3D array to extract data from
       REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90	(revision 6808)
@@ -7,4 +7,6 @@
    !!             -   ! 2006-05  (K. Mogensen)  Reformatted
    !!             -   ! 2008-01  (K. Mogensen)  add mpp_global_max
+   !!            3.6  ! 2015-01  (J. Waters) obs_mpp_find_obs_proc 
+   !!                            rewritten to avoid global arrays
    !!----------------------------------------------------------------------
 #  define mpivar mpi_double_precision
@@ -12,5 +14,5 @@
    !! obs_mpp_bcast_integer : Broadcast an integer array from a processor to all processors
    !! obs_mpp_max_integer   : Find maximum on all processors of each value in an integer on all processors
-   !! obs_mpp_find_obs_proc : Find processors which should hold the observations
+   !! obs_mpp_find_obs_proc : Find processors which should hold the observations, avoiding global arrays
    !! obs_mpp_sum_integers  : Sum an integer array from all processors
    !! obs_mpp_sum_integer   : Sum an integer from all processors
@@ -111,18 +113,18 @@
 
 
-   SUBROUTINE obs_mpp_find_obs_proc( kobsp, kobsi, kobsj, kno )
-      !!----------------------------------------------------------------------
-      !!               ***  ROUTINE obs_mpp_find_obs_proc ***
-      !!          
-      !! ** Purpose : From the array kobsp containing the results of the grid
+   SUBROUTINE obs_mpp_find_obs_proc( kobsp,kno )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_find_obs_proc  ***
+      !!         
+      !! ** Purpose : From the array kobsp containing the results of the
       !!              grid search on each processor the processor return a
       !!              decision of which processors should hold the observation.
       !!
-      !! ** Method  : A temporary 2D array holding all the decisions is
-      !!              constructed using mpi_allgather on each processor.
-      !!              If more than one processor has found the observation
-      !!              with the observation in the inner domain gets it
-      !!
-      !! ** Action  : This does only work for MPI. 
+      !! ** Method  : Synchronize the processor number for each obs using
+      !!              obs_mpp_max_integer. If an observation exists on two 
+      !!              processors it will be allocated to the lower numbered
+      !!              processor.
+      !!
+      !! ** Action  : This does only work for MPI.
       !!              It does not work for SHMEM.
       !!
@@ -130,99 +132,44 @@
       !!----------------------------------------------------------------------
       INTEGER                , INTENT(in   ) ::   kno
-      INTEGER, DIMENSION(kno), INTENT(in   ) ::   kobsi, kobsj
       INTEGER, DIMENSION(kno), INTENT(inout) ::   kobsp
       !
 #if defined key_mpp_mpi
       !
-      INTEGER :: ji
-      INTEGER :: jj
-      INTEGER :: size
-      INTEGER :: ierr
-      INTEGER :: iobsip
-      INTEGER :: iobsjp
-      INTEGER :: num_sus_obs
-      INTEGER, DIMENSION(kno) ::   iobsig, iobsjg
-      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iobsp, iobsi, iobsj
-      !!
-INCLUDE 'mpif.h'
-      !!----------------------------------------------------------------------
-
-      !-----------------------------------------------------------------------
-      ! Call the MPI library to find the maximum accross processors
-      !-----------------------------------------------------------------------
-      CALL mpi_comm_size( mpi_comm_opa, size, ierr )
-      !-----------------------------------------------------------------------
-      ! Convert local grids points to global grid points
-      !-----------------------------------------------------------------------
+      !
+      INTEGER :: ji, isum
+      INTEGER, DIMENSION(kno) ::   iobsp
+      !!
+      !!
+
+      iobsp=kobsp
+
+      WHERE( iobsp(:) == -1 )
+         iobsp(:) = 9999999
+      END WHERE
+
+      iobsp=-1*iobsp
+
+      CALL obs_mpp_max_integer( iobsp, kno )
+
+      kobsp=-1*iobsp
+
+      isum=0
       DO ji = 1, kno
-         IF ( ( kobsi(ji) >= 1 ) .AND. ( kobsi(ji) <= jpi ) .AND. &
-            & ( kobsj(ji) >= 1 ) .AND. ( kobsj(ji) <= jpj ) ) THEN
-            iobsig(ji) = mig( kobsi(ji) )
-            iobsjg(ji) = mjg( kobsj(ji) )
-         ELSE
-            iobsig(ji) = -1
-            iobsjg(ji) = -1
+         IF ( kobsp(ji) == 9999999 ) THEN
+            isum=isum+1
+            kobsp(ji)=-1
          ENDIF
-      END DO
-      !-----------------------------------------------------------------------
-      ! Get the decisions from all processors
-      !-----------------------------------------------------------------------
-      ALLOCATE( iobsp(kno,size) )
-      ALLOCATE( iobsi(kno,size) )
-      ALLOCATE( iobsj(kno,size) )
-      CALL mpi_allgather( kobsp, kno, mpi_integer, &
-         &                iobsp, kno, mpi_integer, &
-         &                mpi_comm_opa, ierr )
-      CALL mpi_allgather( iobsig, kno, mpi_integer, &
-         &                iobsi, kno, mpi_integer, &
-         &                mpi_comm_opa, ierr )
-      CALL mpi_allgather( iobsjg, kno, mpi_integer, &
-         &                iobsj, kno, mpi_integer, &
-         &                mpi_comm_opa, ierr )
-
-      !-----------------------------------------------------------------------
-      ! Find the processor with observations from the lowest processor 
-      ! number among processors holding the observation.
-      !-----------------------------------------------------------------------
-      kobsp(:) = -1
-      num_sus_obs = 0
-      DO ji = 1, kno
-         DO jj = 1, size
-            IF ( ( kobsp(ji) == -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN
-               kobsp(ji) = iobsp(ji,jj)
-               iobsip = iobsi(ji,jj)
-               iobsjp = iobsj(ji,jj)
-            ENDIF
-            IF ( ( kobsp(ji) /= -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN
-               IF ( ( iobsip /= iobsi(ji,jj) ) .OR. &
-                  & ( iobsjp /= iobsj(ji,jj) ) ) THEN
-                  IF ( ( kobsp(ji) < 1000000 ) .AND. &
-                     & ( iobsp(ji,jj) < 1000000 ) ) THEN
-                     num_sus_obs=num_sus_obs+1
-                  ENDIF
-               ENDIF
-               IF ( mppmap(iobsip,iobsjp) /= ( kobsp(ji)+1 ) ) THEN
-                  IF ( ( iobsi(ji,jj) /= -1 ) .AND. &
-                     & ( iobsj(ji,jj) /= -1 ) ) THEN
-                     IF ((mppmap(iobsi(ji,jj),iobsj(ji,jj)) == (iobsp(ji,jj)+1))&
-                        & .OR. ( iobsp(ji,jj) < kobsp(ji) ) ) THEN
-                        kobsp(ji) = iobsp(ji,jj)
-                        iobsip = iobsi(ji,jj)
-                        iobsjp = iobsj(ji,jj)
-                     ENDIF
-                  ENDIF
-               ENDIF
-            ENDIF
-         END DO
-      END DO
-      IF (lwp) WRITE(numout,*) 'Number of suspicious observations: ',num_sus_obs
-
-      DEALLOCATE( iobsj )
-      DEALLOCATE( iobsi )
-      DEALLOCATE( iobsp )
+      ENDDO
+
+
+      IF ( isum > 0 ) THEN
+         IF (lwp) WRITE(numout,*) isum, ' observations failed the grid search.'
+         IF (lwp) WRITE(numout,*)'If ln_grid_search_lookup=.TRUE., try reducing grid_search_res'
+      ENDIF
+
 #else
       ! no MPI: empty routine
-#endif
-      !
+#endif     
+      
    END SUBROUTINE obs_mpp_find_obs_proc
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 6808)
@@ -7,28 +7,20 @@
 
    !!----------------------------------------------------------------------
-   !!   obs_pro_opt :    Compute the model counterpart of temperature and
-   !!                    salinity observations from profiles
-   !!   obs_sla_opt :    Compute the model counterpart of sea level anomaly
-   !!                    observations
-   !!   obs_sst_opt :    Compute the model counterpart of sea surface temperature
-   !!                    observations
-   !!   obs_sss_opt :    Compute the model counterpart of sea surface salinity
-   !!                    observations
-   !!   obs_seaice_opt : Compute the model counterpart of sea ice concentration
-   !!                    observations
-   !!
-   !!   obs_vel_opt :    Compute the model counterpart of zonal and meridional
-   !!                    components of velocity from observations.
+   !!   obs_prof_opt :    Compute the model counterpart of profile data
+   !!   obs_surf_opt :    Compute the model counterpart of surface data
+   !!   obs_pro_sco_opt: Compute the model counterpart of temperature and 
+   !!                    salinity observations from profiles in generalised 
+   !!                    vertical coordinates 
    !!----------------------------------------------------------------------
 
-   !! * Modules used   
+   !! * Modules used
    USE par_kind, ONLY : &         ! Precision variables
       & wp
    USE in_out_manager             ! I/O manager
    USE obs_inter_sup              ! Interpolation support
-   USE obs_inter_h2d, ONLY : &    ! Horizontal interpolation to the observation pt
+   USE obs_inter_h2d, ONLY : &    ! Horizontal interpolation to the obs pt
       & obs_int_h2d, &
       & obs_int_h2d_init
-   USE obs_inter_z1d, ONLY : &    ! Vertical interpolation to the observation pt
+   USE obs_inter_z1d, ONLY : &    ! Vertical interpolation to the obs pt
       & obs_int_z1d,    &
       & obs_int_z1d_spl
@@ -37,7 +29,12 @@
    USE dom_oce,       ONLY : &
       & glamt, glamu, glamv, &
-      & gphit, gphiu, gphiv
+      & gphit, gphiu, gphiv, & 
+      & gdept_n, gdept_0 
    USE lib_mpp,       ONLY : &
       & ctl_warn, ctl_stop
+   USE obs_grid,      ONLY : & 
+      & obs_level_search     
+   USE sbcdcy,        ONLY : &    ! For calculation of where it is night-time
+      & sbc_dcy, nday_qsr
 
    IMPLICIT NONE
@@ -46,12 +43,10 @@
    PRIVATE
 
-   PUBLIC obs_pro_opt, &  ! Compute the model counterpart of profile observations
-      &   obs_sla_opt, &  ! Compute the model counterpart of SLA observations
-      &   obs_sst_opt, &  ! Compute the model counterpart of SST observations
-      &   obs_sss_opt, &  ! Compute the model counterpart of SSS observations
-      &   obs_seaice_opt, &
-      &   obs_vel_opt     ! Compute the model counterpart of velocity profile data
-
-   INTEGER, PARAMETER, PUBLIC :: imaxavtypes = 20 ! Max number of daily avgd obs types
+   PUBLIC obs_prof_opt, &  ! Compute the model counterpart of profile obs
+      &   obs_pro_sco_opt, &  ! Compute the model counterpart of profile observations 
+      &   obs_surf_opt     ! Compute the model counterpart of surface obs
+
+   INTEGER, PARAMETER, PUBLIC :: &
+      & imaxavtypes = 20   ! Max number of daily avgd obs types
 
    !!----------------------------------------------------------------------
@@ -63,7 +58,10 @@
 CONTAINS
 
-   SUBROUTINE obs_pro_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, &
-      &                    ptn, psn, pgdept, ptmask, k1dint, k2dint, &
-      &                    kdailyavtypes )
+   SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk,          &
+      &                     kit000, kdaystp,                      &
+      &                     pvar1, pvar2, pgdept, pmask1, pmask2, &
+      &                     plam1, plam2, pphi1, pphi2,           &
+      &                     k1dint, k2dint, kdailyavtypes )
+
       !!-----------------------------------------------------------------------
       !!
@@ -78,5 +76,5 @@
       !!
       !!    First, a vertical profile of horizontally interpolated model
-      !!    now temperatures is computed at the obs (lon, lat) point.
+      !!    now values is computed at the obs (lon, lat) point.
       !!    Several horizontal interpolation schemes are available:
       !!        - distance-weighted (great circle) (k2dint = 0)
@@ -86,5 +84,5 @@
       !!        - polynomial (quadrilateral grid)  (k2dint = 4)
       !!
-      !!    Next, the vertical temperature profile is interpolated to the
+      !!    Next, the vertical profile is interpolated to the
       !!    data depth points. Two vertical interpolation schemes are
       !!    available:
@@ -96,14 +94,11 @@
       !!    routine.
       !!
-      !!    For ENACT moored buoy data (e.g., TAO), the model equivalent is
+      !!    If the logical is switched on, the model equivalent is
       !!    a daily mean model temperature field. So, we first compute
       !!    the mean, then interpolate only at the end of the day.
       !!
-      !!    Note: the in situ temperature observations must be converted
+      !!    Note: in situ temperature observations must be converted
       !!    to potential temperature (the model variable) prior to
       !!    assimilation. 
-      !!??????????????????????????????????????????????????????????????
-      !!    INCLUDE POTENTIAL TEMP -> IN SITU TEMP IN OBS OPERATOR???
-      !!??????????????????????????????????????????????????????????????
       !!
       !! ** Action  :
@@ -115,6 +110,7 @@
       !!      ! 07-01 (K. Mogensen) Merge of temperature and salinity
       !!      ! 07-03 (K. Mogensen) General handling of profiles
+      !!      ! 15-02 (M. Martin) Combined routine for all profile types
       !!-----------------------------------------------------------------------
-  
+
       !! * Modules used
       USE obs_profiles_def ! Definition of storage space for profile obs.
@@ -123,22 +119,30 @@
 
       !! * Arguments
-      TYPE(obs_prof), INTENT(INOUT) :: prodatqc  ! Subset of profile data not failing screening
-      INTEGER, INTENT(IN) :: kt        ! Time step
-      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
+      TYPE(obs_prof), INTENT(INOUT) :: &
+         & prodatqc                  ! Subset of profile data passing QC
+      INTEGER, INTENT(IN) :: kt      ! Time step
+      INTEGER, INTENT(IN) :: kpi     ! Model grid parameters
       INTEGER, INTENT(IN) :: kpj
       INTEGER, INTENT(IN) :: kpk
-      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
-                                       !   (kit000-1 = restart time)
-      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header)
-      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
-      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                    
+      INTEGER, INTENT(IN) :: kit000  ! Number of the first time step
+                                     !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k1dint  ! Vertical interpolation type (see header)
+      INTEGER, INTENT(IN) :: k2dint  ! Horizontal interpolation type (see header)
+      INTEGER, INTENT(IN) :: kdaystp ! Number of time steps per day
       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
-         & ptn,    &    ! Model temperature field
-         & psn,    &    ! Model salinity field
-         & ptmask       ! Land-sea mask
+         & pvar1,    &               ! Model field 1
+         & pvar2,    &               ! Model field 2
+         & pmask1,   &               ! Land-sea mask 1
+         & pmask2                    ! Land-sea mask 2
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & plam1,    &               ! Model longitudes for variable 1
+         & plam2,    &               ! Model longitudes for variable 2
+         & pphi1,    &               ! Model latitudes for variable 1
+         & pphi2                     ! Model latitudes for variable 2
       REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
-         & pgdept       ! Model array of depth levels
+         & pgdept                    ! Model array of depth levels
       INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
-         & kdailyavtypes! Types for daily averages
+         & kdailyavtypes             ! Types for daily averages
+
       !! * Local declarations
       INTEGER ::   ji
@@ -154,125 +158,158 @@
       INTEGER, DIMENSION(imaxavtypes) :: &
          & idailyavtypes
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi1, &
+         & igrdi2, &
+         & igrdj1, &
+         & igrdj2
       REAL(KIND=wp) :: zlam
       REAL(KIND=wp) :: zphi
       REAL(KIND=wp) :: zdaystp
       REAL(KIND=wp), DIMENSION(kpk) :: &
-         & zobsmask, &
+         & zobsmask1, &
+         & zobsmask2, &
          & zobsk,    &
          & zobs2k
       REAL(KIND=wp), DIMENSION(2,2,kpk) :: &
-         & zweig
+         & zweig1, &
+         & zweig2
       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: &
-         & zmask, &
-         & zintt, &
-         & zints, &
-         & zinmt, &
-         & zinms
+         & zmask1, &
+         & zmask2, &
+         & zint1, &
+         & zint2, &
+         & zinm1, &
+         & zinm2
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
-         & zglam, &
-         & zgphi
-      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
-         & igrdi, &
-         & igrdj
+         & zglam1, &
+         & zglam2, &
+         & zgphi1, &
+         & zgphi2
+      LOGICAL :: ld_dailyav
 
       !------------------------------------------------------------------------
       ! Local initialization 
       !------------------------------------------------------------------------
-      ! ... Record and data counters
+      ! Record and data counters
       inrc = kt - kit000 + 2
       ipro = prodatqc%npstp(inrc)
- 
+
       ! Daily average types
+      ld_dailyav = .FALSE.
       IF ( PRESENT(kdailyavtypes) ) THEN
          idailyavtypes(:) = kdailyavtypes(:)
+         IF ( ANY (idailyavtypes(:) /= -1) ) ld_dailyav = .TRUE.
       ELSE
          idailyavtypes(:) = -1
       ENDIF
 
-      ! Initialize daily mean for first timestep
+      ! Daily means are calculated for values over timesteps:
+      !  [1 <= kt <= kdaystp], [kdaystp+1 <= kt <= 2*kdaystp], ...
       idayend = MOD( kt - kit000 + 1, kdaystp )
 
-      ! Added kt == 0 test to catch restart case 
-      IF ( idayend == 1 .OR. kt == 0) THEN
-         IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt
+      IF ( ld_dailyav ) THEN
+
+         ! Initialize daily mean for first timestep of the day
+         IF ( idayend == 1 .OR. kt == 0 ) THEN
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     prodatqc%vdmean(ji,jj,jk,1) = 0.0
+                     prodatqc%vdmean(ji,jj,jk,2) = 0.0
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
          DO jk = 1, jpk
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  prodatqc%vdmean(ji,jj,jk,1) = 0.0
-                  prodatqc%vdmean(ji,jj,jk,2) = 0.0
+                  ! Increment field 1 for computing daily mean
+                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+                     &                        + pvar1(ji,jj,jk)
+                  ! Increment field 2 for computing daily mean
+                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+                     &                        + pvar2(ji,jj,jk)
                END DO
             END DO
          END DO
-      ENDIF
-
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! Increment the temperature field for computing daily mean
-               prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
-                  &                        + ptn(ji,jj,jk)
-               ! Increment the salinity field for computing daily mean
-               prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
-                  &                        + psn(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-   
-      ! Compute the daily mean at the end of day
-      zdaystp = 1.0 / REAL( kdaystp )
-      IF ( idayend == 0 ) THEN
-         DO jk = 1, jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
-                     &                        * zdaystp
-                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
-                  &                           * zdaystp
+
+         ! Compute the daily mean at the end of day
+         zdaystp = 1.0 / REAL( kdaystp )
+         IF ( idayend == 0 ) THEN
+            IF (lwp) WRITE(numout,*) 'Calculating prodatqc%vdmean on time-step: ',kt
+            CALL FLUSH(numout)
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+                        &                        * zdaystp
+                     prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+                        &                        * zdaystp
+                  END DO
                END DO
             END DO
-         END DO
+         ENDIF
+
       ENDIF
 
       ! Get the data for interpolation
       ALLOCATE( &
-         & igrdi(2,2,ipro),      &
-         & igrdj(2,2,ipro),      &
-         & zglam(2,2,ipro),      &
-         & zgphi(2,2,ipro),      &
-         & zmask(2,2,kpk,ipro),  &
-         & zintt(2,2,kpk,ipro),  &
-         & zints(2,2,kpk,ipro)   &
+         & igrdi1(2,2,ipro),      &
+         & igrdi2(2,2,ipro),      &
+         & igrdj1(2,2,ipro),      &
+         & igrdj2(2,2,ipro),      &
+         & zglam1(2,2,ipro),      &
+         & zglam2(2,2,ipro),      &
+         & zgphi1(2,2,ipro),      &
+         & zgphi2(2,2,ipro),      &
+         & zmask1(2,2,kpk,ipro),  &
+         & zmask2(2,2,kpk,ipro),  &
+         & zint1(2,2,kpk,ipro),  &
+         & zint2(2,2,kpk,ipro)   &
          & )
 
       DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
          iobs = jobs - prodatqc%nprofup
-         igrdi(1,1,iobs) = prodatqc%mi(jobs,1)-1
-         igrdj(1,1,iobs) = prodatqc%mj(jobs,1)-1
-         igrdi(1,2,iobs) = prodatqc%mi(jobs,1)-1
-         igrdj(1,2,iobs) = prodatqc%mj(jobs,1)
-         igrdi(2,1,iobs) = prodatqc%mi(jobs,1)
-         igrdj(2,1,iobs) = prodatqc%mj(jobs,1)-1
-         igrdi(2,2,iobs) = prodatqc%mi(jobs,1)
-         igrdj(2,2,iobs) = prodatqc%mj(jobs,1)
+         igrdi1(1,1,iobs) = prodatqc%mi(jobs,1)-1
+         igrdj1(1,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdi1(1,2,iobs) = prodatqc%mi(jobs,1)-1
+         igrdj1(1,2,iobs) = prodatqc%mj(jobs,1)
+         igrdi1(2,1,iobs) = prodatqc%mi(jobs,1)
+         igrdj1(2,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdi1(2,2,iobs) = prodatqc%mi(jobs,1)
+         igrdj1(2,2,iobs) = prodatqc%mj(jobs,1)
+         igrdi2(1,1,iobs) = prodatqc%mi(jobs,2)-1
+         igrdj2(1,1,iobs) = prodatqc%mj(jobs,2)-1
+         igrdi2(1,2,iobs) = prodatqc%mi(jobs,2)-1
+         igrdj2(1,2,iobs) = prodatqc%mj(jobs,2)
+         igrdi2(2,1,iobs) = prodatqc%mi(jobs,2)
+         igrdj2(2,1,iobs) = prodatqc%mj(jobs,2)-1
+         igrdi2(2,2,iobs) = prodatqc%mi(jobs,2)
+         igrdj2(2,2,iobs) = prodatqc%mj(jobs,2)
       END DO
 
-      CALL obs_int_comm_2d( 2, 2, ipro, igrdi, igrdj, glamt, zglam )
-      CALL obs_int_comm_2d( 2, 2, ipro, igrdi, igrdj, gphit, zgphi )
-      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, ptmask,zmask )
-      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, ptn,   zintt )
-      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, psn,   zints )
+      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, plam1, zglam1 )
+      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, pphi1, zgphi1 )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pmask1, zmask1 )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pvar1,   zint1 )
+      
+      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, plam2, zglam2 )
+      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, pphi2, zgphi2 )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pmask2, zmask2 )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pvar2,   zint2 )
 
       ! At the end of the day also get interpolated means
-      IF ( idayend == 0 ) THEN
+      IF ( ld_dailyav .AND. idayend == 0 ) THEN
 
          ALLOCATE( &
-            & zinmt(2,2,kpk,ipro),  &
-            & zinms(2,2,kpk,ipro)   &
+            & zinm1(2,2,kpk,ipro),  &
+            & zinm2(2,2,kpk,ipro)   &
             & )
 
-         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, &
-            &                  prodatqc%vdmean(:,:,:,1), zinmt )
-         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, &
-            &                  prodatqc%vdmean(:,:,:,2), zinms )
+         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, &
+            &                  prodatqc%vdmean(:,:,:,1), zinm1 )
+         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, &
+            &                  prodatqc%vdmean(:,:,:,2), zinm2 )
 
       ENDIF
@@ -283,5 +320,5 @@
 
          IF ( kt /= prodatqc%mstp(jobs) ) THEN
-            
+
             IF(lwp) THEN
                WRITE(numout,*)
@@ -298,47 +335,44 @@
             CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' )
          ENDIF
-         
+
          zlam = prodatqc%rlam(jobs)
          zphi = prodatqc%rphi(jobs)
-         
+
          ! Horizontal weights and vertical mask
 
-         IF ( ( prodatqc%npvend(jobs,1) > 0 ) .OR. &
-            & ( prodatqc%npvend(jobs,2) > 0 ) ) THEN
+         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN
 
             CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
-               &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
-               &                   zmask(:,:,:,iobs), zweig, zobsmask )
+               &                   zglam1(:,:,iobs), zgphi1(:,:,iobs), &
+               &                   zmask1(:,:,:,iobs), zweig1, zobsmask1 )
 
          ENDIF
 
+         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
+
+            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
+               &                   zglam2(:,:,iobs), zgphi2(:,:,iobs), &
+               &                   zmask2(:,:,:,iobs), zweig2, zobsmask2 )
+ 
+         ENDIF
+
          IF ( prodatqc%npvend(jobs,1) > 0 ) THEN
 
             zobsk(:) = obfillflt
 
-	    IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN
+            IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN
 
                IF ( idayend == 0 )  THEN
-                  
-                  ! Daily averaged moored buoy (MRB) data
-                  
+                  ! Daily averaged data
                   CALL obs_int_h2d( kpk, kpk,      &
-                     &              zweig, zinmt(:,:,:,iobs), zobsk )
-                  
-                  
-               ELSE
-               
-                  CALL ctl_stop( ' A nonzero' //     &
-                     &           ' number of profile T BUOY data should' // &
-                     &           ' only occur at the end of a given day' )
+                     &              zweig1, zinm1(:,:,:,iobs), zobsk )
 
                ENDIF
-	       
+
             ELSE 
-               
+
                ! Point data
-
                CALL obs_int_h2d( kpk, kpk,      &
-                  &              zweig, zintt(:,:,:,iobs), zobsk )
+                  &              zweig1, zint1(:,:,:,iobs), zobsk )
 
             ENDIF
@@ -348,10 +382,10 @@
             ! polynomial at obs points
             !-------------------------------------------------------------
-            
+
             IF ( k1dint == 1 ) THEN
                CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   &
-                  &                  pgdept, zobsmask )
+                  &                  pgdept, zobsmask1 )
             ENDIF
-            
+
             !-----------------------------------------------------------------
             !  Vertical interpolation to the observation point
@@ -365,5 +399,5 @@
                & zobsk, zobs2k,                   &
                & prodatqc%var(1)%vmod(ista:iend), &
-               & pgdept, zobsmask )
+               & pgdept, zobsmask1 )
 
          ENDIF
@@ -377,23 +411,15 @@
                IF ( idayend == 0 )  THEN
 
-                  ! Daily averaged moored buoy (MRB) data
-                  
+                  ! Daily averaged data
                   CALL obs_int_h2d( kpk, kpk,      &
-                     &              zweig, zinms(:,:,:,iobs), zobsk )
-                  
-               ELSE
-
-                  CALL ctl_stop( ' A nonzero' //     &
-                     &           ' number of profile S BUOY data should' // &
-                     &           ' only occur at the end of a given day' )
+                     &              zweig2, zinm2(:,:,:,iobs), zobsk )
 
                ENDIF
 
             ELSE
-               
+
                ! Point data
-
                CALL obs_int_h2d( kpk, kpk,      &
-                  &              zweig, zints(:,:,:,iobs), zobsk )
+                  &              zweig2, zint2(:,:,:,iobs), zobsk )
 
             ENDIF
@@ -404,10 +430,10 @@
             ! polynomial at obs points
             !-------------------------------------------------------------
-            
+
             IF ( k1dint == 1 ) THEN
                CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, &
-                  &                  pgdept, zobsmask )
+                  &                  pgdept, zobsmask2 )
             ENDIF
-            
+
             !----------------------------------------------------------------
             !  Vertical interpolation to the observation point
@@ -421,39 +447,632 @@
                & zobsk, zobs2k, &
                & prodatqc%var(2)%vmod(ista:iend),&
-               & pgdept, zobsmask )
+               & pgdept, zobsmask2 )
 
          ENDIF
 
       END DO
- 
+
       ! Deallocate the data for interpolation
       DEALLOCATE( &
-         & igrdi, &
-         & igrdj, &
-         & zglam, &
-         & zgphi, &
-         & zmask, &
-         & zintt, &
-         & zints  &
+         & igrdi1, &
+         & igrdi2, &
+         & igrdj1, &
+         & igrdj2, &
+         & zglam1, &
+         & zglam2, &
+         & zgphi1, &
+         & zgphi2, &
+         & zmask1, &
+         & zmask2, &
+         & zint1,  &
+         & zint2   &
          & )
+
       ! At the end of the day also get interpolated means
-      IF ( idayend == 0 ) THEN
+      IF ( ld_dailyav .AND. idayend == 0 ) THEN
          DEALLOCATE( &
-            & zinmt,  &
-            & zinms   &
+            & zinm1,  &
+            & zinm2   &
             & )
       ENDIF
 
       prodatqc%nprofup = prodatqc%nprofup + ipro 
+
+   END SUBROUTINE obs_prof_opt
+
+   SUBROUTINE obs_pro_sco_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, & 
+      &                    ptn, psn, pgdept, pgdepw, ptmask, k1dint, k2dint, & 
+      &                    kdailyavtypes ) 
+      !!----------------------------------------------------------------------- 
+      !! 
+      !!                     ***  ROUTINE obs_pro_opt  *** 
+      !! 
+      !! ** Purpose : Compute the model counterpart of profiles 
+      !!              data by interpolating from the model grid to the  
+      !!              observation point. Generalised vertical coordinate version 
+      !! 
+      !! ** Method  : Linearly interpolate to each observation point using  
+      !!              the model values at the corners of the surrounding grid box. 
+      !! 
+      !!          First, model values on the model grid are interpolated vertically to the 
+      !!          Depths of the profile observations.  Two vertical interpolation schemes are 
+      !!          available: 
+      !!          - linear       (k1dint = 0) 
+      !!          - Cubic spline (k1dint = 1)    
+      !! 
+      !! 
+      !!         Secondly the interpolated values are interpolated horizontally to the  
+      !!         obs (lon, lat) point. 
+      !!         Several horizontal interpolation schemes are available: 
+      !!        - distance-weighted (great circle) (k2dint = 0) 
+      !!        - distance-weighted (small angle)  (k2dint = 1) 
+      !!        - bilinear (geographical grid)     (k2dint = 2) 
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3) 
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4) 
+      !! 
+      !!    For the cubic spline the 2nd derivative of the interpolating  
+      !!    polynomial is computed before entering the vertical interpolation  
+      !!    routine. 
+      !! 
+      !!    For ENACT moored buoy data (e.g., TAO), the model equivalent is 
+      !!    a daily mean model temperature field. So, we first compute 
+      !!    the mean, then interpolate only at the end of the day. 
+      !! 
+      !!    This is the procedure to be used with generalised vertical model  
+      !!    coordinates (ie s-coordinates. It is ~4x slower than the equivalent 
+      !!    horizontal then vertical interpolation algorithm, but can deal with situations 
+      !!    where the model levels are not flat. 
+      !!    ONLY PERFORMED if ln_sco=.TRUE.  
+      !!       
+      !!    Note: the in situ temperature observations must be converted 
+      !!    to potential temperature (the model variable) prior to 
+      !!    assimilation.  
+      !!?????????????????????????????????????????????????????????????? 
+      !!    INCLUDE POTENTIAL TEMP -> IN SITU TEMP IN OBS OPERATOR??? 
+      !!?????????????????????????????????????????????????????????????? 
+      !! 
+      !! ** Action  : 
+      !! 
+      !! History : 
+      !!      ! 2014-08 (J. While) Adapted from obs_pro_opt to handel generalised 
+      !!                           vertical coordinates
+      !!----------------------------------------------------------------------- 
+   
+      !! * Modules used 
+      USE obs_profiles_def   ! Definition of storage space for profile obs. 
+       
+      IMPLICIT NONE 
+ 
+      !! * Arguments 
+      TYPE(obs_prof), INTENT(INOUT) :: prodatqc   ! Subset of profile data not failing screening 
+      INTEGER, INTENT(IN) :: kt        ! Time step 
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters 
+      INTEGER, INTENT(IN) :: kpj 
+      INTEGER, INTENT(IN) :: kpk 
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step  
+                                       !   (kit000-1 = restart time) 
+      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header) 
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
+      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                     
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
+         & ptn,    &    ! Model temperature field 
+         & psn,    &    ! Model salinity field 
+         & ptmask       ! Land-sea mask 
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
+         & pgdept,  &    ! Model array of depth T levels    
+         & pgdepw       ! Model array of depth W levels 
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
+         & kdailyavtypes   ! Types for daily averages 
       
-   END SUBROUTINE obs_pro_opt
-
-   SUBROUTINE obs_sla_opt( sladatqc, kt, kpi, kpj, kit000, &
-      &                    psshn, psshmask, k2dint )
+      !! * Local declarations 
+      INTEGER ::   ji 
+      INTEGER ::   jj 
+      INTEGER ::   jk 
+      INTEGER ::   iico, ijco 
+      INTEGER ::   jobs 
+      INTEGER ::   inrc 
+      INTEGER ::   ipro 
+      INTEGER ::   idayend 
+      INTEGER ::   ista 
+      INTEGER ::   iend 
+      INTEGER ::   iobs 
+      INTEGER ::   iin, ijn, ikn, ik   ! looping indices over interpolation nodes 
+      INTEGER, DIMENSION(imaxavtypes) :: & 
+         & idailyavtypes 
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
+         & igrdi, & 
+         & igrdj 
+      INTEGER :: & 
+         & inum_obs
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: iv_indic    
+      REAL(KIND=wp) :: zlam 
+      REAL(KIND=wp) :: zphi 
+      REAL(KIND=wp) :: zdaystp 
+      REAL(KIND=wp), DIMENSION(kpk) :: & 
+         & zobsmask, & 
+         & zobsk,    & 
+         & zobs2k 
+      REAL(KIND=wp), DIMENSION(2,2,1) :: & 
+         & zweig, & 
+         & l_zweig 
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
+         & zmask, & 
+         & zintt, & 
+         & zints, & 
+         & zinmt, & 
+         & zgdept,& 
+         & zgdepw,& 
+         & zinms 
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
+         & zglam, & 
+         & zgphi    
+      REAL(KIND=wp), DIMENSION(1) :: zmsk_1       
+      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner       
+ 
+      !------------------------------------------------------------------------ 
+      ! Local initialization  
+      !------------------------------------------------------------------------ 
+      ! ... Record and data counters 
+      inrc = kt - kit000 + 2 
+      ipro = prodatqc%npstp(inrc) 
+  
+      ! Daily average types 
+      IF ( PRESENT(kdailyavtypes) ) THEN 
+         idailyavtypes(:) = kdailyavtypes(:) 
+      ELSE 
+         idailyavtypes(:) = -1 
+      ENDIF 
+ 
+      ! Initialize daily mean for first time-step 
+      idayend = MOD( kt - kit000 + 1, kdaystp ) 
+ 
+      ! Added kt == 0 test to catch restart case  
+      IF ( idayend == 1 .OR. kt == 0) THEN 
+          
+         IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt 
+         DO jk = 1, jpk 
+            DO jj = 1, jpj 
+               DO ji = 1, jpi 
+                  prodatqc%vdmean(ji,jj,jk,1) = 0.0 
+                  prodatqc%vdmean(ji,jj,jk,2) = 0.0 
+               END DO 
+            END DO 
+         END DO 
+       
+      ENDIF 
+       
+      DO jk = 1, jpk 
+         DO jj = 1, jpj 
+            DO ji = 1, jpi 
+               ! Increment the temperature field for computing daily mean 
+               prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
+               &                        + ptn(ji,jj,jk) 
+               ! Increment the salinity field for computing daily mean 
+               prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
+               &                        + psn(ji,jj,jk) 
+            END DO 
+         END DO 
+      END DO 
+    
+      ! Compute the daily mean at the end of day 
+      zdaystp = 1.0 / REAL( kdaystp ) 
+      IF ( idayend == 0 ) THEN 
+         DO jk = 1, jpk 
+            DO jj = 1, jpj 
+               DO ji = 1, jpi 
+                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
+                  &                        * zdaystp 
+                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
+                  &                           * zdaystp 
+               END DO 
+            END DO 
+         END DO 
+      ENDIF 
+ 
+      ! Get the data for interpolation 
+      ALLOCATE( & 
+         & igrdi(2,2,ipro),      & 
+         & igrdj(2,2,ipro),      & 
+         & zglam(2,2,ipro),      & 
+         & zgphi(2,2,ipro),      & 
+         & zmask(2,2,kpk,ipro),  & 
+         & zintt(2,2,kpk,ipro),  & 
+         & zints(2,2,kpk,ipro),  & 
+         & zgdept(2,2,kpk,ipro), & 
+         & zgdepw(2,2,kpk,ipro)  & 
+         & ) 
+ 
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
+         iobs = jobs - prodatqc%nprofup 
+         igrdi(1,1,iobs) = prodatqc%mi(jobs,1)-1 
+         igrdj(1,1,iobs) = prodatqc%mj(jobs,1)-1 
+         igrdi(1,2,iobs) = prodatqc%mi(jobs,1)-1 
+         igrdj(1,2,iobs) = prodatqc%mj(jobs,1) 
+         igrdi(2,1,iobs) = prodatqc%mi(jobs,1) 
+         igrdj(2,1,iobs) = prodatqc%mj(jobs,1)-1 
+         igrdi(2,2,iobs) = prodatqc%mi(jobs,1) 
+         igrdj(2,2,iobs) = prodatqc%mj(jobs,1) 
+      END DO 
+     
+      ! Initialise depth arrays
+      zgdept = 0.0
+      zgdepw = 0.0
+ 
+      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi, igrdj, glamt, zglam ) 
+      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi, igrdj, gphit, zgphi ) 
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, ptmask,zmask ) 
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, ptn,   zintt ) 
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, psn,   zints ) 
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdept(:,:,:), & 
+        &                     zgdept ) 
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdepw(:,:,:), & 
+        &                     zgdepw ) 
+ 
+      ! At the end of the day also get interpolated means 
+      IF ( idayend == 0 ) THEN 
+ 
+         ALLOCATE( & 
+            & zinmt(2,2,kpk,ipro),  & 
+            & zinms(2,2,kpk,ipro)   & 
+            & ) 
+ 
+         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, & 
+            &                  prodatqc%vdmean(:,:,:,1), zinmt ) 
+         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, & 
+            &                  prodatqc%vdmean(:,:,:,2), zinms ) 
+ 
+      ENDIF 
+       
+      ! Return if no observations to process 
+      ! Has to be done after comm commands to ensure processors 
+      ! stay in sync 
+      IF ( ipro == 0 ) RETURN 
+ 
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
+    
+         iobs = jobs - prodatqc%nprofup 
+    
+         IF ( kt /= prodatqc%mstp(jobs) ) THEN 
+             
+            IF(lwp) THEN 
+               WRITE(numout,*) 
+               WRITE(numout,*) ' E R R O R : Observation',              & 
+                  &            ' time step is not consistent with the', & 
+                  &            ' model time step' 
+               WRITE(numout,*) ' =========' 
+               WRITE(numout,*) 
+               WRITE(numout,*) ' Record  = ', jobs,                    & 
+                  &            ' kt      = ', kt,                      & 
+                  &            ' mstp    = ', prodatqc%mstp(jobs), & 
+                  &            ' ntyp    = ', prodatqc%ntyp(jobs) 
+            ENDIF 
+            CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' ) 
+         ENDIF 
+          
+         zlam = prodatqc%rlam(jobs) 
+         zphi = prodatqc%rphi(jobs) 
+          
+         ! Horizontal weights 
+         ! Only calculated once, for both T and S. 
+         ! Masked values are calculated later.  
+ 
+         IF ( ( prodatqc%npvend(jobs,1) > 0 ) .OR. & 
+            & ( prodatqc%npvend(jobs,2) > 0 ) ) THEN 
+ 
+            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     & 
+               &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
+               &                   zmask(:,:,1,iobs), zweig, zmsk_1 ) 
+ 
+         ENDIF 
+         
+         ! IF zmsk_1 = 0; then ob is on land 
+         IF (zmsk_1(1) < 0.1) THEN 
+            WRITE(numout,*) 'WARNING (obs_oper) :- profile found within landmask' 
+   
+         ELSE  
+             
+            ! Temperature 
+             
+            IF ( prodatqc%npvend(jobs,1) > 0 ) THEN  
+    
+               zobsk(:) = obfillflt 
+    
+               IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN 
+    
+                  IF ( idayend == 0 )  THEN 
+                   
+                     ! Daily averaged moored buoy (MRB) data 
+                   
+                     ! vertically interpolate all 4 corners 
+                     ista = prodatqc%npvsta(jobs,1) 
+                     iend = prodatqc%npvend(jobs,1) 
+                     inum_obs = iend - ista + 1 
+                     ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs)) 
+      
+                     DO iin=1,2 
+                        DO ijn=1,2 
+                                       
+                                       
+           
+                           IF ( k1dint == 1 ) THEN 
+                              CALL obs_int_z1d_spl( kpk, & 
+                                 &     zinmt(iin,ijn,:,iobs), & 
+                                 &     zobs2k, zgdept(iin,ijn,:,iobs), & 
+                                 &     zmask(iin,ijn,:,iobs)) 
+                           ENDIF 
+       
+                           CALL obs_level_search(kpk, & 
+                              &    zgdept(iin,ijn,:,iobs), & 
+                              &    inum_obs, prodatqc%var(1)%vdep(ista:iend), & 
+                              &    iv_indic) 
+                           CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, & 
+                              &    prodatqc%var(1)%vdep(ista:iend), & 
+                              &    zinmt(iin,ijn,:,iobs), & 
+                              &    zobs2k, interp_corner(iin,ijn,:), & 
+                              &    zgdept(iin,ijn,:,iobs), & 
+                              &    zmask(iin,ijn,:,iobs)) 
+       
+                        ENDDO 
+                     ENDDO 
+                   
+                   
+                  ELSE 
+                
+                     CALL ctl_stop( ' A nonzero' //     & 
+                        &           ' number of profile T BUOY data should' // & 
+                        &           ' only occur at the end of a given day' ) 
+    
+                  ENDIF 
+         
+               ELSE  
+                
+                  ! Point data 
+     
+                  ! vertically interpolate all 4 corners 
+                  ista = prodatqc%npvsta(jobs,1) 
+                  iend = prodatqc%npvend(jobs,1) 
+                  inum_obs = iend - ista + 1 
+                  ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs)) 
+                  DO iin=1,2  
+                     DO ijn=1,2 
+                                    
+                                    
+                        IF ( k1dint == 1 ) THEN 
+                           CALL obs_int_z1d_spl( kpk, & 
+                              &    zintt(iin,ijn,:,iobs),& 
+                              &    zobs2k, zgdept(iin,ijn,:,iobs), & 
+                              &    zmask(iin,ijn,:,iobs)) 
+  
+                        ENDIF 
+       
+                        CALL obs_level_search(kpk, & 
+                            &        zgdept(iin,ijn,:,iobs),& 
+                            &        inum_obs, prodatqc%var(1)%vdep(ista:iend), & 
+                            &         iv_indic) 
+                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     & 
+                            &          prodatqc%var(1)%vdep(ista:iend),     & 
+                            &          zintt(iin,ijn,:,iobs),            & 
+                            &          zobs2k,interp_corner(iin,ijn,:), & 
+                            &          zgdept(iin,ijn,:,iobs),         & 
+                            &          zmask(iin,ijn,:,iobs) )      
+         
+                     ENDDO 
+                  ENDDO 
+             
+               ENDIF 
+       
+               !------------------------------------------------------------- 
+               ! Compute the horizontal interpolation for every profile level 
+               !------------------------------------------------------------- 
+             
+               DO ikn=1,inum_obs 
+                  iend=ista+ikn-1 
+
+                  l_zweig(:,:,1) = 0._wp 
+
+                  ! This code forces the horizontal weights to be  
+                  ! zero IF the observation is below the bottom of the  
+                  ! corners of the interpolation nodes, Or if it is in  
+                  ! the mask. This is important for observations are near  
+                  ! steep bathymetry 
+                  DO iin=1,2 
+                     DO ijn=1,2 
+     
+                        depth_loop1: DO ik=kpk,2,-1 
+                           IF(zmask(iin,ijn,ik-1,iobs ) > 0.9 )THEN   
+                            
+                              l_zweig(iin,ijn,1) = &  
+                                 & zweig(iin,ijn,1) * & 
+                                 & MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) & 
+                                 &  - prodatqc%var(1)%vdep(iend)),0._wp) 
+                            
+                              EXIT depth_loop1 
+                           ENDIF 
+                        ENDDO depth_loop1 
+     
+                     ENDDO 
+                  ENDDO 
+   
+                  CALL obs_int_h2d( 1, 1, l_zweig, interp_corner(:,:,ikn), & 
+                  &          prodatqc%var(1)%vmod(iend:iend) ) 
+ 
+               ENDDO 
+ 
+ 
+               DEALLOCATE(interp_corner,iv_indic) 
+          
+            ENDIF 
+       
+ 
+            ! Salinity  
+          
+            IF ( prodatqc%npvend(jobs,2) > 0 ) THEN  
+    
+               zobsk(:) = obfillflt 
+    
+               IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN 
+    
+                  IF ( idayend == 0 )  THEN 
+                   
+                     ! Daily averaged moored buoy (MRB) data 
+                   
+                     ! vertically interpolate all 4 corners 
+                     ista = prodatqc%npvsta(iobs,2) 
+                     iend = prodatqc%npvend(iobs,2) 
+                     inum_obs = iend - ista + 1 
+                     ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs)) 
+      
+                     DO iin=1,2 
+                        DO ijn=1,2 
+                                       
+                                       
+           
+                           IF ( k1dint == 1 ) THEN 
+                              CALL obs_int_z1d_spl( kpk, & 
+                                 &     zinms(iin,ijn,:,iobs), & 
+                                 &     zobs2k, zgdept(iin,ijn,:,iobs), & 
+                                 &     zmask(iin,ijn,:,iobs)) 
+                           ENDIF 
+       
+                           CALL obs_level_search(kpk, & 
+                              &    zgdept(iin,ijn,:,iobs), & 
+                              &    inum_obs, prodatqc%var(2)%vdep(ista:iend), & 
+                              &    iv_indic) 
+                           CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, & 
+                              &    prodatqc%var(2)%vdep(ista:iend), & 
+                              &    zinms(iin,ijn,:,iobs), & 
+                              &    zobs2k, interp_corner(iin,ijn,:), & 
+                              &    zgdept(iin,ijn,:,iobs), & 
+                              &    zmask(iin,ijn,:,iobs)) 
+       
+                        ENDDO 
+                     ENDDO 
+                   
+                   
+                  ELSE 
+                
+                     CALL ctl_stop( ' A nonzero' //     & 
+                        &           ' number of profile T BUOY data should' // & 
+                        &           ' only occur at the end of a given day' ) 
+    
+                  ENDIF 
+         
+               ELSE  
+                
+                  ! Point data 
+     
+                  ! vertically interpolate all 4 corners 
+                  ista = prodatqc%npvsta(jobs,2) 
+                  iend = prodatqc%npvend(jobs,2) 
+                  inum_obs = iend - ista + 1 
+                  ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs)) 
+                   
+                  DO iin=1,2     
+                     DO ijn=1,2  
+                                 
+                                 
+                        IF ( k1dint == 1 ) THEN 
+                           CALL obs_int_z1d_spl( kpk, & 
+                              &    zints(iin,ijn,:,iobs),& 
+                              &    zobs2k, zgdept(iin,ijn,:,iobs), & 
+                              &    zmask(iin,ijn,:,iobs)) 
+  
+                        ENDIF 
+       
+                        CALL obs_level_search(kpk, & 
+                           &        zgdept(iin,ijn,:,iobs),& 
+                           &        inum_obs, prodatqc%var(2)%vdep(ista:iend), & 
+                           &         iv_indic) 
+                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,  & 
+                           &          prodatqc%var(2)%vdep(ista:iend),     & 
+                           &          zints(iin,ijn,:,iobs),               & 
+                           &          zobs2k,interp_corner(iin,ijn,:),     & 
+                           &          zgdept(iin,ijn,:,iobs),              & 
+                           &          zmask(iin,ijn,:,iobs) )      
+         
+                     ENDDO 
+                  ENDDO 
+             
+               ENDIF 
+       
+               !------------------------------------------------------------- 
+               ! Compute the horizontal interpolation for every profile level 
+               !------------------------------------------------------------- 
+             
+               DO ikn=1,inum_obs 
+                  iend=ista+ikn-1 
+
+                  l_zweig(:,:,1) = 0._wp
+   
+                  ! This code forces the horizontal weights to be  
+                  ! zero IF the observation is below the bottom of the  
+                  ! corners of the interpolation nodes, Or if it is in  
+                  ! the mask. This is important for observations are near  
+                  ! steep bathymetry 
+                  DO iin=1,2 
+                     DO ijn=1,2 
+     
+                        depth_loop2: DO ik=kpk,2,-1 
+                           IF(zmask(iin,ijn,ik-1,iobs ) > 0.9 )THEN   
+                            
+                              l_zweig(iin,ijn,1) = &  
+                                 &  zweig(iin,ijn,1) * & 
+                                 &  MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) & 
+                                 &  - prodatqc%var(2)%vdep(iend)),0._wp) 
+                            
+                              EXIT depth_loop2 
+                           ENDIF 
+                        ENDDO depth_loop2 
+     
+                     ENDDO 
+                  ENDDO 
+   
+                  CALL obs_int_h2d( 1, 1, l_zweig, interp_corner(:,:,ikn), & 
+                  &          prodatqc%var(2)%vmod(iend:iend) ) 
+ 
+               ENDDO 
+ 
+ 
+               DEALLOCATE(interp_corner,iv_indic) 
+          
+            ENDIF 
+          
+         ENDIF 
+       
+      END DO 
+     
+      ! Deallocate the data for interpolation 
+      DEALLOCATE( & 
+         & igrdi, & 
+         & igrdj, & 
+         & zglam, & 
+         & zgphi, & 
+         & zmask, & 
+         & zintt, & 
+         & zints, & 
+         & zgdept,&
+         & zgdepw &
+         & ) 
+      ! At the end of the day also get interpolated means 
+      IF ( idayend == 0 ) THEN 
+         DEALLOCATE( & 
+            & zinmt,  & 
+            & zinms   & 
+            & ) 
+      ENDIF 
+    
+      prodatqc%nprofup = prodatqc%nprofup + ipro  
+       
+   END SUBROUTINE obs_pro_sco_opt 
+ 
+   SUBROUTINE obs_surf_opt( surfdataqc, kt, kpi, kpj,         &
+      &                    kit000, kdaystp, psurf, psurfmask, &
+      &                    k2dint, ldnightav )
+
       !!-----------------------------------------------------------------------
       !!
-      !!                     ***  ROUTINE obs_sla_opt  ***
-      !!
-      !! ** Purpose : Compute the model counterpart of sea level anomaly
+      !!                     ***  ROUTINE obs_surf_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of surface
       !!              data by interpolating from the model grid to the 
       !!              observation point.
@@ -462,5 +1081,5 @@
       !!              the model values at the corners of the surrounding grid box.
       !!
-      !!    The now model SSH is first computed at the obs (lon, lat) point.
+      !!    The new model value is first computed at the obs (lon, lat) point.
       !!
       !!    Several horizontal interpolation schemes are available:
@@ -470,7 +1089,5 @@
       !!        - bilinear (quadrilateral grid)    (k2dint = 3)
       !!        - polynomial (quadrilateral grid)  (k2dint = 4)
-      !!  
-      !!    The sea level anomaly at the observation points is then computed 
-      !!    by removing a mean dynamic topography (defined at the obs. point).
+      !!
       !!
       !! ** Action  :
@@ -478,6 +1095,7 @@
       !! History :
       !!      ! 07-03 (A. Weaver)
+      !!      ! 15-02 (M. Martin) Combined routine for surface types
       !!-----------------------------------------------------------------------
-  
+
       !! * Modules used
       USE obs_surf_def  ! Definition of storage space for surface observations
@@ -486,15 +1104,18 @@
 
       !! * Arguments
-      TYPE(obs_surf), INTENT(INOUT) :: sladatqc     ! Subset of surface data not failing screening
-      INTEGER, INTENT(IN) :: kt      ! Time step
-      INTEGER, INTENT(IN) :: kpi     ! Model grid parameters
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & surfdataqc                  ! Subset of surface data passing QC
+      INTEGER, INTENT(IN) :: kt        ! Time step
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
       INTEGER, INTENT(IN) :: kpj
-      INTEGER, INTENT(IN) :: kit000   ! Number of the first time step 
-                                      !   (kit000-1 = restart time)
-      INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header)
-      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
-         & psshn,  &    ! Model SSH field
-         & psshmask     ! Land-sea mask
-         
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
+                                       !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
+      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & psurf,  &                   ! Model surface field
+         & psurfmask                   ! Land-sea mask
+      LOGICAL, INTENT(IN) :: ldnightav ! Logical for averaging night-time data
+
       !! * Local declarations
       INTEGER :: ji
@@ -502,67 +1123,150 @@
       INTEGER :: jobs
       INTEGER :: inrc
-      INTEGER :: isla
+      INTEGER :: isurf
       INTEGER :: iobs
-      REAL(KIND=wp) :: zlam
-      REAL(KIND=wp) :: zphi
-      REAL(KIND=wp) :: zext(1), zobsmask(1)
-      REAL(kind=wp), DIMENSION(2,2,1) :: &
-         & zweig
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
-         & zmask, &
-         & zsshl, &
-         & zglam, &
-         & zgphi
+      INTEGER :: idayend
       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
          & igrdi, &
          & igrdj
+      INTEGER, DIMENSION(:,:), SAVE, ALLOCATABLE :: &
+         & icount_night,      &
+         & imask_night
+      REAL(wp) :: zlam
+      REAL(wp) :: zphi
+      REAL(wp), DIMENSION(1) :: zext, zobsmask
+      REAL(wp) :: zdaystp
+      REAL(wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask,  &
+         & zsurf,  &
+         & zsurfm, &
+         & zglam,  &
+         & zgphi
+      REAL(wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: &
+         & zintmp,  &
+         & zouttmp, &
+         & zmeanday    ! to compute model sst in region of 24h daylight (pole)
 
       !------------------------------------------------------------------------
       ! Local initialization 
       !------------------------------------------------------------------------
-      ! ... Record and data counters
+      ! Record and data counters
       inrc = kt - kit000 + 2
-      isla = sladatqc%nsstp(inrc)
+      isurf = surfdataqc%nsstp(inrc)
+
+      IF ( ldnightav ) THEN
+
+      ! Initialize array for night mean
+         IF ( kt == 0 ) THEN
+            ALLOCATE ( icount_night(kpi,kpj) )
+            ALLOCATE ( imask_night(kpi,kpj) )
+            ALLOCATE ( zintmp(kpi,kpj) )
+            ALLOCATE ( zouttmp(kpi,kpj) )
+            ALLOCATE ( zmeanday(kpi,kpj) )
+            nday_qsr = -1   ! initialisation flag for nbc_dcy
+         ENDIF
+
+         ! Night-time means are calculated for night-time values over timesteps:
+         !  [1 <= kt <= kdaystp], [kdaystp+1 <= kt <= 2*kdaystp], .....
+         idayend = MOD( kt - kit000 + 1, kdaystp )
+
+         ! Initialize night-time mean for first timestep of the day
+         IF ( idayend == 1 .OR. kt == 0 ) THEN
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  surfdataqc%vdmean(ji,jj) = 0.0
+                  zmeanday(ji,jj) = 0.0
+                  icount_night(ji,jj) = 0
+               END DO
+            END DO
+         ENDIF
+
+         zintmp(:,:) = 0.0
+         zouttmp(:,:) = sbc_dcy( zintmp(:,:), .TRUE. )
+         imask_night(:,:) = INT( zouttmp(:,:) )
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! Increment the temperature field for computing night mean and counter
+               surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj)  &
+                      &                    + psurf(ji,jj) * REAL( imask_night(ji,jj) )
+               zmeanday(ji,jj)          = zmeanday(ji,jj) + psurf(ji,jj)
+               icount_night(ji,jj)      = icount_night(ji,jj) + imask_night(ji,jj)
+            END DO
+         END DO
+
+         ! Compute the night-time mean at the end of the day
+         zdaystp = 1.0 / REAL( kdaystp )
+         IF ( idayend == 0 ) THEN
+            IF (lwp) WRITE(numout,*) 'Calculating surfdataqc%vdmean on time-step: ',kt
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! Test if "no night" point
+                  IF ( icount_night(ji,jj) > 0 ) THEN
+                     surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj) &
+                       &                        / REAL( icount_night(ji,jj) )
+                  ELSE
+                     !At locations where there is no night (e.g. poles),
+                     ! calculate daily mean instead of night-time mean.
+                     surfdataqc%vdmean(ji,jj) = zmeanday(ji,jj) * zdaystp
+                  ENDIF
+               END DO
+            END DO
+         ENDIF
+
+      ENDIF
 
       ! Get the data for interpolation
 
       ALLOCATE( &
-         & igrdi(2,2,isla), &
-         & igrdj(2,2,isla), &
-         & zglam(2,2,isla), &
-         & zgphi(2,2,isla), &
-         & zmask(2,2,isla), &
-         & zsshl(2,2,isla)  &
+         & igrdi(2,2,isurf), &
+         & igrdj(2,2,isurf), &
+         & zglam(2,2,isurf), &
+         & zgphi(2,2,isurf), &
+         & zmask(2,2,isurf), &
+         & zsurf(2,2,isurf)  &
          & )
-      
-      DO jobs = sladatqc%nsurfup + 1, sladatqc%nsurfup + isla
-         iobs = jobs - sladatqc%nsurfup
-         igrdi(1,1,iobs) = sladatqc%mi(jobs)-1
-         igrdj(1,1,iobs) = sladatqc%mj(jobs)-1
-         igrdi(1,2,iobs) = sladatqc%mi(jobs)-1
-         igrdj(1,2,iobs) = sladatqc%mj(jobs)
-         igrdi(2,1,iobs) = sladatqc%mi(jobs)
-         igrdj(2,1,iobs) = sladatqc%mj(jobs)-1
-         igrdi(2,2,iobs) = sladatqc%mi(jobs)
-         igrdj(2,2,iobs) = sladatqc%mj(jobs)
+
+      DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf
+         iobs = jobs - surfdataqc%nsurfup
+         igrdi(1,1,iobs) = surfdataqc%mi(jobs)-1
+         igrdj(1,1,iobs) = surfdataqc%mj(jobs)-1
+         igrdi(1,2,iobs) = surfdataqc%mi(jobs)-1
+         igrdj(1,2,iobs) = surfdataqc%mj(jobs)
+         igrdi(2,1,iobs) = surfdataqc%mi(jobs)
+         igrdj(2,1,iobs) = surfdataqc%mj(jobs)-1
+         igrdi(2,2,iobs) = surfdataqc%mi(jobs)
+         igrdj(2,2,iobs) = surfdataqc%mj(jobs)
       END DO
 
-      CALL obs_int_comm_2d( 2, 2, isla, &
+      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, &
          &                  igrdi, igrdj, glamt, zglam )
-      CALL obs_int_comm_2d( 2, 2, isla, &
+      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, &
          &                  igrdi, igrdj, gphit, zgphi )
-      CALL obs_int_comm_2d( 2, 2, isla, &
-         &                  igrdi, igrdj, psshmask, zmask )
-      CALL obs_int_comm_2d( 2, 2, isla, &
-         &                  igrdi, igrdj, psshn, zsshl )
+      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, &
+         &                  igrdi, igrdj, psurfmask, zmask )
+      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, &
+         &                  igrdi, igrdj, psurf, zsurf )
+
+      ! At the end of the day get interpolated means
+      IF ( idayend == 0 .AND. ldnightav ) THEN
+
+         ALLOCATE( &
+            & zsurfm(2,2,isurf)  &
+            & )
+
+         CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, igrdi, igrdj, &
+            &               surfdataqc%vdmean(:,:), zsurfm )
+
+      ENDIF
 
       ! Loop over observations
-
-      DO jobs = sladatqc%nsurfup + 1, sladatqc%nsurfup + isla
-
-         iobs = jobs - sladatqc%nsurfup
-
-         IF ( kt /= sladatqc%mstp(jobs) ) THEN
-            
+      DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf
+
+         iobs = jobs - surfdataqc%nsurfup
+
+         IF ( kt /= surfdataqc%mstp(jobs) ) THEN
+
             IF(lwp) THEN
                WRITE(numout,*)
@@ -574,27 +1278,34 @@
                WRITE(numout,*) ' Record  = ', jobs,                &
                   &            ' kt      = ', kt,                  &
-                  &            ' mstp    = ', sladatqc%mstp(jobs), &
-                  &            ' ntyp    = ', sladatqc%ntyp(jobs)
+                  &            ' mstp    = ', surfdataqc%mstp(jobs), &
+                  &            ' ntyp    = ', surfdataqc%ntyp(jobs)
             ENDIF
-            CALL ctl_stop( 'obs_sla_opt', 'Inconsistent time' )
-            
+            CALL ctl_stop( 'obs_surf_opt', 'Inconsistent time' )
+
          ENDIF
-         
-         zlam = sladatqc%rlam(jobs)
-         zphi = sladatqc%rphi(jobs)
-
-         ! Get weights to interpolate the model SSH to the observation point
+
+         zlam = surfdataqc%rlam(jobs)
+         zphi = surfdataqc%rphi(jobs)
+
+         ! Get weights to interpolate the model value to the observation point
          CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
             &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
             &                   zmask(:,:,iobs), zweig, zobsmask )
-         
-
-         ! Interpolate the model SSH to the observation point
-         CALL obs_int_h2d( 1, 1,      &
-            &              zweig, zsshl(:,:,iobs),  zext )
-         
-         sladatqc%rext(jobs,1) = zext(1)
-         ! ... Remove the MDT at the observation point
-         sladatqc%rmod(jobs,1) = sladatqc%rext(jobs,1) - sladatqc%rext(jobs,2)
+
+         ! Interpolate the model field to the observation point
+         IF ( ldnightav .AND. idayend == 0 ) THEN
+            ! Night-time averaged data
+            CALL obs_int_h2d( 1, 1, zweig, zsurfm(:,:,iobs), zext )
+         ELSE
+            CALL obs_int_h2d( 1, 1, zweig, zsurf(:,:,iobs),  zext )
+         ENDIF
+
+         IF ( TRIM(surfdataqc%cvars(1)) == 'SLA' .AND. surfdataqc%nextra == 2 ) THEN
+            ! ... Remove the MDT from the SSH at the observation point to get the SLA
+            surfdataqc%rext(jobs,1) = zext(1)
+            surfdataqc%rmod(jobs,1) = surfdataqc%rext(jobs,1) - surfdataqc%rext(jobs,2)
+         ELSE
+            surfdataqc%rmod(jobs,1) = zext(1)
+         ENDIF
 
       END DO
@@ -607,836 +1318,17 @@
          & zgphi, &
          & zmask, &
-         & zsshl  &
+         & zsurf  &
          & )
 
-      sladatqc%nsurfup = sladatqc%nsurfup + isla
-
-   END SUBROUTINE obs_sla_opt
-
-   SUBROUTINE obs_sst_opt( sstdatqc, kt, kpi, kpj, kit000, kdaystp, &
-      &                    psstn, psstmask, k2dint, ld_nightav )
-      !!-----------------------------------------------------------------------
-      !!
-      !!                     ***  ROUTINE obs_sst_opt  ***
-      !!
-      !! ** Purpose : Compute the model counterpart of surface temperature
-      !!              data by interpolating from the model grid to the 
-      !!              observation point.
-      !!
-      !! ** Method  : Linearly interpolate to each observation point using 
-      !!              the model values at the corners of the surrounding grid box.
-      !!
-      !!    The now model SST is first computed at the obs (lon, lat) point.
-      !!
-      !!    Several horizontal interpolation schemes are available:
-      !!        - distance-weighted (great circle) (k2dint = 0)
-      !!        - distance-weighted (small angle)  (k2dint = 1)
-      !!        - bilinear (geographical grid)     (k2dint = 2)
-      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
-      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
-      !!
-      !!
-      !! ** Action  :
-      !!
-      !! History :
-      !!        !  07-07  (S. Ricci ) : Original
-      !!      
-      !!-----------------------------------------------------------------------
-
-      !! * Modules used
-      USE obs_surf_def  ! Definition of storage space for surface observations
-      USE sbcdcy
-
-      IMPLICIT NONE
-
-      !! * Arguments
-      TYPE(obs_surf), INTENT(INOUT) :: &
-         & sstdatqc     ! Subset of surface data not failing screening
-      INTEGER, INTENT(IN) :: kt        ! Time step
-      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
-      INTEGER, INTENT(IN) :: kpj
-      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
-                                       !   (kit000-1 = restart time)
-      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
-      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day  
-      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
-         & psstn,  &    ! Model SST field
-         & psstmask     ! Land-sea mask
-
-      !! * Local declarations
-      INTEGER :: ji
-      INTEGER :: jj
-      INTEGER :: jobs
-      INTEGER :: inrc
-      INTEGER :: isst
-      INTEGER :: iobs
-      INTEGER :: idayend
-      REAL(KIND=wp) :: zlam
-      REAL(KIND=wp) :: zphi
-      REAL(KIND=wp) :: zext(1), zobsmask(1)
-      REAL(KIND=wp) :: zdaystp
-      INTEGER, DIMENSION(:,:), SAVE, ALLOCATABLE :: &
-         & icount_sstnight,      &
-         & imask_night
-      REAL(kind=wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: &
-         & zintmp, &
-         & zouttmp, & 
-         & zmeanday    ! to compute model sst in region of 24h daylight (pole)
-      REAL(kind=wp), DIMENSION(2,2,1) :: &
-         & zweig
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
-         & zmask, &
-         & zsstl, &
-         & zsstm, &
-         & zglam, &
-         & zgphi
-      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
-         & igrdi, &
-         & igrdj
-      LOGICAL, INTENT(IN) :: ld_nightav
-
-      !-----------------------------------------------------------------------
-      ! Local initialization 
-      !-----------------------------------------------------------------------
-      ! ... Record and data counters
-      inrc = kt - kit000 + 2
-      isst = sstdatqc%nsstp(inrc)
-
-      IF ( ld_nightav ) THEN
-
-      ! Initialize array for night mean
-
-      IF ( kt .EQ. 0 ) THEN
-         ALLOCATE ( icount_sstnight(kpi,kpj) )
-         ALLOCATE ( imask_night(kpi,kpj) )
-         ALLOCATE ( zintmp(kpi,kpj) )
-         ALLOCATE ( zouttmp(kpi,kpj) )
-         ALLOCATE ( zmeanday(kpi,kpj) )
-         nday_qsr = -1   ! initialisation flag for nbc_dcy
-      ENDIF
-
-      ! Initialize daily mean for first timestep
-      idayend = MOD( kt - kit000 + 1, kdaystp )
-
-      ! Added kt == 0 test to catch restart case 
-      IF ( idayend == 1 .OR. kt == 0) THEN
-         IF (lwp) WRITE(numout,*) 'Reset sstdatqc%vdmean on time-step: ',kt
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               sstdatqc%vdmean(ji,jj) = 0.0
-               zmeanday(ji,jj) = 0.0
-               icount_sstnight(ji,jj) = 0
-            END DO
-         END DO
-      ENDIF
-
-      zintmp(:,:) = 0.0
-      zouttmp(:,:) = sbc_dcy( zintmp(:,:), .TRUE. )
-      imask_night(:,:) = INT( zouttmp(:,:) )
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ! Increment the temperature field for computing night mean and counter
-            sstdatqc%vdmean(ji,jj) = sstdatqc%vdmean(ji,jj)  &
-                   &                        + psstn(ji,jj)*imask_night(ji,jj)
-            zmeanday(ji,jj)        = zmeanday(ji,jj) + psstn(ji,jj)
-            icount_sstnight(ji,jj) = icount_sstnight(ji,jj) + imask_night(ji,jj)
-         END DO
-      END DO
-   
-      ! Compute the daily mean at the end of day
-
-      zdaystp = 1.0 / REAL( kdaystp )
-
-      IF ( idayend == 0 ) THEN 
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! Test if "no night" point
-               IF ( icount_sstnight(ji,jj) .NE. 0 ) THEN
-                  sstdatqc%vdmean(ji,jj) = sstdatqc%vdmean(ji,jj) &
-                    &                        / icount_sstnight(ji,jj) 
-               ELSE
-                  sstdatqc%vdmean(ji,jj) = zmeanday(ji,jj) * zdaystp
-               ENDIF
-            END DO
-         END DO
-      ENDIF
-
-      ENDIF
-
-      ! Get the data for interpolation
-      
-      ALLOCATE( &
-         & igrdi(2,2,isst), &
-         & igrdj(2,2,isst), &
-         & zglam(2,2,isst), &
-         & zgphi(2,2,isst), &
-         & zmask(2,2,isst), &
-         & zsstl(2,2,isst)  &
-         & )
-      
-      DO jobs = sstdatqc%nsurfup + 1, sstdatqc%nsurfup + isst
-         iobs = jobs - sstdatqc%nsurfup
-         igrdi(1,1,iobs) = sstdatqc%mi(jobs)-1
-         igrdj(1,1,iobs) = sstdatqc%mj(jobs)-1
-         igrdi(1,2,iobs) = sstdatqc%mi(jobs)-1
-         igrdj(1,2,iobs) = sstdatqc%mj(jobs)
-         igrdi(2,1,iobs) = sstdatqc%mi(jobs)
-         igrdj(2,1,iobs) = sstdatqc%mj(jobs)-1
-         igrdi(2,2,iobs) = sstdatqc%mi(jobs)
-         igrdj(2,2,iobs) = sstdatqc%mj(jobs)
-      END DO
-      
-      CALL obs_int_comm_2d( 2, 2, isst, &
-         &                  igrdi, igrdj, glamt, zglam )
-      CALL obs_int_comm_2d( 2, 2, isst, &
-         &                  igrdi, igrdj, gphit, zgphi )
-      CALL obs_int_comm_2d( 2, 2, isst, &
-         &                  igrdi, igrdj, psstmask, zmask )
-      CALL obs_int_comm_2d( 2, 2, isst, &
-         &                  igrdi, igrdj, psstn, zsstl )
-
-      ! At the end of the day get interpolated means
-      IF ( idayend == 0 .AND. ld_nightav ) THEN
-
-         ALLOCATE( &
-            & zsstm(2,2,isst)  &
-            & )
-
-         CALL obs_int_comm_2d( 2, 2, isst, igrdi, igrdj, &
-            &               sstdatqc%vdmean(:,:), zsstm )
-
-      ENDIF
-
-      ! Loop over observations
-
-      DO jobs = sstdatqc%nsurfup + 1, sstdatqc%nsurfup + isst
-         
-         iobs = jobs - sstdatqc%nsurfup
-         
-         IF ( kt /= sstdatqc%mstp(jobs) ) THEN
-            
-            IF(lwp) THEN
-               WRITE(numout,*)
-               WRITE(numout,*) ' E R R O R : Observation',              &
-                  &            ' time step is not consistent with the', &
-                  &            ' model time step'
-               WRITE(numout,*) ' ========='
-               WRITE(numout,*)
-               WRITE(numout,*) ' Record  = ', jobs,                &
-                  &            ' kt      = ', kt,                  &
-                  &            ' mstp    = ', sstdatqc%mstp(jobs), &
-                  &            ' ntyp    = ', sstdatqc%ntyp(jobs)
-            ENDIF
-            CALL ctl_stop( 'obs_sst_opt', 'Inconsistent time' )
-            
-         ENDIF
-         
-         zlam = sstdatqc%rlam(jobs)
-         zphi = sstdatqc%rphi(jobs)
-         
-         ! Get weights to interpolate the model SST to the observation point
-         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
-            &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
-            &                   zmask(:,:,iobs), zweig, zobsmask )
-            
-         ! Interpolate the model SST to the observation point 
-
-         IF ( ld_nightav ) THEN
-
-           IF ( idayend == 0 )  THEN
-               ! Daily averaged/diurnal cycle of SST  data
-               CALL obs_int_h2d( 1, 1,      & 
-                     &              zweig, zsstm(:,:,iobs), zext )
-            ELSE 
-               CALL ctl_stop( ' ld_nightav is set to true: a nonzero' //     &
-                     &           ' number of night SST data should' // &
-                     &           ' only occur at the end of a given day' )
-            ENDIF
-
-         ELSE
-
-            CALL obs_int_h2d( 1, 1,      &
-            &              zweig, zsstl(:,:,iobs),  zext )
-
-         ENDIF
-         sstdatqc%rmod(jobs,1) = zext(1)
-         
-      END DO
-      
-      ! Deallocate the data for interpolation
-      DEALLOCATE( &
-         & igrdi, &
-         & igrdj, &
-         & zglam, &
-         & zgphi, &
-         & zmask, &
-         & zsstl  &
-         & )
-
-      ! At the end of the day also get interpolated means
-      IF ( idayend == 0 .AND. ld_nightav ) THEN
+      ! At the end of the day also deallocate night-time mean array
+      IF ( idayend == 0 .AND. ldnightav ) THEN
          DEALLOCATE( &
-            & zsstm  &
+            & zsurfm  &
             & )
       ENDIF
-      
-      sstdatqc%nsurfup = sstdatqc%nsurfup + isst
-
-   END SUBROUTINE obs_sst_opt
-
-   SUBROUTINE obs_sss_opt
-      !!-----------------------------------------------------------------------
-      !!
-      !!                     ***  ROUTINE obs_sss_opt  ***
-      !!
-      !! ** Purpose : Compute the model counterpart of sea surface salinity
-      !!              data by interpolating from the model grid to the 
-      !!              observation point.
-      !!
-      !! ** Method  : 
-      !!
-      !! ** Action  :
-      !!
-      !! History :
-      !!      ! ??-?? 
-      !!-----------------------------------------------------------------------
-
-      IMPLICIT NONE
-
-   END SUBROUTINE obs_sss_opt
-
-   SUBROUTINE obs_seaice_opt( seaicedatqc, kt, kpi, kpj, kit000, &
-      &                    pseaicen, pseaicemask, k2dint )
-
-      !!-----------------------------------------------------------------------
-      !!
-      !!                     ***  ROUTINE obs_seaice_opt  ***
-      !!
-      !! ** Purpose : Compute the model counterpart of surface temperature
-      !!              data by interpolating from the model grid to the 
-      !!              observation point.
-      !!
-      !! ** Method  : Linearly interpolate to each observation point using 
-      !!              the model values at the corners of the surrounding grid box.
-      !!
-      !!    The now model sea ice is first computed at the obs (lon, lat) point.
-      !!
-      !!    Several horizontal interpolation schemes are available:
-      !!        - distance-weighted (great circle) (k2dint = 0)
-      !!        - distance-weighted (small angle)  (k2dint = 1)
-      !!        - bilinear (geographical grid)     (k2dint = 2)
-      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
-      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
-      !!
-      !!
-      !! ** Action  :
-      !!
-      !! History :
-      !!        !  07-07  (S. Ricci ) : Original
-      !!      
-      !!-----------------------------------------------------------------------
-
-      !! * Modules used
-      USE obs_surf_def  ! Definition of storage space for surface observations
-
-      IMPLICIT NONE
-
-      !! * Arguments
-      TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc     ! Subset of surface data not failing screening
-      INTEGER, INTENT(IN) :: kt       ! Time step
-      INTEGER, INTENT(IN) :: kpi      ! Model grid parameters
-      INTEGER, INTENT(IN) :: kpj
-      INTEGER, INTENT(IN) :: kit000   ! Number of the first time step 
-                                      !   (kit000-1 = restart time)
-      INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header)
-      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
-         & pseaicen,  &    ! Model sea ice field
-         & pseaicemask     ! Land-sea mask
-         
-      !! * Local declarations
-      INTEGER :: ji
-      INTEGER :: jj
-      INTEGER :: jobs
-      INTEGER :: inrc
-      INTEGER :: iseaice
-      INTEGER :: iobs
-       
-      REAL(KIND=wp) :: zlam
-      REAL(KIND=wp) :: zphi
-      REAL(KIND=wp) :: zext(1), zobsmask(1)
-      REAL(kind=wp), DIMENSION(2,2,1) :: &
-         & zweig
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
-         & zmask, &
-         & zseaicel, &
-         & zglam, &
-         & zgphi
-      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
-         & igrdi, &
-         & igrdj
-
-      !------------------------------------------------------------------------
-      ! Local initialization 
-      !------------------------------------------------------------------------
-      ! ... Record and data counters
-      inrc = kt - kit000 + 2
-      iseaice = seaicedatqc%nsstp(inrc)
-
-      ! Get the data for interpolation
-      
-      ALLOCATE( &
-         & igrdi(2,2,iseaice), &
-         & igrdj(2,2,iseaice), &
-         & zglam(2,2,iseaice), &
-         & zgphi(2,2,iseaice), &
-         & zmask(2,2,iseaice), &
-         & zseaicel(2,2,iseaice)  &
-         & )
-      
-      DO jobs = seaicedatqc%nsurfup + 1, seaicedatqc%nsurfup + iseaice
-         iobs = jobs - seaicedatqc%nsurfup
-         igrdi(1,1,iobs) = seaicedatqc%mi(jobs)-1
-         igrdj(1,1,iobs) = seaicedatqc%mj(jobs)-1
-         igrdi(1,2,iobs) = seaicedatqc%mi(jobs)-1
-         igrdj(1,2,iobs) = seaicedatqc%mj(jobs)
-         igrdi(2,1,iobs) = seaicedatqc%mi(jobs)
-         igrdj(2,1,iobs) = seaicedatqc%mj(jobs)-1
-         igrdi(2,2,iobs) = seaicedatqc%mi(jobs)
-         igrdj(2,2,iobs) = seaicedatqc%mj(jobs)
-      END DO
-      
-      CALL obs_int_comm_2d( 2, 2, iseaice, &
-         &                  igrdi, igrdj, glamt, zglam )
-      CALL obs_int_comm_2d( 2, 2, iseaice, &
-         &                  igrdi, igrdj, gphit, zgphi )
-      CALL obs_int_comm_2d( 2, 2, iseaice, &
-         &                  igrdi, igrdj, pseaicemask, zmask )
-      CALL obs_int_comm_2d( 2, 2, iseaice, &
-         &                  igrdi, igrdj, pseaicen, zseaicel )
-      
-      DO jobs = seaicedatqc%nsurfup + 1, seaicedatqc%nsurfup + iseaice
-         
-         iobs = jobs - seaicedatqc%nsurfup
-         
-         IF ( kt /= seaicedatqc%mstp(jobs) ) THEN
-            
-            IF(lwp) THEN
-               WRITE(numout,*)
-               WRITE(numout,*) ' E R R O R : Observation',              &
-                  &            ' time step is not consistent with the', &
-                  &            ' model time step'
-               WRITE(numout,*) ' ========='
-               WRITE(numout,*)
-               WRITE(numout,*) ' Record  = ', jobs,                &
-                  &            ' kt      = ', kt,                  &
-                  &            ' mstp    = ', seaicedatqc%mstp(jobs), &
-                  &            ' ntyp    = ', seaicedatqc%ntyp(jobs)
-            ENDIF
-            CALL ctl_stop( 'obs_seaice_opt', 'Inconsistent time' )
-            
-         ENDIF
-         
-         zlam = seaicedatqc%rlam(jobs)
-         zphi = seaicedatqc%rphi(jobs)
-         
-         ! Get weights to interpolate the model sea ice to the observation point
-         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
-            &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
-            &                   zmask(:,:,iobs), zweig, zobsmask )
-         
-         ! ... Interpolate the model sea ice to the observation point
-         CALL obs_int_h2d( 1, 1,      &
-            &              zweig, zseaicel(:,:,iobs),  zext )
-         
-         seaicedatqc%rmod(jobs,1) = zext(1)
-         
-      END DO
-      
-      ! Deallocate the data for interpolation
-      DEALLOCATE( &
-         & igrdi,    &
-         & igrdj,    &
-         & zglam,    &
-         & zgphi,    &
-         & zmask,    &
-         & zseaicel  &
-         & )
-      
-      seaicedatqc%nsurfup = seaicedatqc%nsurfup + iseaice
-
-   END SUBROUTINE obs_seaice_opt
-
-   SUBROUTINE obs_vel_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, &
-      &                    pun, pvn, pgdept, pumask, pvmask, k1dint, k2dint, &
-      &                    ld_dailyav )
-      !!-----------------------------------------------------------------------
-      !!
-      !!                     ***  ROUTINE obs_vel_opt  ***
-      !!
-      !! ** Purpose : Compute the model counterpart of velocity profile
-      !!              data by interpolating from the model grid to the 
-      !!              observation point.
-      !!
-      !! ** Method  : Linearly interpolate zonal and meridional components of velocity 
-      !!              to each observation point using the model values at the corners of 
-      !!              the surrounding grid box. The model velocity components are on a 
-      !!              staggered C- grid.
-      !!
-      !!    For velocity data from the TAO array, the model equivalent is
-      !!    a daily mean velocity field. So, we first compute
-      !!    the mean, then interpolate only at the end of the day.
-      !!
-      !! ** Action  :
-      !!
-      !! History :
-      !!    ! 07-03 (K. Mogensen)      : Temperature and Salinity profiles
-      !!    ! 08-10 (Maria Valdivieso) : Velocity component (U,V) profiles
-      !!-----------------------------------------------------------------------
-    
-      !! * Modules used
-      USE obs_profiles_def ! Definition of storage space for profile obs.
-
-      IMPLICIT NONE
-
-      !! * Arguments
-      TYPE(obs_prof), INTENT(INOUT) :: &
-         & prodatqc        ! Subset of profile data not failing screening
-      INTEGER, INTENT(IN) :: kt        ! Time step
-      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
-      INTEGER, INTENT(IN) :: kpj
-      INTEGER, INTENT(IN) :: kpk 
-      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
-                                       !   (kit000-1 = restart time)
-      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header)
-      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
-      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                    
-      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
-         & pun,    &    ! Model zonal component of velocity
-         & pvn,    &    ! Model meridional component of velocity
-         & pumask, &    ! Land-sea mask
-         & pvmask       ! Land-sea mask
-      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
-         & pgdept       ! Model array of depth levels
-      LOGICAL, INTENT(IN) :: ld_dailyav
-         
-      !! * Local declarations
-      INTEGER :: ji
-      INTEGER :: jj
-      INTEGER :: jk
-      INTEGER :: jobs
-      INTEGER :: inrc
-      INTEGER :: ipro
-      INTEGER :: idayend
-      INTEGER :: ista
-      INTEGER :: iend
-      INTEGER :: iobs
-      INTEGER, DIMENSION(imaxavtypes) :: &
-         & idailyavtypes
-      REAL(KIND=wp) :: zlam
-      REAL(KIND=wp) :: zphi
-      REAL(KIND=wp) :: zdaystp
-      REAL(KIND=wp), DIMENSION(kpk) :: &
-         & zobsmasku, &
-         & zobsmaskv, &
-         & zobsmask,  &
-         & zobsk,     &
-         & zobs2k
-      REAL(KIND=wp), DIMENSION(2,2,kpk) :: &
-         & zweigu,zweigv
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: &
-         & zumask, zvmask, &
-         & zintu, &
-         & zintv, &
-         & zinmu, &
-         & zinmv
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
-         & zglamu, zglamv, &
-         & zgphiu, zgphiv
-      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
-         & igrdiu, &
-         & igrdju, &
-         & igrdiv, &
-         & igrdjv
-
-      !------------------------------------------------------------------------
-      ! Local initialization 
-      !------------------------------------------------------------------------
-      ! ... Record and data counters
-      inrc = kt - kit000 + 2
-      ipro = prodatqc%npstp(inrc)
-
-      ! Initialize daily mean for first timestep
-      idayend = MOD( kt - kit000 + 1, kdaystp )
-
-      ! Added kt == 0 test to catch restart case 
-      IF ( idayend == 1 .OR. kt == 0) THEN
-         IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt
-         prodatqc%vdmean(:,:,:,1) = 0.0
-         prodatqc%vdmean(:,:,:,2) = 0.0
-      ENDIF
-
-      ! Increment the zonal velocity field for computing daily mean
-      prodatqc%vdmean(:,:,:,1) = prodatqc%vdmean(:,:,:,1) + pun(:,:,:)
-      ! Increment the meridional velocity field for computing daily mean
-      prodatqc%vdmean(:,:,:,2) = prodatqc%vdmean(:,:,:,2) + pvn(:,:,:)
-   
-      ! Compute the daily mean at the end of day
-      zdaystp = 1.0 / REAL( kdaystp )
-      IF ( idayend == 0 ) THEN
-         prodatqc%vdmean(:,:,:,1) = prodatqc%vdmean(:,:,:,1) * zdaystp
-         prodatqc%vdmean(:,:,:,2) = prodatqc%vdmean(:,:,:,2) * zdaystp
-      ENDIF
-
-      ! Get the data for interpolation
-      ALLOCATE( &
-         & igrdiu(2,2,ipro),      &
-         & igrdju(2,2,ipro),      &
-         & igrdiv(2,2,ipro),      &
-         & igrdjv(2,2,ipro),      &
-         & zglamu(2,2,ipro), zglamv(2,2,ipro), &
-         & zgphiu(2,2,ipro), zgphiv(2,2,ipro), &
-         & zumask(2,2,kpk,ipro), zvmask(2,2,kpk,ipro), &
-         & zintu(2,2,kpk,ipro),  &
-         & zintv(2,2,kpk,ipro)   &
-         & )
-
-      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
-         iobs = jobs - prodatqc%nprofup
-         igrdiu(1,1,iobs) = prodatqc%mi(jobs,1)-1
-         igrdju(1,1,iobs) = prodatqc%mj(jobs,1)-1
-         igrdiu(1,2,iobs) = prodatqc%mi(jobs,1)-1
-         igrdju(1,2,iobs) = prodatqc%mj(jobs,1)
-         igrdiu(2,1,iobs) = prodatqc%mi(jobs,1)
-         igrdju(2,1,iobs) = prodatqc%mj(jobs,1)-1
-         igrdiu(2,2,iobs) = prodatqc%mi(jobs,1)
-         igrdju(2,2,iobs) = prodatqc%mj(jobs,1)
-         igrdiv(1,1,iobs) = prodatqc%mi(jobs,2)-1
-         igrdjv(1,1,iobs) = prodatqc%mj(jobs,2)-1
-         igrdiv(1,2,iobs) = prodatqc%mi(jobs,2)-1
-         igrdjv(1,2,iobs) = prodatqc%mj(jobs,2)
-         igrdiv(2,1,iobs) = prodatqc%mi(jobs,2)
-         igrdjv(2,1,iobs) = prodatqc%mj(jobs,2)-1
-         igrdiv(2,2,iobs) = prodatqc%mi(jobs,2)
-         igrdjv(2,2,iobs) = prodatqc%mj(jobs,2)
-      END DO
-
-      CALL obs_int_comm_2d( 2, 2, ipro, igrdiu, igrdju, glamu, zglamu )
-      CALL obs_int_comm_2d( 2, 2, ipro, igrdiu, igrdju, gphiu, zgphiu )
-      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, pumask, zumask )
-      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, pun, zintu )
-
-      CALL obs_int_comm_2d( 2, 2, ipro, igrdiv, igrdjv, glamv, zglamv )
-      CALL obs_int_comm_2d( 2, 2, ipro, igrdiv, igrdjv, gphiv, zgphiv )
-      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, pvmask, zvmask )
-      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, pvn, zintv )
-
-      ! At the end of the day also get interpolated means
-      IF ( idayend == 0 ) THEN
-
-         ALLOCATE( &
-            & zinmu(2,2,kpk,ipro),  &
-            & zinmv(2,2,kpk,ipro)   &
-            & )
-
-         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, &
-            &                  prodatqc%vdmean(:,:,:,1), zinmu )
-         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, &
-            &                  prodatqc%vdmean(:,:,:,2), zinmv )
-
-      ENDIF
-
-! loop over observations
-
-      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
-
-         iobs = jobs - prodatqc%nprofup
-
-         IF ( kt /= prodatqc%mstp(jobs) ) THEN
-            
-            IF(lwp) THEN
-               WRITE(numout,*)
-               WRITE(numout,*) ' E R R O R : Observation',              &
-                  &            ' time step is not consistent with the', &
-                  &            ' model time step'
-               WRITE(numout,*) ' ========='
-               WRITE(numout,*)
-               WRITE(numout,*) ' Record  = ', jobs,                    &
-                  &            ' kt      = ', kt,                      &
-                  &            ' mstp    = ', prodatqc%mstp(jobs), &
-                  &            ' ntyp    = ', prodatqc%ntyp(jobs)
-            ENDIF
-            CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' )
-         ENDIF
-         
-         zlam = prodatqc%rlam(jobs)
-         zphi = prodatqc%rphi(jobs)
-
-         ! Initialize observation masks
-
-         zobsmasku(:) = 0.0
-         zobsmaskv(:) = 0.0
-         
-         ! Horizontal weights and vertical mask
-
-         IF  ( prodatqc%npvend(jobs,1) > 0 ) THEN
-
-            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
-               &                   zglamu(:,:,iobs), zgphiu(:,:,iobs), &
-               &                   zumask(:,:,:,iobs), zweigu, zobsmasku )
-
-         ENDIF
-
-         
-         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
-
-            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
-               &                   zglamv(:,:,iobs), zgphiv(:,:,iobs), &
-               &                   zvmask(:,:,:,iobs), zweigv, zobsmasku )
-
-         ENDIF
-
-         ! Ensure that the vertical mask on u and v are consistent.
-
-         zobsmask(:) = MIN( zobsmasku(:), zobsmaskv(:) )
-
-         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN
-
-            zobsk(:) = obfillflt
-
-	    IF ( ld_dailyav ) THEN
-
-               IF ( idayend == 0 )  THEN
-                  
-                  ! Daily averaged data
-                  
-                  CALL obs_int_h2d( kpk, kpk,      &
-                     &              zweigu, zinmu(:,:,:,iobs), zobsk )
-                  
-                  
-               ELSE
-               
-                  CALL ctl_stop( ' A nonzero' //     &
-                     &           ' number of U profile data should' // &
-                     &           ' only occur at the end of a given day' )
-
-               ENDIF
-	       
-            ELSE 
-               
-               ! Point data
-
-               CALL obs_int_h2d( kpk, kpk,      &
-                  &              zweigu, zintu(:,:,:,iobs), zobsk )
-
-            ENDIF
-
-            !-------------------------------------------------------------
-            ! Compute vertical second-derivative of the interpolating 
-            ! polynomial at obs points
-            !-------------------------------------------------------------
-            
-            IF ( k1dint == 1 ) THEN
-               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   &
-                  &                  pgdept, zobsmask )
-            ENDIF
-            
-            !-----------------------------------------------------------------
-            !  Vertical interpolation to the observation point
-            !-----------------------------------------------------------------
-            ista = prodatqc%npvsta(jobs,1)
-            iend = prodatqc%npvend(jobs,1)
-            CALL obs_int_z1d( kpk,                &
-               & prodatqc%var(1)%mvk(ista:iend),  &
-               & k1dint, iend - ista + 1,         &
-               & prodatqc%var(1)%vdep(ista:iend), &
-               & zobsk, zobs2k,                   &
-               & prodatqc%var(1)%vmod(ista:iend), &
-               & pgdept, zobsmask )
-
-         ENDIF
-
-         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
-
-            zobsk(:) = obfillflt
-
-            IF ( ld_dailyav ) THEN
-
-               IF ( idayend == 0 )  THEN
-
-                  ! Daily averaged data
-                  
-                  CALL obs_int_h2d( kpk, kpk,      &
-                     &              zweigv, zinmv(:,:,:,iobs), zobsk )
-                  
-               ELSE
-
-                  CALL ctl_stop( ' A nonzero' //     &
-                     &           ' number of V profile data should' // &
-                     &           ' only occur at the end of a given day' )
-
-               ENDIF
-
-            ELSE
-               
-               ! Point data
-
-               CALL obs_int_h2d( kpk, kpk,      &
-                  &              zweigv, zintv(:,:,:,iobs), zobsk )
-
-            ENDIF
-
-
-            !-------------------------------------------------------------
-            ! Compute vertical second-derivative of the interpolating 
-            ! polynomial at obs points
-            !-------------------------------------------------------------
-            
-            IF ( k1dint == 1 ) THEN
-               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, &
-                  &                  pgdept, zobsmask )
-            ENDIF
-            
-            !----------------------------------------------------------------
-            !  Vertical interpolation to the observation point
-            !----------------------------------------------------------------
-            ista = prodatqc%npvsta(jobs,2)
-            iend = prodatqc%npvend(jobs,2)
-            CALL obs_int_z1d( kpk, &
-               & prodatqc%var(2)%mvk(ista:iend),&
-               & k1dint, iend - ista + 1, &
-               & prodatqc%var(2)%vdep(ista:iend),&
-               & zobsk, zobs2k, &
-               & prodatqc%var(2)%vmod(ista:iend),&
-               & pgdept, zobsmask )
-
-         ENDIF
-
-      END DO
- 
-      ! Deallocate the data for interpolation
-      DEALLOCATE( &
-         & igrdiu, &
-         & igrdju, &
-         & igrdiv, &
-         & igrdjv, &
-         & zglamu, zglamv, &
-         & zgphiu, zgphiv, &
-         & zumask, zvmask, &
-         & zintu, &
-         & zintv  &
-         & )
-      ! At the end of the day also get interpolated means
-      IF ( idayend == 0 ) THEN
-         DEALLOCATE( &
-            & zinmu,  &
-            & zinmv   &
-            & )
-      ENDIF
-
-      prodatqc%nprofup = prodatqc%nprofup + ipro 
-      
-   END SUBROUTINE obs_vel_opt
+
+      surfdataqc%nsurfup = surfdataqc%nsurfup + isurf
+
+   END SUBROUTINE obs_surf_opt
 
 END MODULE obs_oper
-
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 6808)
@@ -7,12 +7,9 @@
 
    !!---------------------------------------------------------------------
-   !!   obs_pre_pro  : First level check and screening of T/S profiles
-   !!   obs_pre_sla  : First level check and screening of SLA observations
-   !!   obs_pre_sst  : First level check and screening of SLA observations
-   !!   obs_pre_seaice : First level check and screening of sea ice observations
-   !!   obs_pre_vel  : First level check and screening of velocity obs.
-   !!   obs_scr      : Basic screening of the observations
-   !!   obs_coo_tim  : Compute number of time steps to the observation time
-   !!   obs_sor      : Sort the observation arrays
+   !!   obs_pre_prof  : First level check and screening of profile observations
+   !!   obs_pre_surf  : First level check and screening of surface observations
+   !!   obs_scr       : Basic screening of the observations
+   !!   obs_coo_tim   : Compute number of time steps to the observation time
+   !!   obs_sor       : Sort the observation arrays
    !!---------------------------------------------------------------------
    !! * Modules used
@@ -36,10 +33,7 @@
 
    PUBLIC &
-      & obs_pre_pro, &    ! First level check and screening of profiles
-      & obs_pre_sla, &    ! First level check and screening of SLA data
-      & obs_pre_sst, &    ! First level check and screening of SLA data
-      & obs_pre_seaice, & ! First level check and screening of sea ice data
-      & obs_pre_vel, &     ! First level check and screening of velocity profiles
-      & calc_month_len     ! Calculate the number of days in the months of a year  
+      & obs_pre_prof, &    ! First level check and screening of profile obs
+      & obs_pre_surf, &    ! First level check and screening of surface obs
+      & calc_month_len     ! Calculate the number of days in the months of a year
 
    !!----------------------------------------------------------------------
@@ -49,299 +43,14 @@
    !!----------------------------------------------------------------------
 
+
 CONTAINS
 
-   SUBROUTINE obs_pre_pro( profdata, prodatqc, ld_t3d, ld_s3d, ld_nea, &
-      &                    kdailyavtypes )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE obs_pre_pro  ***
-      !!
-      !! ** Purpose : First level check and screening of T and S profiles
-      !!
-      !! ** Method  : First level check and screening of T and S profiles
-      !!
-      !! ** Action  : 
-      !!
-      !! References :
-      !!   
-      !! History :
-      !!        !  2007-01  (K. Mogensen) Merge of obs_pre_t3d and obs_pre_s3d 
-      !!        !  2007-03  (K. Mogensen) General handling of profiles
-      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE domstp              ! Domain: set the time-step
-      USE par_oce             ! Ocean parameters
-      USE dom_oce, ONLY : &   ! Geographical information
-         & glamt,   &
-         & gphit,   &
-         & gdept_1d,&
-         & tmask,   &
-         & nproc
-      !! * Arguments
-      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data
-      TYPE(obs_prof), INTENT(INOUT) :: prodatqc     ! Subset of profile data not failing screening
-      LOGICAL, INTENT(IN) :: ld_t3d         ! Switch for temperature
-      LOGICAL, INTENT(IN) :: ld_s3d         ! Switch for salinity
-      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land
-      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
-         & kdailyavtypes! Types for daily averages
-      !! * Local declarations   
-      INTEGER :: iyea0         ! Initial date
-      INTEGER :: imon0         !  - (year, month, day, hour, minute)
-      INTEGER :: iday0   
-      INTEGER :: ihou0
-      INTEGER :: imin0
-      INTEGER :: icycle        ! Current assimilation cycle
-                               ! Counters for observations that
-      INTEGER :: iotdobs       !  - outside time domain
-      INTEGER :: iosdtobs      !  - outside space domain (temperature)
-      INTEGER :: iosdsobs      !  - outside space domain (salinity)
-      INTEGER :: ilantobs      !  - within a model land cell (temperature)
-      INTEGER :: ilansobs      !  - within a model land cell (salinity)
-      INTEGER :: inlatobs      !  - close to land (temperature)
-      INTEGER :: inlasobs      !  - close to land (salinity)
-      INTEGER :: igrdobs       !  - fail the grid search
-                               ! Global counters for observations that
-      INTEGER :: iotdobsmpp    !  - outside time domain
-      INTEGER :: iosdtobsmpp   !  - outside space domain (temperature)
-      INTEGER :: iosdsobsmpp   !  - outside space domain (salinity)
-      INTEGER :: ilantobsmpp   !  - within a model land cell (temperature)
-      INTEGER :: ilansobsmpp   !  - within a model land cell (salinity)
-      INTEGER :: inlatobsmpp   !  - close to land (temperature)
-      INTEGER :: inlasobsmpp   !  - close to land (salinity)
-      INTEGER :: igrdobsmpp    !  - fail the grid search
-      TYPE(obs_prof_valid) ::  llvalid     ! Profile selection 
-      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: &
-         & llvvalid            ! T,S selection 
-      INTEGER :: jvar          ! Variable loop variable
-      INTEGER :: jobs          ! Obs. loop variable
-      INTEGER :: jstp          ! Time loop variable
-      INTEGER :: inrc          ! Time index variable
-      
-      IF(lwp) WRITE(numout,*)'obs_pre_pro : Preparing the profile observations...'
-
-      ! Initial date initialization (year, month, day, hour, minute)
-      iyea0 =   ndate0 / 10000
-      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
-      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
-      ihou0 = 0
-      imin0 = 0
-
-      icycle = no     ! Assimilation cycle
-
-      ! Diagnotics counters for various failures.
-
-      iotdobs  = 0
-      igrdobs  = 0
-      iosdtobs = 0
-      iosdsobs = 0
-      ilantobs = 0
-      ilansobs = 0
-      inlatobs = 0
-      inlasobs = 0
-
-      ! -----------------------------------------------------------------------
-      ! Find time coordinate for profiles
-      ! -----------------------------------------------------------------------
-
-      IF ( PRESENT(kdailyavtypes) ) THEN
-         CALL obs_coo_tim_prof( icycle, &
-            &                iyea0,   imon0,   iday0,   ihou0,   imin0,      &
-            &                profdata%nprof,   profdata%nyea, profdata%nmon, &
-            &                profdata%nday,    profdata%nhou, profdata%nmin, &
-            &                profdata%ntyp,    profdata%nqc,  profdata%mstp, &
-            &                iotdobs, kdailyavtypes = kdailyavtypes        )
-      ELSE
-         CALL obs_coo_tim_prof( icycle, &
-            &                iyea0,   imon0,   iday0,   ihou0,   imin0,      &
-            &                profdata%nprof,   profdata%nyea, profdata%nmon, &
-            &                profdata%nday,    profdata%nhou, profdata%nmin, &
-            &                profdata%ntyp,    profdata%nqc,  profdata%mstp, &
-            &                iotdobs )
-      ENDIF
-      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
-      
-      ! -----------------------------------------------------------------------
-      ! Check for profiles failing the grid search
-      ! -----------------------------------------------------------------------
-
-      CALL obs_coo_grd( profdata%nprof,   profdata%mi, profdata%mj, &
-         &              profdata%nqc,     igrdobs                         )
-
-      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
-
-      ! -----------------------------------------------------------------------
-      ! Reject all observations for profiles with nqc > 10
-      ! -----------------------------------------------------------------------
-
-      CALL obs_pro_rej( profdata )
-
-      ! -----------------------------------------------------------------------
-      ! Check for land points. This includes points below the model
-      ! bathymetry so this is done for every point in the profile
-      ! -----------------------------------------------------------------------
-
-      ! Temperature
-
-      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   &
-         &                 profdata%npvsta(:,1),  profdata%npvend(:,1), &
-         &                 jpi,                   jpj,                  &
-         &                 jpk,                                         &
-         &                 profdata%mi,           profdata%mj,          & 
-         &                 profdata%var(1)%mvk,                         &
-         &                 profdata%rlam,         profdata%rphi,        &
-         &                 profdata%var(1)%vdep,                        &
-         &                 glamt,                 gphit,                &
-         &                 gdept_1d,              tmask,                &
-         &                 profdata%nqc,          profdata%var(1)%nvqc, &
-         &                 iosdtobs,              ilantobs,             &
-         &                 inlatobs,              ld_nea                )
-
-      CALL obs_mpp_sum_integer( iosdtobs, iosdtobsmpp )
-      CALL obs_mpp_sum_integer( ilantobs, ilantobsmpp )
-      CALL obs_mpp_sum_integer( inlatobs, inlatobsmpp )
-
-      ! Salinity
-
-      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   &
-         &                 profdata%npvsta(:,2),  profdata%npvend(:,2), &
-         &                 jpi,                   jpj,                  &
-         &                 jpk,                                         &
-         &                 profdata%mi,           profdata%mj,          & 
-         &                 profdata%var(2)%mvk,                         &
-         &                 profdata%rlam,         profdata%rphi,        &
-         &                 profdata%var(2)%vdep,                        &
-         &                 glamt,                 gphit,                &
-         &                 gdept_1d,              tmask,                &
-         &                 profdata%nqc,          profdata%var(2)%nvqc, &
-         &                 iosdsobs,              ilansobs,             &
-         &                 inlasobs,              ld_nea                )
-
-      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
-      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
-      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
-
-      ! -----------------------------------------------------------------------
-      ! Copy useful data from the profdata data structure to
-      ! the prodatqc data structure 
-      ! -----------------------------------------------------------------------
-
-      ! Allocate the selection arrays
-
-      ALLOCATE( llvalid%luse(profdata%nprof) )
-      DO jvar = 1,profdata%nvar
-         ALLOCATE( llvvalid(jvar)%luse(profdata%nvprot(jvar)) )
-      END DO
-
-      ! We want all data which has qc flags <= 10
-
-      llvalid%luse(:) = ( profdata%nqc(:)  <= 10 )
-      DO jvar = 1,profdata%nvar
-         llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10 )
-      END DO
-
-      ! The actual copying
-
-      CALL obs_prof_compress( profdata,     prodatqc,       .TRUE.,  numout, &
-         &                    lvalid=llvalid, lvvalid=llvvalid )
-
-      ! Dellocate the selection arrays
-      DEALLOCATE( llvalid%luse )
-      DO jvar = 1,profdata%nvar
-         DEALLOCATE( llvvalid(jvar)%luse )
-      END DO
-
-      ! -----------------------------------------------------------------------
-      ! Print information about what observations are left after qc
-      ! -----------------------------------------------------------------------
-
-      ! Update the total observation counter array
-      
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'obs_pre_pro :'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*)
-         WRITE(numout,*) ' Profiles outside time domain                = ', &
-            &            iotdobsmpp
-         WRITE(numout,*) ' Remaining profiles that failed grid search  = ', &
-            &            igrdobsmpp
-         WRITE(numout,*) ' Remaining T data outside space domain       = ', &
-            &            iosdtobsmpp
-         WRITE(numout,*) ' Remaining T data at land points             = ', &
-            &            ilantobsmpp
-         IF (ld_nea) THEN
-            WRITE(numout,*) ' Remaining T data near land points (removed) = ',&
-               &            inlatobsmpp
-         ELSE
-            WRITE(numout,*) ' Remaining T data near land points (kept)    = ',&
-               &            inlatobsmpp
-         ENDIF
-         WRITE(numout,*) ' T data accepted                             = ', &
-            &            prodatqc%nvprotmpp(1)
-         WRITE(numout,*) ' Remaining S data outside space domain       = ', &
-            &            iosdsobsmpp
-         WRITE(numout,*) ' Remaining S data at land points             = ', &
-            &            ilansobsmpp
-         IF (ld_nea) THEN
-            WRITE(numout,*) ' Remaining S data near land points (removed) = ',&
-               &            inlasobsmpp
-         ELSE
-            WRITE(numout,*) ' Remaining S data near land points (kept)    = ',&
-               &            inlasobsmpp
-         ENDIF
-         WRITE(numout,*) ' S data accepted                             = ', &
-            &            prodatqc%nvprotmpp(2)
-
-         WRITE(numout,*)
-         WRITE(numout,*) ' Number of observations per time step :'
-         WRITE(numout,*)
-         WRITE(numout,997)
-         WRITE(numout,998)
-      ENDIF
-      
-      DO jobs = 1, prodatqc%nprof
-         inrc = prodatqc%mstp(jobs) + 2 - nit000
-         prodatqc%npstp(inrc)  = prodatqc%npstp(inrc) + 1
-         DO jvar = 1, prodatqc%nvar
-            IF ( prodatqc%npvend(jobs,jvar) > 0 ) THEN
-               prodatqc%nvstp(inrc,jvar) = prodatqc%nvstp(inrc,jvar) + &
-                  &                      ( prodatqc%npvend(jobs,jvar) - &
-                  &                        prodatqc%npvsta(jobs,jvar) + 1 )
-            ENDIF
-         END DO
-      END DO
-      
-      
-      CALL obs_mpp_sum_integers( prodatqc%npstp, prodatqc%npstpmpp, &
-         &                       nitend - nit000 + 2 )
-      DO jvar = 1, prodatqc%nvar
-         CALL obs_mpp_sum_integers( prodatqc%nvstp(:,jvar), &
-            &                       prodatqc%nvstpmpp(:,jvar), &
-            &                       nitend - nit000 + 2 )
-      END DO
-
-      IF ( lwp ) THEN
-         DO jstp = nit000 - 1, nitend
-            inrc = jstp - nit000 + 2
-            WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), &
-               &                    prodatqc%nvstpmpp(inrc,1), &
-               &                    prodatqc%nvstpmpp(inrc,2)
-         END DO
-      ENDIF
-
-997   FORMAT(10X,'Time step',5X,'Profiles',5X,'Temperature',5X,'Salinity')
-998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'--------')
-999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8)
-      
-   END SUBROUTINE obs_pre_pro
-
-   SUBROUTINE obs_pre_sla( sladata, sladatqc, ld_sla, ld_nea )
+   SUBROUTINE obs_pre_surf( surfdata, surfdataqc, ld_nea )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE obs_pre_sla  ***
       !!
-      !! ** Purpose : First level check and screening of SLA observations
-      !!
-      !! ** Method  : First level check and screening of SLA observations
+      !! ** Purpose : First level check and screening of surface observations
+      !!
+      !! ** Method  : First level check and screening of surface observations
       !!
       !! ** Action  : 
@@ -352,4 +61,5 @@
       !!        !  2007-03  (A. Weaver, K. Mogensen) Original
       !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!        !  2015-02  (M. Martin) Combined routine for surface types.
       !!----------------------------------------------------------------------
       !! * Modules used
@@ -362,7 +72,6 @@
          & nproc
       !! * Arguments
-      TYPE(obs_surf), INTENT(INOUT) :: sladata    ! Full set of SLA data
-      TYPE(obs_surf), INTENT(INOUT) :: sladatqc   ! Subset of SLA data not failing screening
-      LOGICAL, INTENT(IN) :: ld_sla         ! Switch for SLA data
+      TYPE(obs_surf), INTENT(INOUT) :: surfdata    ! Full set of surface data
+      TYPE(obs_surf), INTENT(INOUT) :: surfdataqc   ! Subset of surface data not failing screening
       LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land
       !! * Local declarations
@@ -391,12 +100,13 @@
       INTEGER :: inrc         ! Time index variable
 
-      IF(lwp) WRITE(numout,*)'obs_pre_sla : Preparing the SLA observations...'
-
+      IF(lwp) WRITE(numout,*)'obs_pre_surf : Preparing the surface observations...'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      
       ! Initial date initialization (year, month, day, hour, minute)
       iyea0 =   ndate0 / 10000
       imon0 = ( ndate0 - iyea0 * 10000 ) / 100
       iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
-      ihou0 = 0
-      imin0 = 0
+      ihou0 = nn_time0 / 100
+      imin0 = ( nn_time0 - ihou0 * 100 )
 
       icycle = no     ! Assimilation cycle
@@ -411,21 +121,21 @@
 
       ! -----------------------------------------------------------------------
-      ! Find time coordinate for SLA data
+      ! Find time coordinate for surface data
       ! -----------------------------------------------------------------------
 
       CALL obs_coo_tim( icycle, &
          &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
-         &              sladata%nsurf,   sladata%nyea, sladata%nmon, &
-         &              sladata%nday,    sladata%nhou, sladata%nmin, &
-         &              sladata%nqc,     sladata%mstp, iotdobs        )
+         &              surfdata%nsurf,   surfdata%nyea, surfdata%nmon, &
+         &              surfdata%nday,    surfdata%nhou, surfdata%nmin, &
+         &              surfdata%nqc,     surfdata%mstp, iotdobs        )
 
       CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
       
       ! -----------------------------------------------------------------------
-      ! Check for SLA data failing the grid search
-      ! -----------------------------------------------------------------------
-
-      CALL obs_coo_grd( sladata%nsurf,   sladata%mi, sladata%mj, &
-         &              sladata%nqc,     igrdobs                         )
+      ! Check for surface data failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( surfdata%nsurf,   surfdata%mi, surfdata%mj, &
+         &              surfdata%nqc,     igrdobs                         )
 
       CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
@@ -435,10 +145,10 @@
       ! -----------------------------------------------------------------------
 
-      CALL obs_coo_spc_2d( sladata%nsurf,              &
+      CALL obs_coo_spc_2d( surfdata%nsurf,              &
          &                 jpi,          jpj,          &
-         &                 sladata%mi,   sladata%mj,   & 
-         &                 sladata%rlam, sladata%rphi, &
+         &                 surfdata%mi,   surfdata%mj,   & 
+         &                 surfdata%rlam, surfdata%rphi, &
          &                 glamt,        gphit,        &
-         &                 tmask(:,:,1), sladata%nqc,  &
+         &                 tmask(:,:,1), surfdata%nqc,  &
          &                 iosdsobs,     ilansobs,     &
          &                 inlasobs,     ld_nea        )
@@ -449,19 +159,19 @@
 
       ! -----------------------------------------------------------------------
-      ! Copy useful data from the sladata data structure to
-      ! the sladatqc data structure 
+      ! Copy useful data from the surfdata data structure to
+      ! the surfdataqc data structure 
       ! -----------------------------------------------------------------------
 
       ! Allocate the selection arrays
 
-      ALLOCATE( llvalid(sladata%nsurf) )
+      ALLOCATE( llvalid(surfdata%nsurf) )
       
       ! We want all data which has qc flags <= 10
 
-      llvalid(:)  = ( sladata%nqc(:)  <= 10 )
+      llvalid(:)  = ( surfdata%nqc(:)  <= 10 )
 
       ! The actual copying
 
-      CALL obs_surf_compress( sladata,     sladatqc,       .TRUE.,  numout, &
+      CALL obs_surf_compress( surfdata,     surfdataqc,       .TRUE.,  numout, &
          &                    lvalid=llvalid )
 
@@ -477,38 +187,36 @@
       IF(lwp) THEN
          WRITE(numout,*)
-         WRITE(numout,*) 'obs_pre_sla :'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*)
-         WRITE(numout,*) ' SLA data outside time domain                  = ', &
+         WRITE(numout,*) ' '//surfdataqc%cvars(1)//' data outside time domain                  = ', &
             &            iotdobsmpp
-         WRITE(numout,*) ' Remaining SLA data that failed grid search    = ', &
+         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data that failed grid search    = ', &
             &            igrdobsmpp
-         WRITE(numout,*) ' Remaining SLA data outside space domain       = ', &
+         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data outside space domain       = ', &
             &            iosdsobsmpp
-         WRITE(numout,*) ' Remaining SLA data at land points             = ', &
+         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data at land points             = ', &
             &            ilansobsmpp
          IF (ld_nea) THEN
-            WRITE(numout,*) ' Remaining SLA data near land points (removed) = ', &
+            WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (removed) = ', &
                &            inlasobsmpp
          ELSE
-            WRITE(numout,*) ' Remaining SLA data near land points (kept)    = ', &
+            WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (kept)    = ', &
                &            inlasobsmpp
          ENDIF
-         WRITE(numout,*) ' SLA data accepted                             = ', &
-            &            sladatqc%nsurfmpp
+         WRITE(numout,*) ' '//surfdataqc%cvars(1)//' data accepted                             = ', &
+            &            surfdataqc%nsurfmpp
 
          WRITE(numout,*)
          WRITE(numout,*) ' Number of observations per time step :'
          WRITE(numout,*)
-         WRITE(numout,1997)
-         WRITE(numout,1998)
+         WRITE(numout,'(10X,A,10X,A)')'Time step',surfdataqc%cvars(1)
+         WRITE(numout,'(10X,A,5X,A)')'---------','-----------------'
+         CALL FLUSH(numout)
       ENDIF
       
-      DO jobs = 1, sladatqc%nsurf
-         inrc = sladatqc%mstp(jobs) + 2 - nit000
-         sladatqc%nsstp(inrc)  = sladatqc%nsstp(inrc) + 1
+      DO jobs = 1, surfdataqc%nsurf
+         inrc = surfdataqc%mstp(jobs) + 2 - nit000
+         surfdataqc%nsstp(inrc)  = surfdataqc%nsstp(inrc) + 1
       END DO
       
-      CALL obs_mpp_sum_integers( sladatqc%nsstp, sladatqc%nsstpmpp, &
+      CALL obs_mpp_sum_integers( surfdataqc%nsstp, surfdataqc%nsstpmpp, &
          &                       nitend - nit000 + 2 )
 
@@ -516,28 +224,32 @@
          DO jstp = nit000 - 1, nitend
             inrc = jstp - nit000 + 2
-            WRITE(numout,1999) jstp, sladatqc%nsstpmpp(inrc)
+            WRITE(numout,1999) jstp, surfdataqc%nsstpmpp(inrc)
+            CALL FLUSH(numout)
          END DO
       ENDIF
 
-1997  FORMAT(10X,'Time step',5X,'Sea level anomaly')
-1998  FORMAT(10X,'---------',5X,'-----------------')
 1999  FORMAT(10X,I9,5X,I17)
 
-   END SUBROUTINE obs_pre_sla
-
-   SUBROUTINE obs_pre_sst( sstdata, sstdatqc, ld_sst, ld_nea )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE obs_pre_sst  ***
-      !!
-      !! ** Purpose : First level check and screening of SST observations
-      !!
-      !! ** Method  : First level check and screening of SST observations
-      !!
-      !! ** Action  : 
-      !!
-      !! References :
-      !!   
+   END SUBROUTINE obs_pre_surf
+
+
+   SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var1, ld_var2, &
+      &                     kpi, kpj, kpk, &
+      &                     zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2,  &
+      &                     ld_nea, kdailyavtypes )
+
+!!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_prof  ***
+      !!
+      !! ** Purpose : First level check and screening of profiles
+      !!
+      !! ** Method  : First level check and screening of profiles
+      !!
       !! History :
-      !!        !  2007-03  (S. Ricci) SST data preparation 
+      !!        !  2007-06  (K. Mogensen) original : T and S profile data
+      !!        !  2008-09  (M. Valdivieso) : TAO velocity data
+      !!        !  2009-01  (K. Mogensen) : New feedback stricture
+      !!        !  2015-02  (M. Martin) : Combined profile routine.
+      !!
       !!----------------------------------------------------------------------
       !! * Modules used
@@ -545,384 +257,25 @@
       USE par_oce             ! Ocean parameters
       USE dom_oce, ONLY : &   ! Geographical information
-         & glamt,   &
-         & gphit,   &
-         & tmask,   &
+         & gdept_1d,             &
          & nproc
-      !! * Arguments
-      TYPE(obs_surf), INTENT(INOUT) :: sstdata     ! Full set of SST data
-      TYPE(obs_surf), INTENT(INOUT) :: sstdatqc    ! Subset of SST data not failing screening
-      LOGICAL :: ld_sst             ! Switch for SST data
-      LOGICAL :: ld_nea             ! Switch for rejecting observation near land
-      !! * Local declarations
-      INTEGER :: iyea0        ! Initial date
-      INTEGER :: imon0        !  - (year, month, day, hour, minute)
-      INTEGER :: iday0   
-      INTEGER :: ihou0    
-      INTEGER :: imin0
-      INTEGER :: icycle       ! Current assimilation cycle
-                              ! Counters for observations that
-      INTEGER :: iotdobs      !  - outside time domain
-      INTEGER :: iosdsobs     !  - outside space domain
-      INTEGER :: ilansobs     !  - within a model land cell
-      INTEGER :: inlasobs     !  - close to land
-      INTEGER :: igrdobs      !  - fail the grid search
-                              ! Global counters for observations that
-      INTEGER :: iotdobsmpp   !  - outside time domain
-      INTEGER :: iosdsobsmpp  !  - outside space domain
-      INTEGER :: ilansobsmpp  !  - within a model land cell
-      INTEGER :: inlasobsmpp  !  - close to land
-      INTEGER :: igrdobsmpp   !  - fail the grid search
-      LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
-         & llvalid            ! SST data selection
-      INTEGER :: jobs         ! Obs. loop variable
-      INTEGER :: jstp         ! Time loop variable
-      INTEGER :: inrc         ! Time index variable
-
-      IF(lwp) WRITE(numout,*)'obs_pre_sst : Preparing the SST observations...'
-
-      ! Initial date initialization (year, month, day, hour, minute)
-      iyea0 =   ndate0 / 10000
-      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
-      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
-      ihou0 = 0
-      imin0 = 0
-
-      icycle = no     ! Assimilation cycle
-
-      ! Diagnotics counters for various failures.
-
-      iotdobs  = 0
-      igrdobs  = 0
-      iosdsobs = 0
-      ilansobs = 0
-      inlasobs = 0
-
-      ! -----------------------------------------------------------------------
-      ! Find time coordinate for SST data
-      ! -----------------------------------------------------------------------
-
-      CALL obs_coo_tim( icycle, &
-         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
-         &              sstdata%nsurf,   sstdata%nyea, sstdata%nmon, &
-         &              sstdata%nday,    sstdata%nhou, sstdata%nmin, &
-         &              sstdata%nqc,     sstdata%mstp, iotdobs        )
-      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
-      ! -----------------------------------------------------------------------
-      ! Check for SST data failing the grid search
-      ! -----------------------------------------------------------------------
-
-      CALL obs_coo_grd( sstdata%nsurf,   sstdata%mi, sstdata%mj, &
-         &              sstdata%nqc,     igrdobs                         )
-      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
-
-      ! -----------------------------------------------------------------------
-      ! Check for land points. 
-      ! -----------------------------------------------------------------------
-
-      CALL obs_coo_spc_2d( sstdata%nsurf,              &
-         &                 jpi,          jpj,          &
-         &                 sstdata%mi,   sstdata%mj,   & 
-         &                 sstdata%rlam, sstdata%rphi, &
-         &                 glamt,        gphit,        &
-         &                 tmask(:,:,1), sstdata%nqc,  &
-         &                 iosdsobs,     ilansobs,     &
-         &                 inlasobs,     ld_nea        )
-
-      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
-      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
-      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
-
-      ! -----------------------------------------------------------------------
-      ! Copy useful data from the sstdata data structure to
-      ! the sstdatqc data structure 
-      ! -----------------------------------------------------------------------
-
-      ! Allocate the selection arrays
-
-      ALLOCATE( llvalid(sstdata%nsurf) )
-      
-      ! We want all data which has qc flags <= 0
-
-      llvalid(:)  = ( sstdata%nqc(:)  <= 10 )
-
-      ! The actual copying
-
-      CALL obs_surf_compress( sstdata,     sstdatqc,       .TRUE.,  numout, &
-         &                    lvalid=llvalid )
-
-      ! Dellocate the selection arrays
-      DEALLOCATE( llvalid )
-
-      ! -----------------------------------------------------------------------
-      ! Print information about what observations are left after qc
-      ! -----------------------------------------------------------------------
-
-      ! Update the total observation counter array
-      
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'obs_pre_sst :'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*)
-         WRITE(numout,*) ' SST data outside time domain                  = ', &
-            &            iotdobsmpp
-         WRITE(numout,*) ' Remaining SST data that failed grid search    = ', &
-            &            igrdobsmpp
-         WRITE(numout,*) ' Remaining SST data outside space domain       = ', &
-            &            iosdsobsmpp
-         WRITE(numout,*) ' Remaining SST data at land points             = ', &
-            &            ilansobsmpp
-         IF (ld_nea) THEN
-            WRITE(numout,*) ' Remaining SST data near land points (removed) = ', &
-               &            inlasobsmpp
-         ELSE
-            WRITE(numout,*) ' Remaining SST data near land points (kept)    = ', &
-               &            inlasobsmpp
-         ENDIF
-         WRITE(numout,*) ' SST data accepted                             = ', &
-            &            sstdatqc%nsurfmpp
-
-         WRITE(numout,*)
-         WRITE(numout,*) ' Number of observations per time step :'
-         WRITE(numout,*)
-         WRITE(numout,1997)
-         WRITE(numout,1998)
-      ENDIF
-      
-      DO jobs = 1, sstdatqc%nsurf
-         inrc = sstdatqc%mstp(jobs) + 2 - nit000
-         sstdatqc%nsstp(inrc)  = sstdatqc%nsstp(inrc) + 1
-      END DO
-      
-      CALL obs_mpp_sum_integers( sstdatqc%nsstp, sstdatqc%nsstpmpp, &
-         &                       nitend - nit000 + 2 )
-
-      IF ( lwp ) THEN
-         DO jstp = nit000 - 1, nitend
-            inrc = jstp - nit000 + 2
-            WRITE(numout,1999) jstp, sstdatqc%nsstpmpp(inrc)
-         END DO
-      ENDIF
-
-1997  FORMAT(10X,'Time step',5X,'Sea surface temperature')
-1998  FORMAT(10X,'---------',5X,'-----------------')
-1999  FORMAT(10X,I9,5X,I17)
-      
-   END SUBROUTINE obs_pre_sst
-
-   SUBROUTINE obs_pre_seaice( seaicedata, seaicedatqc, ld_seaice, ld_nea )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE obs_pre_seaice  ***
-      !!
-      !! ** Purpose : First level check and screening of Sea Ice observations
-      !!
-      !! ** Method  : First level check and screening of Sea Ice observations
-      !!
-      !! ** Action  : 
-      !!
-      !! References :
-      !!   
-      !! History :
-      !!        !  2007-11 (D. Lea) based on obs_pre_sst
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE domstp              ! Domain: set the time-step
-      USE par_oce             ! Ocean parameters
-      USE dom_oce, ONLY : &   ! Geographical information
-         & glamt,   &
-         & gphit,   &
-         & tmask,   &
-         & nproc
-      !! * Arguments
-      TYPE(obs_surf), INTENT(INOUT) :: seaicedata     ! Full set of Sea Ice data
-      TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc    ! Subset of sea ice data not failing screening
-      LOGICAL :: ld_seaice     ! Switch for sea ice data
-      LOGICAL :: ld_nea        ! Switch for rejecting observation near land
-      !! * Local declarations
-      INTEGER :: iyea0         ! Initial date
-      INTEGER :: imon0         !  - (year, month, day, hour, minute)
-      INTEGER :: iday0    
-      INTEGER :: ihou0    
-      INTEGER :: imin0
-      INTEGER :: icycle       ! Current assimilation cycle
-                              ! Counters for observations that
-      INTEGER :: iotdobs      !  - outside time domain
-      INTEGER :: iosdsobs     !  - outside space domain
-      INTEGER :: ilansobs     !  - within a model land cell
-      INTEGER :: inlasobs     !  - close to land
-      INTEGER :: igrdobs      !  - fail the grid search
-                              ! Global counters for observations that
-      INTEGER :: iotdobsmpp   !  - outside time domain
-      INTEGER :: iosdsobsmpp  !  - outside space domain
-      INTEGER :: ilansobsmpp  !  - within a model land cell
-      INTEGER :: inlasobsmpp  !  - close to land
-      INTEGER :: igrdobsmpp   !  - fail the grid search
-      LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
-         & llvalid            ! data selection
-      INTEGER :: jobs         ! Obs. loop variable
-      INTEGER :: jstp         ! Time loop variable
-      INTEGER :: inrc         ! Time index variable
-
-      IF (lwp) WRITE(numout,*)'obs_pre_seaice : Preparing the sea ice observations...'
-
-      ! Initial date initialization (year, month, day, hour, minute)
-      iyea0 =   ndate0 / 10000
-      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
-      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
-      ihou0 = 0
-      imin0 = 0
-
-      icycle = no     ! Assimilation cycle
-
-      ! Diagnotics counters for various failures.
-
-      iotdobs  = 0
-      igrdobs  = 0
-      iosdsobs = 0
-      ilansobs = 0
-      inlasobs = 0
-
-      ! -----------------------------------------------------------------------
-      ! Find time coordinate for sea ice data
-      ! -----------------------------------------------------------------------
-
-      CALL obs_coo_tim( icycle, &
-         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
-         &              seaicedata%nsurf,   seaicedata%nyea, seaicedata%nmon, &
-         &              seaicedata%nday,    seaicedata%nhou, seaicedata%nmin, &
-         &              seaicedata%nqc,     seaicedata%mstp, iotdobs        )
-      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
-      ! -----------------------------------------------------------------------
-      ! Check for sea ice data failing the grid search
-      ! -----------------------------------------------------------------------
-
-      CALL obs_coo_grd( seaicedata%nsurf,   seaicedata%mi, seaicedata%mj, &
-         &              seaicedata%nqc,     igrdobs                         )
-      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
-
-      ! -----------------------------------------------------------------------
-      ! Check for land points. 
-      ! -----------------------------------------------------------------------
-
-      CALL obs_coo_spc_2d( seaicedata%nsurf,                 &
-         &                 jpi,             jpj,             &
-         &                 seaicedata%mi,   seaicedata%mj,   & 
-         &                 seaicedata%rlam, seaicedata%rphi, &
-         &                 glamt,           gphit,           &
-         &                 tmask(:,:,1),    seaicedata%nqc,  &
-         &                 iosdsobs,        ilansobs,        &
-         &                 inlasobs,        ld_nea           )
-
-      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
-      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
-      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
-
-      ! -----------------------------------------------------------------------
-      ! Copy useful data from the seaicedata data structure to
-      ! the seaicedatqc data structure 
-      ! -----------------------------------------------------------------------
-
-      ! Allocate the selection arrays
-
-      ALLOCATE( llvalid(seaicedata%nsurf) )
-      
-      ! We want all data which has qc flags <= 0
-
-      llvalid(:)  = ( seaicedata%nqc(:)  <= 10 )
-
-      ! The actual copying
-
-      CALL obs_surf_compress( seaicedata,     seaicedatqc,       .TRUE.,  numout, &
-         &                    lvalid=llvalid )
-
-      ! Dellocate the selection arrays
-      DEALLOCATE( llvalid )
-
-      ! -----------------------------------------------------------------------
-      ! Print information about what observations are left after qc
-      ! -----------------------------------------------------------------------
-
-      ! Update the total observation counter array
-      
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'obs_pre_seaice :'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*)
-         WRITE(numout,*) ' Sea ice data outside time domain                  = ', &
-            &            iotdobsmpp
-         WRITE(numout,*) ' Remaining sea ice data that failed grid search    = ', &
-            &            igrdobsmpp
-         WRITE(numout,*) ' Remaining sea ice data outside space domain       = ', &
-            &            iosdsobsmpp
-         WRITE(numout,*) ' Remaining sea ice data at land points             = ', &
-            &            ilansobsmpp
-         IF (ld_nea) THEN
-            WRITE(numout,*) ' Remaining sea ice data near land points (removed) = ', &
-               &            inlasobsmpp
-         ELSE
-            WRITE(numout,*) ' Remaining sea ice data near land points (kept)    = ', &
-               &            inlasobsmpp
-         ENDIF
-         WRITE(numout,*) ' Sea ice data accepted                             = ', &
-            &            seaicedatqc%nsurfmpp
-
-         WRITE(numout,*)
-         WRITE(numout,*) ' Number of observations per time step :'
-         WRITE(numout,*)
-         WRITE(numout,1997)
-         WRITE(numout,1998)
-      ENDIF
-      
-      DO jobs = 1, seaicedatqc%nsurf
-         inrc = seaicedatqc%mstp(jobs) + 2 - nit000
-         seaicedatqc%nsstp(inrc)  = seaicedatqc%nsstp(inrc) + 1
-      END DO
-      
-      CALL obs_mpp_sum_integers( seaicedatqc%nsstp, seaicedatqc%nsstpmpp, &
-         &                       nitend - nit000 + 2 )
-
-      IF ( lwp ) THEN
-         DO jstp = nit000 - 1, nitend
-            inrc = jstp - nit000 + 2
-            WRITE(numout,1999) jstp, seaicedatqc%nsstpmpp(inrc)
-         END DO
-      ENDIF
-
-1997  FORMAT(10X,'Time step',5X,'Sea ice data           ')
-1998  FORMAT(10X,'---------',5X,'-----------------')
-1999  FORMAT(10X,I9,5X,I17)
-      
-   END SUBROUTINE obs_pre_seaice
-
-   SUBROUTINE obs_pre_vel( profdata, prodatqc, ld_vel3d, ld_nea, ld_dailyav )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE obs_pre_taovel  ***
-      !!
-      !! ** Purpose : First level check and screening of U and V profiles
-      !!
-      !! ** Method  : First level check and screening of U and V profiles
-      !!
-      !! History :
-      !!        !  2007-06  (K. Mogensen) original : T and S profile data
-      !!        !  2008-09  (M. Valdivieso) : TAO velocity data
-      !!        !  2009-01  (K. Mogensen) : New feedback strictuer
-      !!
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE domstp              ! Domain: set the time-step
-      USE par_oce             ! Ocean parameters
-      USE dom_oce, ONLY : &   ! Geographical information
-         & glamt, glamu, glamv,    &
-         & gphit, gphiu, gphiv,    &
-         & gdept_1d,             &
-         & tmask, umask, vmask,  &
-         & nproc
+
       !! * Arguments
       TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Full set of profile data
       TYPE(obs_prof), INTENT(INOUT) :: prodatqc   ! Subset of profile data not failing screening
-      LOGICAL, INTENT(IN) :: ld_vel3d      ! Switch for zonal and meridional velocity components
-      LOGICAL, INTENT(IN) :: ld_nea        ! Switch for rejecting observation near land
-      LOGICAL, INTENT(IN) :: ld_dailyav    ! Switch for daily average data
+      LOGICAL, INTENT(IN) :: ld_var1              ! Observed variables switches
+      LOGICAL, INTENT(IN) :: ld_var2
+      LOGICAL, INTENT(IN) :: ld_nea               ! Switch for rejecting observation near land
+      INTEGER, INTENT(IN) :: kpi, kpj, kpk        ! Local domain sizes
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes                          ! Types for daily averages
+      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
+         & zmask1, &
+         & zmask2
+      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & pglam1, &
+         & pglam2, &
+         & pgphi1, &
+         & pgphi2
+
       !! * Local declarations
       INTEGER :: iyea0        ! Initial date
@@ -932,29 +285,29 @@
       INTEGER :: imin0
       INTEGER :: icycle       ! Current assimilation cycle
-                              ! Counters for observations that
+                              ! Counters for observations that are
       INTEGER :: iotdobs      !  - outside time domain
-      INTEGER :: iosduobs     !  - outside space domain (zonal velocity component)
-      INTEGER :: iosdvobs     !  - outside space domain (meridional velocity component)
-      INTEGER :: ilanuobs     !  - within a model land cell (zonal velocity component)
-      INTEGER :: ilanvobs     !  - within a model land cell (meridional velocity component)
-      INTEGER :: inlauobs     !  - close to land (zonal velocity component)
-      INTEGER :: inlavobs     !  - close to land (meridional velocity component)
+      INTEGER :: iosdv1obs    !  - outside space domain (variable 1)
+      INTEGER :: iosdv2obs    !  - outside space domain (variable 2)
+      INTEGER :: ilanv1obs    !  - within a model land cell (variable 1)
+      INTEGER :: ilanv2obs    !  - within a model land cell (variable 2)
+      INTEGER :: inlav1obs    !  - close to land (variable 1)
+      INTEGER :: inlav2obs    !  - close to land (variable 2)
       INTEGER :: igrdobs      !  - fail the grid search
       INTEGER :: iuvchku      !  - reject u if v rejected and vice versa
       INTEGER :: iuvchkv      !
-                              ! Global counters for observations that
+                              ! Global counters for observations that are
       INTEGER :: iotdobsmpp   !  - outside time domain
-      INTEGER :: iosduobsmpp  !  - outside space domain (zonal velocity component)
-      INTEGER :: iosdvobsmpp  !  - outside space domain (meridional velocity component)
-      INTEGER :: ilanuobsmpp  !  - within a model land cell (zonal velocity component)
-      INTEGER :: ilanvobsmpp  !  - within a model land cell (meridional velocity component)
-      INTEGER :: inlauobsmpp  !  - close to land (zonal velocity component)
-      INTEGER :: inlavobsmpp  !  - close to land (meridional velocity component)
+      INTEGER :: iosdv1obsmpp !  - outside space domain (variable 1)
+      INTEGER :: iosdv2obsmpp !  - outside space domain (variable 2)
+      INTEGER :: ilanv1obsmpp !  - within a model land cell (variable 1)
+      INTEGER :: ilanv2obsmpp !  - within a model land cell (variable 2)
+      INTEGER :: inlav1obsmpp !  - close to land (variable 1)
+      INTEGER :: inlav2obsmpp !  - close to land (variable 2)
       INTEGER :: igrdobsmpp   !  - fail the grid search
-      INTEGER :: iuvchkumpp   !  - reject u if v rejected and vice versa
+      INTEGER :: iuvchkumpp   !  - reject var1 if var2 rejected and vice versa
       INTEGER :: iuvchkvmpp   !
       TYPE(obs_prof_valid) ::  llvalid      ! Profile selection 
       TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: &
-         & llvvalid           ! U,V selection 
+         & llvvalid           ! var1,var2 selection 
       INTEGER :: jvar         ! Variable loop variable
       INTEGER :: jobs         ! Obs. loop variable
@@ -962,5 +315,6 @@
       INTEGER :: inrc         ! Time index variable
 
-      IF(lwp) WRITE(numout,*)'obs_pre_vel: Preparing the velocity profile data'
+      IF(lwp) WRITE(numout,*)'obs_pre_prof: Preparing the profile data...'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
 
       ! Initial date initialization (year, month, day, hour, minute)
@@ -968,6 +322,6 @@
       imon0 = ( ndate0 - iyea0 * 10000 ) / 100
       iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
-      ihou0 = 0
-      imin0 = 0
+      ihou0 = nn_time0 / 100
+      imin0 = ( nn_time0 - ihou0 * 100 )
 
       icycle = no     ! Assimilation cycle
@@ -977,10 +331,10 @@
       iotdobs  = 0
       igrdobs  = 0
-      iosduobs = 0
-      iosdvobs = 0
-      ilanuobs = 0
-      ilanvobs = 0
-      inlauobs = 0
-      inlavobs = 0
+      iosdv1obs = 0
+      iosdv2obs = 0
+      ilanv1obs = 0
+      ilanv2obs = 0
+      inlav1obs = 0
+      inlav2obs = 0
       iuvchku  = 0
       iuvchkv = 0
@@ -990,11 +344,20 @@
       ! -----------------------------------------------------------------------
 
-      CALL obs_coo_tim_prof( icycle, &
-         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
-         &              profdata%nprof,   profdata%nyea, profdata%nmon, &
-         &              profdata%nday,    profdata%nhou, profdata%nmin, &
-         &              profdata%ntyp,    profdata%nqc,  profdata%mstp, &
-         &              iotdobs, ld_dailyav = ld_dailyav        )
-	 
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         CALL obs_coo_tim_prof( icycle, &
+            &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+            &              profdata%nprof,   profdata%nyea, profdata%nmon, &
+            &              profdata%nday,    profdata%nhou, profdata%nmin, &
+            &              profdata%ntyp,    profdata%nqc,  profdata%mstp, &
+            &              iotdobs, kdailyavtypes = kdailyavtypes )
+      ELSE
+         CALL obs_coo_tim_prof( icycle, &
+            &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+            &              profdata%nprof,   profdata%nyea, profdata%nmon, &
+            &              profdata%nday,    profdata%nhou, profdata%nmin, &
+            &              profdata%ntyp,    profdata%nqc,  profdata%mstp, &
+            &              iotdobs )
+      ENDIF
+
       CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
       
@@ -1021,26 +384,24 @@
       ! -----------------------------------------------------------------------
 
-      ! Zonal Velocity Component
-
+      ! Variable 1
       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   &
          &                 profdata%npvsta(:,1),  profdata%npvend(:,1), &
          &                 jpi,                   jpj,                  &
          &                 jpk,                                         &
-         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%mi,           profdata%mj,          &
          &                 profdata%var(1)%mvk,                         &
          &                 profdata%rlam,         profdata%rphi,        &
          &                 profdata%var(1)%vdep,                        &
-         &                 glamu,                 gphiu,                &
-         &                 gdept_1d,              umask,                &
+         &                 pglam1,                pgphi1,               &
+         &                 gdept_1d,              zmask1,               &
          &                 profdata%nqc,          profdata%var(1)%nvqc, &
-         &                 iosduobs,              ilanuobs,             &
-         &                 inlauobs,              ld_nea                )
-
-      CALL obs_mpp_sum_integer( iosduobs, iosduobsmpp )
-      CALL obs_mpp_sum_integer( ilanuobs, ilanuobsmpp )
-      CALL obs_mpp_sum_integer( inlauobs, inlauobsmpp )
-
-      ! Meridional Velocity Component
-
+         &                 iosdv1obs,              ilanv1obs,           &
+         &                 inlav1obs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdv1obs, iosdv1obsmpp )
+      CALL obs_mpp_sum_integer( ilanv1obs, ilanv1obsmpp )
+      CALL obs_mpp_sum_integer( inlav1obs, inlav1obsmpp )
+
+      ! Variable 2
       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   &
          &                 profdata%npvsta(:,2),  profdata%npvend(:,2), &
@@ -1051,13 +412,13 @@
          &                 profdata%rlam,         profdata%rphi,        &
          &                 profdata%var(2)%vdep,                        &
-         &                 glamv,                 gphiv,                &
-         &                 gdept_1d,              vmask,                &
+         &                 pglam2,                pgphi2,               &
+         &                 gdept_1d,              zmask2,               &
          &                 profdata%nqc,          profdata%var(2)%nvqc, &
-         &                 iosdvobs,              ilanvobs,             &
-         &                 inlavobs,              ld_nea                )
-
-      CALL obs_mpp_sum_integer( iosdvobs, iosdvobsmpp )
-      CALL obs_mpp_sum_integer( ilanvobs, ilanvobsmpp )
-      CALL obs_mpp_sum_integer( inlavobs, inlavobsmpp )
+         &                 iosdv2obs,              ilanv2obs,           &
+         &                 inlav2obs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdv2obs, iosdv2obsmpp )
+      CALL obs_mpp_sum_integer( ilanv2obs, ilanv2obsmpp )
+      CALL obs_mpp_sum_integer( inlav2obs, inlav2obsmpp )
 
       ! -----------------------------------------------------------------------
@@ -1065,7 +426,9 @@
       ! -----------------------------------------------------------------------
 
-      CALL obs_uv_rej( profdata, iuvchku, iuvchkv )
-      CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp )
-      CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp )
+      IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN
+         CALL obs_uv_rej( profdata, iuvchku, iuvchkv )
+         CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp )
+         CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp )
+      ENDIF
 
       ! -----------------------------------------------------------------------
@@ -1106,41 +469,43 @@
       
       IF(lwp) THEN
+      
          WRITE(numout,*)
-         WRITE(numout,*) 'obs_pre_vel :'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*)
-         WRITE(numout,*) ' Profiles outside time domain                = ', &
+         WRITE(numout,*) ' Profiles outside time domain                     = ', &
             &            iotdobsmpp
-         WRITE(numout,*) ' Remaining profiles that failed grid search  = ', &
+         WRITE(numout,*) ' Remaining profiles that failed grid search       = ', &
             &            igrdobsmpp
-         WRITE(numout,*) ' Remaining U data outside space domain       = ', &
-            &            iosduobsmpp
-         WRITE(numout,*) ' Remaining U data at land points             = ', &
-            &            ilanuobsmpp
+         WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data outside space domain       = ', &
+            &            iosdv1obsmpp
+         WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data at land points             = ', &
+            &            ilanv1obsmpp
          IF (ld_nea) THEN
-            WRITE(numout,*) ' Remaining U data near land points (removed) = ',&
-               &            inlauobsmpp
+            WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (removed) = ',&
+               &            inlav1obsmpp
          ELSE
-            WRITE(numout,*) ' Remaining U data near land points (kept)    = ',&
-               &            inlauobsmpp
-         ENDIF
-         WRITE(numout,*) ' U observation rejected since V rejected     = ', &
-            &            iuvchku     
-         WRITE(numout,*) ' U data accepted                             = ', &
+            WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (kept)    = ',&
+               &            inlav1obsmpp
+         ENDIF
+         IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN
+            WRITE(numout,*) ' U observation rejected since V rejected     = ', &
+               &            iuvchku
+         ENDIF
+         WRITE(numout,*) ' '//prodatqc%cvars(1)//' data accepted                             = ', &
             &            prodatqc%nvprotmpp(1)
-         WRITE(numout,*) ' Remaining V data outside space domain       = ', &
-            &            iosdvobsmpp
-         WRITE(numout,*) ' Remaining V data at land points             = ', &
-            &            ilanvobsmpp
+         WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data outside space domain       = ', &
+            &            iosdv2obsmpp
+         WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data at land points             = ', &
+            &            ilanv2obsmpp
          IF (ld_nea) THEN
-            WRITE(numout,*) ' Remaining V data near land points (removed) = ',&
-               &            inlavobsmpp
+            WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (removed) = ',&
+               &            inlav2obsmpp
          ELSE
-            WRITE(numout,*) ' Remaining V data near land points (kept)    = ',&
-               &            inlavobsmpp
-         ENDIF
-         WRITE(numout,*) ' V observation rejected since U rejected     = ', &
-            &            iuvchkv     
-         WRITE(numout,*) ' V data accepted                             = ', &
+            WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (kept)    = ',&
+               &            inlav2obsmpp
+         ENDIF
+         IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN
+            WRITE(numout,*) ' V observation rejected since U rejected     = ', &
+               &            iuvchkv
+         ENDIF
+         WRITE(numout,*) ' '//prodatqc%cvars(2)//' data accepted                             = ', &
             &            prodatqc%nvprotmpp(2)
 
@@ -1148,5 +513,7 @@
          WRITE(numout,*) ' Number of observations per time step :'
          WRITE(numout,*)
-         WRITE(numout,997)
+         WRITE(numout,'(10X,A,5X,A,5X,A,A)')'Time step','Profiles', &
+            &                               '     '//prodatqc%cvars(1)//'     ', &
+            &                               '     '//prodatqc%cvars(2)//'     '
          WRITE(numout,998)
       ENDIF
@@ -1182,9 +549,8 @@
       ENDIF
 
-997   FORMAT(10X,'Time step',5X,'Profiles',5X,'Zonal Comp.',5X,'Meridional Comp.')
 998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'----------------')
 999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8)
 
-   END SUBROUTINE obs_pre_vel
+   END SUBROUTINE obs_pre_prof
 
    SUBROUTINE obs_coo_tim( kcycle, &
@@ -1388,6 +754,5 @@
       &                    kobsno,                                        &
       &                    kobsyea, kobsmon, kobsday, kobshou, kobsmin,   &
-      &                    ktyp,    kobsqc,  kobsstp, kotdobs, kdailyavtypes, &
-      &                    ld_dailyav )
+      &                    ktyp,    kobsqc,  kobsstp, kotdobs, kdailyavtypes )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE obs_coo_tim ***
@@ -1433,5 +798,4 @@
       INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
          & kdailyavtypes    ! Types for daily averages
-      LOGICAL, OPTIONAL :: ld_dailyav    ! All types are daily averages
       !! * Local declarations
       INTEGER :: jobs
@@ -1467,24 +831,4 @@
       ENDIF
 
-      !------------------------------------------------------------------------
-      ! If ld_dailyav is set then all data assumed to be daily averaged
-      !------------------------------------------------------------------------
-      
-      IF ( PRESENT( ld_dailyav) ) THEN
-         IF (ld_dailyav) THEN
-            DO jobs = 1, kobsno
-               
-               IF ( kobsqc(jobs) <= 10 ) THEN
-                  
-                  IF ( kobsstp(jobs) == (nit000 - 1) ) THEN
-                     kobsqc(jobs) = kobsqc(jobs) + 14
-                     kotdobs      = kotdobs + 1
-                     CYCLE
-                  ENDIF
-                  
-               ENDIF
-            END DO
-         ENDIF
-      ENDIF
 
    END SUBROUTINE obs_coo_tim_prof
@@ -1614,7 +958,7 @@
       END DO
       
-      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk )
-      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, plam, zglam )
-      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pphi, zgphi )
+      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, pmask, zgmsk )
+      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, plam, zglam )
+      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, pphi, zgphi )
 
       DO jobs = 1, kobsno
@@ -1709,5 +1053,10 @@
       !! * Modules used
       USE dom_oce, ONLY : &       ! Geographical information
-         & gdepw_1d                        
+         & gdepw_1d,      &
+         & gdepw_0,       &                       
+         & gdepw_n,       &
+         & gdept_n,       &
+         & ln_zco,        &
+         & ln_zps             
 
       !! * Arguments
@@ -1747,4 +1096,6 @@
       REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: &
          & zgmsk              ! Grid mask
+      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: &
+         & zgdepw
       REAL(KIND=wp), DIMENSION(2,2,kprofno) :: &
          & zglam, &           ! Model longitude at grid points
@@ -1754,4 +1105,5 @@
          & igrdj
       LOGICAL :: lgridobs           ! Is observation on a model grid point.
+      LOGICAL :: ll_next_to_land    ! Is a profile next to land 
       INTEGER :: iig, ijg           ! i,j of observation on model grid point.
       INTEGER :: jobs, jobsp, jk, ji, jj
@@ -1789,7 +1141,12 @@
       END DO
       
-      CALL obs_int_comm_3d( 2, 2, kprofno, kpk, igrdi, igrdj, pmask, zgmsk )
-      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, plam, zglam )
-      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, pphi, zgphi )
+      CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, pmask, zgmsk )
+      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, plam, zglam )
+      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, pphi, zgphi )
+      IF ( .NOT.( ln_zps .OR. ln_zco ) ) THEN
+        ! Need to know the bathy depth for each observation for sco
+        CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, gdepw_n(:,:,:), &
+        &                     zgdepw )
+      ENDIF
 
       DO jobs = 1, kprofno
@@ -1816,4 +1173,11 @@
          END DO
 
+         ! Check if next to land
+         IF (  ANY( zgmsk(1:2,1:2,1,jobs) == 0.0_wp ) ) THEN
+            ll_next_to_land=.TRUE.
+         ELSE
+            ll_next_to_land=.FALSE.
+         ENDIF 
+
          ! Reject observations
 
@@ -1832,12 +1196,50 @@
             ENDIF
 
-            ! Flag if the observation falls with a model land cell
-            IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) &
-               &  == 0.0_wp ) THEN
-               kobsqc(jobsp) = kobsqc(jobsp) + 12
-               klanobs = klanobs + 1
-               CYCLE
+            ! To check if an observations falls within land there are two cases:
+            ! 1: z-coordibnates, where the check uses the mask
+            ! 2: terrain following (eg s-coordinates), 
+            !    where we use the depth of the bottom cell to mask observations
+             
+            IF( ln_zps .OR. ln_zco ) THEN !(CASE 1)
+               
+               ! Flag if the observation falls with a model land cell
+               IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) &
+                  &  == 0.0_wp ) THEN
+                  kobsqc(jobsp) = kobsqc(jobsp) + 12
+                  klanobs = klanobs + 1
+                  CYCLE
+               ENDIF
+             
+               ! Flag if the observation is close to land
+              IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == &
+                  &  0.0_wp) THEN
+                  knlaobs = knlaobs + 1
+                  IF (ld_nea) THEN   
+                     kobsqc(jobsp) = kobsqc(jobsp) + 14 
+                  ENDIF 
+               ENDIF
+             
+            ELSE ! Case 2
+ 
+               ! Flag if the observation is deeper than the bathymetry
+               ! Or if it is within the mask
+               IF ( ALL( zgdepw(1:2,1:2,kpk,jobs) < pobsdep(jobsp) ) &
+                  &     .OR. &
+                  &  ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) &
+                  &  == 0.0_wp) ) THEN
+                  kobsqc(jobsp) = kobsqc(jobsp) + 12
+                  klanobs = klanobs + 1
+                  CYCLE
+               ENDIF
+               
+               ! Flag if the observation is close to land
+               IF ( ll_next_to_land ) THEN
+                  knlaobs = knlaobs + 1
+                  IF (ld_nea) THEN   
+                     kobsqc(jobsp) = kobsqc(jobsp) + 14 
+                  ENDIF 
+               ENDIF
             ENDIF
-
+            
             ! For observations on the grid reject them if their are at
             ! a masked point
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prof_io.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prof_io.F90	(revision 6807)
+++ 	(revision )
@@ -1,32 +1,0 @@
-MODULE obs_prof_io
-   !!======================================================================
-   !!                       ***  MODULE obs_prof_io  ***
-   !! Observation operators : I/O for ENACT and Coriolis files
-   !!======================================================================
-   !! History : 
-   !!             !  09-01  (K. Mogensen) Initial version
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   read_enactfile    :  Read a obfbdata structure from an ENACT file.
-   !!   read_coriofile    :  Read a obfbdata structure from an Coriolis file.
-   !!----------------------------------------------------------------------
-   USE par_kind
-   USE obs_utils
-   USE obs_fbm
-   USE obs_conv
-   USE netcdf
-   IMPLICIT NONE
-
-   INTEGER, PARAMETER :: imaxlev = 10000
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-#include "obsprof_io.h90"
-
-END MODULE obs_prof_io
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90	(revision 6808)
@@ -104,4 +104,7 @@
       ! Bookkeeping arrays with sizes equal to number of variables
 
+      CHARACTER(len=6), POINTER, DIMENSION(:) :: &
+         & cvars          !: Variable names
+
       INTEGER, POINTER, DIMENSION(:) :: &
          & nvprot,   &    !: Local total number of profile T data
@@ -237,4 +240,5 @@
 
       ALLOCATE( &
+         & prof%cvars(kvar),    &
          & prof%nvprot(kvar),   &
          & prof%nvprotmpp(kvar) &
@@ -242,4 +246,5 @@
          
       DO jvar = 1, kvar
+         prof%cvars    (jvar) = "NotSet"
          prof%nvprot   (jvar) = ko3dt(jvar)
          prof%nvprotmpp(jvar) = 0
@@ -452,5 +457,6 @@
 
       DEALLOCATE( &
-         & prof%nvprot,  &
+         & prof%cvars,    &
+         & prof%nvprot,   &
          & prof%nvprotmpp &
          )
@@ -770,4 +776,5 @@
       newprof%npj      = prof%npj
       newprof%npk      = prof%npk
+      newprof%cvars(:) = prof%cvars(:)
  
       ! Deallocate temporary data
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 6808)
@@ -50,5 +50,5 @@
 CONTAINS
 
-   SUBROUTINE obs_rea_altbias( kslano, sladata, k2dint, bias_file )
+   SUBROUTINE obs_rea_altbias( sladata, k2dint, bias_file )
       !!---------------------------------------------------------------------
       !!
@@ -70,6 +70,5 @@
       !
       !! * Arguments
-      INTEGER, INTENT(IN) :: kslano      ! Number of SLA Products
-      TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: &
+      TYPE(obs_surf), INTENT(INOUT) :: &
          & sladata       ! SLA data
       INTEGER, INTENT(IN) :: k2dint
@@ -80,5 +79,4 @@
       CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias'
 
-      INTEGER :: jslano       ! Data set loop variable
       INTEGER :: jobs         ! Obs loop variable
       INTEGER :: jpialtbias   ! Number of grid point in latitude for the bias
@@ -144,68 +142,63 @@
       ! Intepolate the bias already on the model grid at the observation point
   
-      DO jslano = 1, kslano
-
-         ALLOCATE( &
-            & igrdi(2,2,sladata(jslano)%nsurf), &
-            & igrdj(2,2,sladata(jslano)%nsurf), &
-            & zglam(2,2,sladata(jslano)%nsurf), &
-            & zgphi(2,2,sladata(jslano)%nsurf), &
-            & zmask(2,2,sladata(jslano)%nsurf), &
-            & zbias(2,2,sladata(jslano)%nsurf)  &
-            & )
-         
-         DO jobs = 1, sladata(jslano)%nsurf
-
-            igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1
-            igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1
-            igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1
-            igrdj(1,2,jobs) = sladata(jslano)%mj(jobs)
-            igrdi(2,1,jobs) = sladata(jslano)%mi(jobs)
-            igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1
-            igrdi(2,2,jobs) = sladata(jslano)%mi(jobs)
-            igrdj(2,2,jobs) = sladata(jslano)%mj(jobs)
-
-         END DO
-
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
-            &                  igrdi, igrdj, glamt, zglam )
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
-            &                  igrdi, igrdj, gphit, zgphi )
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
-            &                  igrdi, igrdj, tmask(:,:,1), zmask )
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
-            &                  igrdi, igrdj, z_altbias, zbias )
-
-         DO jobs = 1, sladata(jslano)%nsurf
-
-            zlam = sladata(jslano)%rlam(jobs)
-            zphi = sladata(jslano)%rphi(jobs)
-            iico = sladata(jslano)%mi(jobs)
-            ijco = sladata(jslano)%mj(jobs)
+      ALLOCATE( &
+         & igrdi(2,2,sladata%nsurf), &
+         & igrdj(2,2,sladata%nsurf), &
+         & zglam(2,2,sladata%nsurf), &
+         & zgphi(2,2,sladata%nsurf), &
+         & zmask(2,2,sladata%nsurf), &
+         & zbias(2,2,sladata%nsurf)  &
+         & )
+         
+      DO jobs = 1, sladata%nsurf
+
+         igrdi(1,1,jobs) = sladata%mi(jobs)-1
+         igrdj(1,1,jobs) = sladata%mj(jobs)-1
+         igrdi(1,2,jobs) = sladata%mi(jobs)-1
+         igrdj(1,2,jobs) = sladata%mj(jobs)
+         igrdi(2,1,jobs) = sladata%mi(jobs)
+         igrdj(2,1,jobs) = sladata%mj(jobs)-1
+         igrdi(2,2,jobs) = sladata%mi(jobs)
+         igrdj(2,2,jobs) = sladata%mj(jobs)
+
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, tmask(:,:,1), zmask )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, z_altbias, zbias )
+
+      DO jobs = 1, sladata%nsurf
+
+         zlam = sladata%rlam(jobs)
+         zphi = sladata%rphi(jobs)
+         iico = sladata%mi(jobs)
+         ijco = sladata%mj(jobs)
             
-            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
-               &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
-               &                   zmask(:,:,jobs), zweig, zobsmask )
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
+            &                   zmask(:,:,jobs), zweig, zobsmask )
             
-            CALL obs_int_h2d( 1, 1,      &
-               &              zweig, zbias(:,:,jobs),  zext )
-
-            ! adjust mdt with bias field
-            sladata(jslano)%rext(jobs,2) = &
-               sladata(jslano)%rext(jobs,2) - zext(1)
+         CALL obs_int_h2d( 1, 1,      &
+            &              zweig, zbias(:,:,jobs),  zext )
+
+         ! adjust mdt with bias field
+         sladata%rext(jobs,2) = sladata%rext(jobs,2) - zext(1)
             
-         END DO
-
-         DEALLOCATE( &
-            & igrdi, &
-            & igrdj, &
-            & zglam, &
-            & zgphi, &
-            & zmask, &
-            & zbias  &
-            & )
-         
       END DO
 
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zbias  &
+         & )
+         
       CALL wrk_dealloc(jpi,jpj,z_altbias) 
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 6808)
@@ -25,6 +25,6 @@
    USE netcdf                   ! NetCDF library
    USE obs_oper                 ! Observation operators
-   USE obs_prof_io              ! Profile files I/O (non-FB files)
    USE lib_mpp                  ! For ctl_warn/stop
+   USE obs_fbm                  ! Feedback routines
 
    IMPLICIT NONE
@@ -33,5 +33,5 @@
    PRIVATE
 
-   PUBLIC obs_rea_pro_dri  ! Read the profile observations 
+   PUBLIC obs_rea_prof  ! Read the profile observations 
 
    !!----------------------------------------------------------------------
@@ -42,18 +42,17 @@
 
 CONTAINS
- 
-   SUBROUTINE obs_rea_pro_dri( kformat, &
-      &                        profdata, knumfiles, cfilenames, &
-      &                        kvars, kextr, kstp, ddobsini, ddobsend, &
-      &                        ldt3d, lds3d, ldignmis, ldsatt, ldavtimset, &
-      &                        ldmod, kdailyavtypes )
+
+   SUBROUTINE obs_rea_prof( profdata, knumfiles, cdfilenames, &
+      &                     kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                     ldvar1, ldvar2, ldignmis, ldsatt, &
+      &                     ldmod, kdailyavtypes )
       !!---------------------------------------------------------------------
       !!
-      !!                   *** ROUTINE obs_rea_pro_dri ***
+      !!                   *** ROUTINE obs_rea_prof ***
       !!
       !! ** Purpose : Read from file the profile observations
       !!
-      !! ** Method  : Depending on kformat either ENACT, CORIOLIS or
-      !!              feedback data files are read
+      !! ** Method  : Read feedback data in and transform to NEMO internal 
+      !!              profile data structure
       !!
       !! ** Action  : 
@@ -63,31 +62,30 @@
       !! History :  
       !!      ! :  2009-09 (K. Mogensen) : New merged version of old routines
+      !!      ! :  2015-08 (M. Martin) : Merged profile and velocity routines
       !!----------------------------------------------------------------------
-      !! * Modules used
-   
+
       !! * Arguments
-      INTEGER ::  kformat    ! Format of input data
-      !                      ! 1: ENACT
-      !                      ! 2: Coriolis
-      TYPE(obs_prof), INTENT(OUT) ::  profdata     ! Profile data to be read
-      INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in
+      TYPE(obs_prof), INTENT(OUT) :: &
+         & profdata                     ! Profile data to be read
+      INTEGER, INTENT(IN) :: knumfiles  ! Number of files to read
       CHARACTER(LEN=128), INTENT(IN) ::  &
-         & cfilenames(knumfiles)  ! File names to read in
+         & cdfilenames(knumfiles)        ! File names to read in
       INTEGER, INTENT(IN) :: kvars      ! Number of variables in profdata
-      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in profdata
-      INTEGER, INTENT(IN) :: kstp        ! Ocean time-step index
-      LOGICAL, INTENT(IN) :: ldt3d       ! Observed variables switches
-      LOGICAL, INTENT(IN) :: lds3d
-      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files
-      LOGICAL, INTENT(IN) :: ldsatt      ! Compute salinity at all temperature points
-      LOGICAL, INTENT(IN) :: ldavtimset  ! Correct time for daily averaged data
-      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data
-      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS
-      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS
+      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var
+      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldvar1     ! Observed variables switches
+      LOGICAL, INTENT(IN) :: ldvar2
+      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldsatt     ! Compute salinity at all temperature points
+      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
+      REAL(dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS
       INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
-         & kdailyavtypes
+         & kdailyavtypes                ! Types of daily average observations
 
       !! * Local declarations
-      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_pro_dri'
+      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_prof'
+      CHARACTER(len=8) :: clrefdate
+      CHARACTER(len=6), DIMENSION(:), ALLOCATABLE :: clvars
       INTEGER :: jvar
       INTEGER :: ji
@@ -105,57 +103,62 @@
       INTEGER :: imin
       INTEGER :: isec
+      INTEGER :: iprof
+      INTEGER :: iproftot
+      INTEGER :: ivar1t0
+      INTEGER :: ivar2t0
+      INTEGER :: ivar1t
+      INTEGER :: ivar2t
+      INTEGER :: ip3dt
+      INTEGER :: ios
+      INTEGER :: ioserrcount
+      INTEGER :: ivar1tmpp
+      INTEGER :: ivar2tmpp
+      INTEGER :: ip3dtmpp
+      INTEGER :: itype
       INTEGER, DIMENSION(knumfiles) :: &
          & irefdate
       INTEGER, DIMENSION(ntyp1770+1) :: &
-         & itypt,    &
-         & ityptmpp, &
-         & ityps,    &
-         & itypsmpp 
-      INTEGER :: it3dtmpp
-      INTEGER :: is3dtmpp
-      INTEGER :: ip3dtmpp
+         & itypvar1,    &
+         & itypvar1mpp, &
+         & itypvar2,    &
+         & itypvar2mpp 
       INTEGER, DIMENSION(:), ALLOCATABLE :: &
-         & iobsi,    &
-         & iobsj,    &
-         & iproc,    &
+         & iobsi1,    &
+         & iobsj1,    &
+         & iproc1,    &
+         & iobsi2,    &
+         & iobsj2,    &
+         & iproc2,    &
          & iindx,    &
          & ifileidx, &
          & iprofidx
-      INTEGER :: itype
       INTEGER, DIMENSION(imaxavtypes) :: &
          & idailyavtypes
+      INTEGER, DIMENSION(kvars) :: &
+         & iv3dt
       REAL(wp), DIMENSION(:), ALLOCATABLE :: &
          & zphi, &
          & zlam
-      real(wp), DIMENSION(:), ALLOCATABLE :: &
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
          & zdat
+      REAL(wp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
       LOGICAL :: llvalprof
+      LOGICAL :: lldavtimset
       TYPE(obfbdata), POINTER, DIMENSION(:) :: &
          & inpfiles
-      real(wp), DIMENSION(knumfiles) :: &
-         & djulini, &
-         & djulend
-      INTEGER :: iprof
-      INTEGER :: iproftot
-      INTEGER :: it3dt0
-      INTEGER :: is3dt0
-      INTEGER :: it3dt
-      INTEGER :: is3dt
-      INTEGER :: ip3dt
-      INTEGER :: ios
-      INTEGER :: ioserrcount
-      INTEGER, DIMENSION(kvars) :: &
-         & iv3dt
-      CHARACTER(len=8) :: cl_refdate
-   
+
       ! Local initialization
       iprof = 0
-      it3dt0 = 0
-      is3dt0 = 0
+      ivar1t0 = 0
+      ivar2t0 = 0
       ip3dt = 0
 
       ! Daily average types
+      lldavtimset = .FALSE.
       IF ( PRESENT(kdailyavtypes) ) THEN
          idailyavtypes(:) = kdailyavtypes(:)
+         IF ( ANY (idailyavtypes(:) /= -1) ) lldavtimset = .TRUE.
       ELSE
          idailyavtypes(:) = -1
@@ -163,21 +166,13 @@
 
       !-----------------------------------------------------------------------
-      ! Check data the model part is just with feedback data files
-      !-----------------------------------------------------------------------
-      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
-         CALL ctl_stop( 'Model can only be read from feedback data' )
-         RETURN
-      ENDIF
-
-      !-----------------------------------------------------------------------
       ! Count the number of files needed and allocate the obfbdata type
       !-----------------------------------------------------------------------
-      
+
       inobf = knumfiles
-      
+
       ALLOCATE( inpfiles(inobf) )
 
       prof_files : DO jj = 1, inobf
-          
+
          !---------------------------------------------------------------------
          ! Prints
@@ -186,5 +181,5 @@
             WRITE(numout,*)
             WRITE(numout,*) ' obs_rea_pro_dri : Reading from file = ', &
-               & TRIM( TRIM( cfilenames(jj) ) )
+               & TRIM( TRIM( cdfilenames(jj) ) )
             WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
             WRITE(numout,*)
@@ -194,25 +189,25 @@
          !  Initialization: Open file and get dimensions only
          !---------------------------------------------------------------------
-         
-         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+
+         iflag = nf90_open( TRIM( cdfilenames(jj) ), nf90_nowrite, &
             &                      i_file_id )
-         
+
          IF ( iflag /= nf90_noerr ) THEN
 
             IF ( ldignmis ) THEN
                inpfiles(jj)%nobs = 0
-               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+               CALL ctl_warn( 'File ' // TRIM( cdfilenames(jj) ) // &
                   &           ' not found' )
             ELSE 
-               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+               CALL ctl_stop( 'File ' // TRIM( cdfilenames(jj) ) // &
                   &           ' not found' )
             ENDIF
 
          ELSE 
-            
+
             !------------------------------------------------------------------
-            !  Close the file since it is opened in read_proffile
+            !  Close the file since it is opened in read_obfbdata
             !------------------------------------------------------------------
-            
+
             iflag = nf90_close( i_file_id )
 
@@ -220,39 +215,31 @@
             !  Read the profile file into inpfiles
             !------------------------------------------------------------------
-            IF ( kformat == 0 ) THEN
-               CALL init_obfbdata( inpfiles(jj) )
-               IF(lwp) THEN
-                  WRITE(numout,*)
-                  WRITE(numout,*)'Reading from feedback file :', &
-                     &           TRIM( cfilenames(jj) )
-               ENDIF
-               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
-                  &                ldgrid = .TRUE. )
-               IF ( inpfiles(jj)%nvar < 2 ) THEN
-                  CALL ctl_stop( 'Feedback format error' )
-                  RETURN
-               ENDIF
-               IF ( TRIM(inpfiles(jj)%cname(1)) /= 'POTM' ) THEN
-                  CALL ctl_stop( 'Feedback format error' )
-                  RETURN
-               ENDIF
-               IF ( TRIM(inpfiles(jj)%cname(2)) /= 'PSAL' ) THEN
-                  CALL ctl_stop( 'Feedback format error' )
-                  RETURN
-               ENDIF
-               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
-                  CALL ctl_stop( 'Model not in input data' )
-                  RETURN
-               ENDIF
-            ELSEIF ( kformat == 1 ) THEN
-               CALL read_enactfile( TRIM( cfilenames(jj) ), inpfiles(jj), &
-                  &                 numout, lwp, .TRUE. )
-            ELSEIF ( kformat == 2 ) THEN
-               CALL read_coriofile( TRIM( cfilenames(jj) ), inpfiles(jj), &
-                  &                 numout, lwp, .TRUE. )
+            CALL init_obfbdata( inpfiles(jj) )
+            CALL read_obfbdata( TRIM( cdfilenames(jj) ), inpfiles(jj), &
+               &                ldgrid = .TRUE. )
+
+            IF ( inpfiles(jj)%nvar < 2 ) THEN
+               CALL ctl_stop( 'Feedback format error: ', &
+                  &           ' less than 2 vars in profile file' )
+            ENDIF
+
+            IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
+               CALL ctl_stop( 'Model not in input data' )
+            ENDIF
+
+            IF ( jj == 1 ) THEN
+               ALLOCATE( clvars( inpfiles(jj)%nvar ) )
+               DO ji = 1, inpfiles(jj)%nvar
+                 clvars(ji) = inpfiles(jj)%cname(ji)
+               END DO
             ELSE
-               CALL ctl_stop( 'File format unknown' )
-            ENDIF
-            
+               DO ji = 1, inpfiles(jj)%nvar
+                  IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN
+                     CALL ctl_stop( 'Feedback file variables not consistent', &
+                        &           ' with previous files for this type' )
+                  ENDIF
+               END DO
+            ENDIF
+
             !------------------------------------------------------------------
             !  Change longitude (-180,180)
@@ -272,7 +259,7 @@
             !  Calculate the date  (change eventually)
             !------------------------------------------------------------------
-            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
-            READ(cl_refdate,'(I8)') irefdate(jj)
-            
+            clrefdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(clrefdate,'(I8)') irefdate(jj)
+
             CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
             CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
@@ -283,26 +270,38 @@
 
             ioserrcount=0
-            IF ( ldavtimset ) THEN
+            IF ( lldavtimset ) THEN
+
+               IF ( ANY ( idailyavtypes(:) /= -1 ) .AND. lwp) THEN
+                  WRITE(numout,*)' Resetting time of daily averaged', &
+                     &           ' observations to the end of the day'
+               ENDIF
+
                DO ji = 1, inpfiles(jj)%nobs
-                  ! 
-                  !  for daily averaged data for example
-                  !  MRB data (itype==820) force the time
-                  !  to be the  end of the day
-                  !
                   READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 900 ) itype
 900               IF ( ios /= 0 ) THEN
-                     itype = 0         ! Set type to zero if there is a problem in the string conversion
-                  ENDIF
-                  IF ( ANY (idailyavtypes == itype ) ) THEN
-                     inpfiles(jj)%ptim(ji) = &
-                     & INT(inpfiles(jj)%ptim(ji)) + 1
-                  ENDIF
+                     ! Set type to zero if there is a problem in the string conversion
+                     itype = 0
+                  ENDIF
+
+                  IF ( ANY ( idailyavtypes(:) == itype ) ) THEN
+                  !  for daily averaged data force the time
+                  !  to be the last time-step of the day, but still within the day.
+                     IF ( inpfiles(jj)%ptim(ji) >= 0. ) THEN
+                        inpfiles(jj)%ptim(ji) = &
+                           & INT(inpfiles(jj)%ptim(ji)) + 0.9999
+                     ELSE
+                        inpfiles(jj)%ptim(ji) = &
+                           & INT(inpfiles(jj)%ptim(ji)) - 0.0001
+                     ENDIF
+                  ENDIF
+
                END DO
-            ENDIF
-            
+
+            ENDIF
+
             IF ( inpfiles(jj)%nobs > 0 ) THEN
-               inpfiles(jj)%iproc = -1
-               inpfiles(jj)%iobsi = -1
-               inpfiles(jj)%iobsj = -1
+               inpfiles(jj)%iproc(:,:) = -1
+               inpfiles(jj)%iobsi(:,:) = -1
+               inpfiles(jj)%iobsj(:,:) = -1
             ENDIF
             inowin = 0
@@ -318,7 +317,10 @@
             ALLOCATE( zlam(inowin)  )
             ALLOCATE( zphi(inowin)  )
-            ALLOCATE( iobsi(inowin) )
-            ALLOCATE( iobsj(inowin) )
-            ALLOCATE( iproc(inowin) )
+            ALLOCATE( iobsi1(inowin) )
+            ALLOCATE( iobsj1(inowin) )
+            ALLOCATE( iproc1(inowin) )
+            ALLOCATE( iobsi2(inowin) )
+            ALLOCATE( iobsj2(inowin) )
+            ALLOCATE( iproc2(inowin) )
             inowin = 0
             DO ji = 1, inpfiles(jj)%nobs
@@ -334,5 +336,16 @@
             END DO
 
-            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+            IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN
+               CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, &
+                  &                  iproc1, 'T' )
+               iobsi2(:) = iobsi1(:)
+               iobsj2(:) = iobsj1(:)
+               iproc2(:) = iproc1(:)
+            ELSEIF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN
+               CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, &
+                  &                  iproc1, 'U' )
+               CALL obs_grid_search( inowin, zlam, zphi, iobsi2, iobsj2, &
+                  &                  iproc2, 'V' )
+            ENDIF
 
             inowin = 0
@@ -344,10 +357,18 @@
                   & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
                   inowin = inowin + 1
-                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
-                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
-                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+                  inpfiles(jj)%iproc(ji,1) = iproc1(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi1(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj1(inowin)
+                  inpfiles(jj)%iproc(ji,2) = iproc2(inowin)
+                  inpfiles(jj)%iobsi(ji,2) = iobsi2(inowin)
+                  inpfiles(jj)%iobsj(ji,2) = iobsj2(inowin)
+                  IF ( inpfiles(jj)%iproc(ji,1) /= &
+                     & inpfiles(jj)%iproc(ji,2) ) THEN
+                     CALL ctl_stop( 'Error in obs_read_prof:', &
+                        & 'var1 and var2 observation on different processors')
+                  ENDIF
                ENDIF
             END DO
-            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+            DEALLOCATE( zlam, zphi, iobsi1, iobsj1, iproc1, iobsi2, iobsj2, iproc2 )
 
             DO ji = 1, inpfiles(jj)%nobs
@@ -363,5 +384,5 @@
                   ENDIF
                   llvalprof = .FALSE.
-                  IF ( ldt3d ) THEN
+                  IF ( ldvar1 ) THEN
                      loop_t_count : DO ij = 1,inpfiles(jj)%nlev
                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
@@ -369,9 +390,9 @@
                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                           it3dt0 = it3dt0 + 1
+                           ivar1t0 = ivar1t0 + 1
                         ENDIF
                      END DO loop_t_count
                   ENDIF
-                  IF ( lds3d ) THEN
+                  IF ( ldvar2 ) THEN
                      loop_s_count : DO ij = 1,inpfiles(jj)%nlev
                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
@@ -379,5 +400,5 @@
                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                           is3dt0 = is3dt0 + 1
+                           ivar2t0 = ivar2t0 + 1
                         ENDIF
                      END DO loop_s_count
@@ -388,8 +409,8 @@
                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
-                        &     ldt3d ) .OR. &
+                        &     ldvar1 ) .OR. &
                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
-                        &     lds3d ) ) THEN
+                        &     ldvar2 ) ) THEN
                         ip3dt = ip3dt + 1
                         llvalprof = .TRUE.
@@ -405,5 +426,5 @@
 
       END DO prof_files
-      
+
       !-----------------------------------------------------------------------
       ! Get the time ordered indices of the input data
@@ -446,5 +467,5 @@
          &               zdat,     &
          &               iindx   )
-      
+
       iv3dt(:) = -1
       IF (ldsatt) THEN
@@ -452,29 +473,29 @@
          iv3dt(2) = ip3dt
       ELSE
-         iv3dt(1) = it3dt0
-         iv3dt(2) = is3dt0
+         iv3dt(1) = ivar1t0
+         iv3dt(2) = ivar2t0
       ENDIF
       CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, &
          &                 kstp, jpi, jpj, jpk )
-      
+
       ! * Read obs/positions, QC, all variable and assign to profdata
 
       profdata%nprof     = 0
       profdata%nvprot(:) = 0
-
+      profdata%cvars(:)  = clvars(:)
       iprof = 0
 
       ip3dt = 0
-      it3dt = 0
-      is3dt = 0
-      itypt   (:) = 0
-      ityptmpp(:) = 0
-      
-      ityps   (:) = 0
-      itypsmpp(:) = 0
-      
-      ioserrcount = 0      
+      ivar1t = 0
+      ivar2t = 0
+      itypvar1   (:) = 0
+      itypvar1mpp(:) = 0
+
+      itypvar2   (:) = 0
+      itypvar2mpp(:) = 0
+
+      ioserrcount = 0
       DO jk = 1, iproftot
-         
+
          jj = ifileidx(iindx(jk))
          ji = iprofidx(iindx(jk))
@@ -486,5 +507,5 @@
          IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
             & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
-            
+
             IF ( nproc == 0 ) THEN
                IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
@@ -492,5 +513,5 @@
                IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
             ENDIF
-            
+
             llvalprof = .FALSE.
 
@@ -501,30 +522,30 @@
 
             loop_prof : DO ij = 1, inpfiles(jj)%nlev
-               
+
                IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
                   & CYCLE
-               
+
                IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                  
+
                   llvalprof = .TRUE. 
                   EXIT loop_prof
-                  
+
                ENDIF
-               
+
                IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                  
+
                   llvalprof = .TRUE. 
                   EXIT loop_prof
-                  
+
                ENDIF
-               
+
             END DO loop_prof
-            
+
             ! Set profile information
-            
+
             IF ( llvalprof ) THEN
-               
+
                iprof = iprof + 1
 
@@ -545,5 +566,5 @@
                profdata%nhou(iprof) = ihou
                profdata%nmin(iprof) = imin
-               
+
                ! Profile space coordinates
                profdata%rlam(iprof) = inpfiles(jj)%plam(ji)
@@ -551,10 +572,12 @@
 
                ! Coordinate search parameters
-               profdata%mi  (iprof,:) = inpfiles(jj)%iobsi(ji,1)
-               profdata%mj  (iprof,:) = inpfiles(jj)%iobsj(ji,1)
-               
+               profdata%mi  (iprof,1) = inpfiles(jj)%iobsi(ji,1)
+               profdata%mj  (iprof,1) = inpfiles(jj)%iobsj(ji,1)
+               profdata%mi  (iprof,2) = inpfiles(jj)%iobsi(ji,2)
+               profdata%mj  (iprof,2) = inpfiles(jj)%iobsj(ji,2)
+
                ! Profile WMO number
                profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji)
-               
+
                ! Instrument type
                READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype
@@ -564,7 +587,7 @@
                   itype = 0
                ENDIF
-               
+
                profdata%ntyp(iprof) = itype
-               
+
                ! QC stuff
 
@@ -585,6 +608,6 @@
                profdata%nqc(iprof)  = 0 !TODO
 
-               loop_p : DO ij = 1, inpfiles(jj)%nlev            
-                  
+               loop_p : DO ij = 1, inpfiles(jj)%nlev
+
                   IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
                      & CYCLE
@@ -594,135 +617,137 @@
                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
-                        &     ldt3d ) .OR. &
+                        &     ldvar1 ) .OR. &
                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
-                        &     lds3d ) ) THEN
+                        &     ldvar2 ) ) THEN
                         ip3dt = ip3dt + 1
                      ELSE
                         CYCLE
                      ENDIF
-                     
+
                   ENDIF
 
                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
                      &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
-                     &       ldt3d ) .OR. ldsatt ) THEN
-                     
+                     &       ldvar1 ) .OR. ldsatt ) THEN
+
                      IF (ldsatt) THEN
 
-                        it3dt = ip3dt
+                        ivar1t = ip3dt
 
                      ELSE
 
-                        it3dt = it3dt + 1
-                        
+                        ivar1t = ivar1t + 1
+
                      ENDIF
 
-                     ! Depth of T observation
-                     profdata%var(1)%vdep(it3dt) = &
+                     ! Depth of var1 observation
+                     profdata%var(1)%vdep(ivar1t) = &
                         &                inpfiles(jj)%pdep(ij,ji)
-                     
-                     ! Depth of T observation QC
-                     profdata%var(1)%idqc(it3dt) = &
+
+                     ! Depth of var1 observation QC
+                     profdata%var(1)%idqc(ivar1t) = &
                         &                inpfiles(jj)%idqc(ij,ji)
-                     
-                     ! Depth of T observation QC flags
-                     profdata%var(1)%idqcf(:,it3dt) = &
+
+                     ! Depth of var1 observation QC flags
+                     profdata%var(1)%idqcf(:,ivar1t) = &
                         &                inpfiles(jj)%idqcf(:,ij,ji)
-                     
+
                      ! Profile index
-                     profdata%var(1)%nvpidx(it3dt) = iprof
-                     
+                     profdata%var(1)%nvpidx(ivar1t) = iprof
+
                      ! Vertical index in original profile
-                     profdata%var(1)%nvlidx(it3dt) = ij
-
-                     ! Profile potential T value
+                     profdata%var(1)%nvlidx(ivar1t) = ij
+
+                     ! Profile var1 value
                      IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
                         & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                        profdata%var(1)%vobs(it3dt) = &
+                        profdata%var(1)%vobs(ivar1t) = &
                            &                inpfiles(jj)%pob(ij,ji,1)
                         IF ( ldmod ) THEN
-                           profdata%var(1)%vmod(it3dt) = &
+                           profdata%var(1)%vmod(ivar1t) = &
                               &                inpfiles(jj)%padd(ij,ji,1,1)
                         ENDIF
-                        ! Count number of profile T data as function of type
-                        itypt( profdata%ntyp(iprof) + 1 ) = &
-                           & itypt( profdata%ntyp(iprof) + 1 ) + 1
+                        ! Count number of profile var1 data as function of type
+                        itypvar1( profdata%ntyp(iprof) + 1 ) = &
+                           & itypvar1( profdata%ntyp(iprof) + 1 ) + 1
                      ELSE
-                        profdata%var(1)%vobs(it3dt) = fbrmdi
+                        profdata%var(1)%vobs(ivar1t) = fbrmdi
                      ENDIF
 
-                     ! Profile T qc
-                     profdata%var(1)%nvqc(it3dt) = &
+                     ! Profile var1 qc
+                     profdata%var(1)%nvqc(ivar1t) = &
                         & inpfiles(jj)%ivlqc(ij,ji,1)
 
-                     ! Profile T qc flags
-                     profdata%var(1)%nvqcf(:,it3dt) = &
+                     ! Profile var1 qc flags
+                     profdata%var(1)%nvqcf(:,ivar1t) = &
                         & inpfiles(jj)%ivlqcf(:,ij,ji,1)
 
                      ! Profile insitu T value
-                     profdata%var(1)%vext(it3dt,1) = &
-                        &                inpfiles(jj)%pext(ij,ji,1)
-                     
-                  ENDIF
-                  
+                     IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN
+                        profdata%var(1)%vext(ivar1t,1) = &
+                           &                inpfiles(jj)%pext(ij,ji,1)
+                     ENDIF
+
+                  ENDIF
+
                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
                      &   ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
-                     &   lds3d ) .OR. ldsatt ) THEN
-                     
+                     &   ldvar2 ) .OR. ldsatt ) THEN
+
                      IF (ldsatt) THEN
 
-                        is3dt = ip3dt
+                        ivar2t = ip3dt
 
                      ELSE
 
-                        is3dt = is3dt + 1
-                        
+                        ivar2t = ivar2t + 1
+
                      ENDIF
 
-                     ! Depth of S observation
-                     profdata%var(2)%vdep(is3dt) = &
+                     ! Depth of var2 observation
+                     profdata%var(2)%vdep(ivar2t) = &
                         &                inpfiles(jj)%pdep(ij,ji)
-                     
-                     ! Depth of S observation QC
-                     profdata%var(2)%idqc(is3dt) = &
+
+                     ! Depth of var2 observation QC
+                     profdata%var(2)%idqc(ivar2t) = &
                         &                inpfiles(jj)%idqc(ij,ji)
-                     
-                     ! Depth of S observation QC flags
-                     profdata%var(2)%idqcf(:,is3dt) = &
+
+                     ! Depth of var2 observation QC flags
+                     profdata%var(2)%idqcf(:,ivar2t) = &
                         &                inpfiles(jj)%idqcf(:,ij,ji)
-                     
+
                      ! Profile index
-                     profdata%var(2)%nvpidx(is3dt) = iprof
-                     
+                     profdata%var(2)%nvpidx(ivar2t) = iprof
+
                      ! Vertical index in original profile
-                     profdata%var(2)%nvlidx(is3dt) = ij
-
-                     ! Profile S value
+                     profdata%var(2)%nvlidx(ivar2t) = ij
+
+                     ! Profile var2 value
                      IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
                         & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                        profdata%var(2)%vobs(is3dt) = &
+                        profdata%var(2)%vobs(ivar2t) = &
                            &                inpfiles(jj)%pob(ij,ji,2)
                         IF ( ldmod ) THEN
-                           profdata%var(2)%vmod(is3dt) = &
+                           profdata%var(2)%vmod(ivar2t) = &
                               &                inpfiles(jj)%padd(ij,ji,1,2)
                         ENDIF
-                        ! Count number of profile S data as function of type
-                        ityps( profdata%ntyp(iprof) + 1 ) = &
-                           & ityps( profdata%ntyp(iprof) + 1 ) + 1
+                        ! Count number of profile var2 data as function of type
+                        itypvar2( profdata%ntyp(iprof) + 1 ) = &
+                           & itypvar2( profdata%ntyp(iprof) + 1 ) + 1
                      ELSE
-                        profdata%var(2)%vobs(is3dt) = fbrmdi
+                        profdata%var(2)%vobs(ivar2t) = fbrmdi
                      ENDIF
-                     
-                     ! Profile S qc
-                     profdata%var(2)%nvqc(is3dt) = &
+
+                     ! Profile var2 qc
+                     profdata%var(2)%nvqc(ivar2t) = &
                         & inpfiles(jj)%ivlqc(ij,ji,2)
 
-                     ! Profile S qc flags
-                     profdata%var(2)%nvqcf(:,is3dt) = &
+                     ! Profile var2 qc flags
+                     profdata%var(2)%nvqcf(:,ivar2t) = &
                         & inpfiles(jj)%ivlqcf(:,ij,ji,2)
 
                   ENDIF
-            
+
                END DO loop_p
 
@@ -736,12 +761,12 @@
       ! Sum up over processors
       !-----------------------------------------------------------------------
-      
-      CALL obs_mpp_sum_integer ( it3dt0, it3dtmpp )
-      CALL obs_mpp_sum_integer ( is3dt0, is3dtmpp )
-      CALL obs_mpp_sum_integer ( ip3dt, ip3dtmpp )
-      
-      CALL obs_mpp_sum_integers( itypt, ityptmpp, ntyp1770 + 1 )
-      CALL obs_mpp_sum_integers( ityps, itypsmpp, ntyp1770 + 1 )
-      
+
+      CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp )
+      CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp )
+      CALL obs_mpp_sum_integer ( ip3dt,   ip3dtmpp  )
+
+      CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 )
+      CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 )
+
       !-----------------------------------------------------------------------
       ! Output number of observations.
@@ -749,14 +774,14 @@
       IF(lwp) THEN
          WRITE(numout,*) 
-         WRITE(numout,'(1X,A)') 'Profile data'
+         WRITE(numout,'(A)') ' Profile data'
          WRITE(numout,'(1X,A)') '------------'
          WRITE(numout,*) 
-         WRITE(numout,'(1X,A)') 'Profile T data'
-         WRITE(numout,'(1X,A)') '--------------'
+         WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(1) )
+         WRITE(numout,'(1X,A)') '------------------------'
          DO ji = 0, ntyp1770
-            IF ( ityptmpp(ji+1) > 0 ) THEN
+            IF ( itypvar1mpp(ji+1) > 0 ) THEN
                WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), &
                   & cwmonam1770(ji)(1:52),' = ', &
-                  & ityptmpp(ji+1)
+                  & itypvar1mpp(ji+1)
             ENDIF
          END DO
@@ -764,16 +789,16 @@
             & '---------------------------------------------------------------'
          WRITE(numout,'(1X,A55,I8)') &
-            & 'Total profile T data                                 = ',&
-            & it3dtmpp
+            & 'Total profile data for variable '//TRIM( profdata%cvars(1) )// &
+            & '             = ', ivar1tmpp
          WRITE(numout,'(1X,A)') &
             & '---------------------------------------------------------------'
          WRITE(numout,*) 
-         WRITE(numout,'(1X,A)') 'Profile S data'
-         WRITE(numout,'(1X,A)') '--------------'
+         WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) )
+         WRITE(numout,'(1X,A)') '------------------------'
          DO ji = 0, ntyp1770
-            IF ( itypsmpp(ji+1) > 0 ) THEN
+            IF ( itypvar2mpp(ji+1) > 0 ) THEN
                WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), &
                   & cwmonam1770(ji)(1:52),' = ', &
-                  & itypsmpp(ji+1)
+                  & itypvar2mpp(ji+1)
             ENDIF
          END DO
@@ -781,11 +806,11 @@
             & '---------------------------------------------------------------'
          WRITE(numout,'(1X,A55,I8)') &
-            & 'Total profile S data                                 = ',&
-            & is3dtmpp
+            & 'Total profile data for variable '//TRIM( profdata%cvars(2) )// &
+            & '             = ', ivar2tmpp
          WRITE(numout,'(1X,A)') &
             & '---------------------------------------------------------------'
          WRITE(numout,*) 
       ENDIF
-      
+
       IF (ldsatt) THEN
          profdata%nvprot(1)    = ip3dt
@@ -794,8 +819,8 @@
          profdata%nvprotmpp(2) = ip3dtmpp
       ELSE
-         profdata%nvprot(1)    = it3dt
-         profdata%nvprot(2)    = is3dt
-         profdata%nvprotmpp(1) = it3dtmpp
-         profdata%nvprotmpp(2) = is3dtmpp
+         profdata%nvprot(1)    = ivar1t
+         profdata%nvprot(2)    = ivar2t
+         profdata%nvprotmpp(1) = ivar1tmpp
+         profdata%nvprotmpp(2) = ivar2tmpp
       ENDIF
       profdata%nprof        = iprof
@@ -804,15 +829,15 @@
       ! Model level search
       !-----------------------------------------------------------------------
-      IF ( ldt3d ) THEN
+      IF ( ldvar1 ) THEN
          CALL obs_level_search( jpk, gdept_1d, &
             & profdata%nvprot(1), profdata%var(1)%vdep, &
             & profdata%var(1)%mvk )
       ENDIF
-      IF ( lds3d ) THEN
+      IF ( ldvar2 ) THEN
          CALL obs_level_search( jpk, gdept_1d, &
             & profdata%nvprot(2), profdata%var(2)%vdep, &
             & profdata%var(2)%mvk )
       ENDIF
-      
+
       !-----------------------------------------------------------------------
       ! Set model equivalent to 99999
@@ -826,5 +851,5 @@
       ! Deallocate temporary data
       !-----------------------------------------------------------------------
-      DEALLOCATE( ifileidx, iprofidx, zdat )
+      DEALLOCATE( ifileidx, iprofidx, zdat, clvars )
 
       !-----------------------------------------------------------------------
@@ -836,5 +861,5 @@
       DEALLOCATE( inpfiles )
 
-   END SUBROUTINE obs_rea_pro_dri
+   END SUBROUTINE obs_rea_prof
 
 END MODULE obs_read_prof
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90	(revision 6807)
+++ 	(revision )
@@ -1,465 +1,0 @@
-MODULE obs_read_seaice
-   !!======================================================================
-   !!                       ***  MODULE obs_read_seaice  ***
-   !! Observation diagnostics: Read the along track SEAICE data from
-   !!                          GHRSST or any SEAICE data from feedback files
-   !!======================================================================
-
-   !!----------------------------------------------------------------------
-   !!   obs_rea_seaice : Driver for reading seaice data from the GHRSST/feedback
-   !!----------------------------------------------------------------------
-
-   !! * Modules used   
-   USE par_kind                 ! Precision variables
-   USE in_out_manager           ! I/O manager
-   USE dom_oce                  ! Ocean space and time domain variables
-   USE obs_mpp                  ! MPP support routines for observation diagnostics
-   USE julian                   ! Julian date routines
-   USE obs_utils                ! Observation operator utility functions
-   USE obs_grid                 ! Grid search
-   USE obs_sort                 ! Sorting observation arrays
-   USE obs_surf_def             ! Surface observation definitions
-   USE obs_types                ! Observation type definitions
-   USE obs_seaice_io            ! I/O for seaice files
-   USE iom                      ! I/O of fields for Reynolds data
-   USE netcdf                   ! NetCDF library
-
-   IMPLICIT NONE
-
-   !! * Routine accessibility
-   PRIVATE
-
-   PUBLIC obs_rea_seaice      ! Read the seaice observations from the point data
-   
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE obs_rea_seaice( kformat, &
-      &                    seaicedata, knumfiles, cfilenames, &
-      &                    kvars, kextr, kstp, ddobsini, ddobsend, &
-      &                    ldignmis, ldmod )
-      !!---------------------------------------------------------------------
-      !!
-      !!                   *** ROUTINE obs_rea_seaice ***
-      !!
-      !! ** Purpose : Read from file the seaice data
-      !!
-      !! ** Method  : Depending on kformat either AVISO or
-      !!              feedback data files are read
-      !!
-      !! ** Action  : 
-      !!
-      !!
-      !! History :  
-      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
-      !!----------------------------------------------------------------------
-      !! * Modules used
-
-      !! * Arguments
-      INTEGER :: kformat   ! Format of input data 
-      !                    ! 0: Feedback
-      !                    ! 1: GHRSST
-      TYPE(obs_surf), INTENT(INOUT) :: &
-         & seaicedata     ! seaice data to be read
-      INTEGER, INTENT(IN) :: knumfiles   ! Number of corio format files to read in
-      CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in
-      INTEGER, INTENT(IN) :: kvars    ! Number of variables in seaicedata
-      INTEGER, INTENT(IN) :: kextr    ! Number of extra fields for each var in seaicedata
-      INTEGER, INTENT(IN) :: kstp     ! Ocean time-step index
-      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
-      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
-      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS
-      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS
-         
-      !! * Local declarations
-      CHARACTER(LEN=14), PARAMETER :: cpname='obs_rea_seaice'
-      INTEGER :: ji
-      INTEGER :: jj
-      INTEGER :: jk
-      INTEGER :: iflag
-      INTEGER :: inobf
-      INTEGER :: i_file_id
-      INTEGER :: inowin
-      INTEGER :: iyea
-      INTEGER :: imon
-      INTEGER :: iday
-      INTEGER :: ihou
-      INTEGER :: imin
-      INTEGER :: isec
-      INTEGER, DIMENSION(knumfiles) :: &
-         & irefdate
-      INTEGER :: iobsmpp
-      INTEGER, PARAMETER :: iseaicemaxtype = 1024
-      INTEGER, DIMENSION(0:iseaicemaxtype) :: &
-         & ityp, &
-         & itypmpp
-      INTEGER, DIMENSION(:), ALLOCATABLE :: &
-         & iobsi,    &
-         & iobsj,    &
-         & iproc,    &
-         & iindx,    &
-         & ifileidx, &
-         & iseaiceidx
-      INTEGER :: itype
-      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
-         & zphi, &
-         & zlam
-      real(wp), DIMENSION(:), ALLOCATABLE :: &
-         & zdat
-      LOGICAL :: llvalprof
-      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
-         & inpfiles
-      real(wp), DIMENSION(knumfiles) :: &
-         & djulini, &
-         & djulend
-      INTEGER :: iobs
-      INTEGER :: iobstot
-      INTEGER :: ios
-      INTEGER :: ioserrcount
-      CHARACTER(len=8) :: cl_refdate
-   
-      ! Local initialization
-      iobs = 0
- 
-      !-----------------------------------------------------------------------
-      ! Check data the model part is just with feedback data files
-      !-----------------------------------------------------------------------
-      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
-         CALL ctl_stop( 'Model can only be read from feedback data' )
-         RETURN
-      ENDIF
-
-      !-----------------------------------------------------------------------
-      ! Count the number of files needed and allocate the obfbdata type
-      !-----------------------------------------------------------------------
-      
-      inobf = knumfiles
-      
-      ALLOCATE( inpfiles(inobf) )
-
-      seaice_files : DO jj = 1, inobf
-          
-         !---------------------------------------------------------------------
-         ! Prints
-         !---------------------------------------------------------------------
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) ' obs_rea_seaice : Reading from file = ', &
-               & TRIM( TRIM( cfilenames(jj) ) )
-            WRITE(numout,*) ' ~~~~~~~~~~~~~~'
-            WRITE(numout,*)
-         ENDIF
-
-         !---------------------------------------------------------------------
-         !  Initialization: Open file and get dimensions only
-         !---------------------------------------------------------------------
-         
-         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
-            &                      i_file_id )
-         
-         IF ( iflag /= nf90_noerr ) THEN
-
-            IF ( ldignmis ) THEN
-               inpfiles(jj)%nobs = 0
-               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
-                  &           ' not found' )
-            ELSE 
-               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
-                  &           ' not found' )
-            ENDIF
-
-         ELSE 
-            
-            !------------------------------------------------------------------
-            !  Close the file since it is opened in read_proffile
-            !------------------------------------------------------------------
-            
-            iflag = nf90_close( i_file_id )
-
-            !------------------------------------------------------------------
-            !  Read the profile file into inpfiles
-            !------------------------------------------------------------------
-            IF ( kformat == 0 ) THEN
-               CALL init_obfbdata( inpfiles(jj) )
-               IF(lwp) THEN
-                  WRITE(numout,*)
-                  WRITE(numout,*)'Reading from feedback file :', &
-                     &           TRIM( cfilenames(jj) )
-               ENDIF
-               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
-                  &                ldgrid = .TRUE. )
-               IF ( ldmod .AND. ( ( inpfiles(jj)%nadd == 0 ) .OR.&
-                  &               ( inpfiles(jj)%next < 2 ) ) ) THEN
-                  CALL ctl_stop( 'Model not in input data' )
-                  RETURN
-               ENDIF
-            ELSEIF ( kformat == 1) THEN
-               CALL read_seaice( TRIM( cfilenames(jj) ), inpfiles(jj), &
-               &                 numout, lwp, .TRUE. )
-            ELSE
-               CALL ctl_stop( 'File format unknown' )
-            ENDIF
-
-            !------------------------------------------------------------------
-            !  Change longitude (-180,180)
-            !------------------------------------------------------------------
-
-            DO ji = 1, inpfiles(jj)%nobs 
-
-               IF ( inpfiles(jj)%plam(ji) < -180. ) &
-                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
-
-               IF ( inpfiles(jj)%plam(ji) >  180. ) &
-                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
-
-            END DO
-
-            !------------------------------------------------------------------
-            !  Calculate the date  (change eventually)
-            !------------------------------------------------------------------
-            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
-            READ(cl_refdate,'(I8)') irefdate(jj)
-            
-            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
-            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
-               &           krefdate = irefdate(jj) )
-            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
-            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
-               &           krefdate = irefdate(jj) )
-            IF ( inpfiles(jj)%nobs > 0 ) THEN
-               inpfiles(jj)%iproc = -1
-               inpfiles(jj)%iobsi = -1
-               inpfiles(jj)%iobsj = -1
-            ENDIF
-            inowin = 0
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  inowin = inowin + 1
-               ENDIF
-            END DO
-            ALLOCATE( zlam(inowin)  )
-            ALLOCATE( zphi(inowin)  )
-            ALLOCATE( iobsi(inowin) )
-            ALLOCATE( iobsj(inowin) )
-            ALLOCATE( iproc(inowin) )
-            inowin = 0
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  inowin = inowin + 1
-                  zlam(inowin) = inpfiles(jj)%plam(ji)
-                  zphi(inowin) = inpfiles(jj)%pphi(ji)
-               ENDIF
-            END DO
-
-            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
-
-            inowin = 0
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  inowin = inowin + 1
-                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
-                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
-                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
-               ENDIF
-            END DO
-            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
-
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  IF ( nproc == 0 ) THEN
-                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
-                  ELSE
-                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
-                  ENDIF
-                  llvalprof = .FALSE.
-                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
-                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
-                     iobs = iobs + 1
-                  ENDIF
-               ENDIF
-            END DO
-
-         ENDIF
-
-      END DO seaice_files
-
-      !-----------------------------------------------------------------------
-      ! Get the time ordered indices of the input data
-      !-----------------------------------------------------------------------
-
-      !---------------------------------------------------------------------
-      !  Loop over input data files to count total number of profiles
-      !---------------------------------------------------------------------
-      iobstot = 0
-      DO jj = 1, inobf
-         DO ji = 1, inpfiles(jj)%nobs
-            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-               iobstot = iobstot + 1
-            ENDIF
-         END DO
-      END DO
-
-      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
-         &      iseaiceidx(iobstot), zdat(iobstot) )
-      jk = 0
-      DO jj = 1, inobf
-         DO ji = 1, inpfiles(jj)%nobs
-            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-               jk = jk + 1
-               ifileidx(jk) = jj
-               iseaiceidx(jk) = ji
-               zdat(jk)     = inpfiles(jj)%ptim(ji)
-            ENDIF
-         END DO
-      END DO
-      CALL sort_dp_indx( iobstot, &
-         &               zdat,     &
-         &               iindx   )
-      
-      CALL obs_surf_alloc( seaicedata, iobs, & 
-                           kvars, kextr, kstp, jpi, jpj )
-      
-      ! * Read obs/positions, QC, all variable and assign to seaicedata
- 
-      iobs = 0
-
-      ityp   (:) = 0
-      itypmpp(:) = 0
-
-      ioserrcount=0      
-
-      DO jk = 1, iobstot
-         
-         jj = ifileidx(iindx(jk))
-         ji = iseaiceidx(iindx(jk))
-         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
-            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
-            
-            IF ( nproc == 0 ) THEN
-               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
-            ELSE
-               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
-            ENDIF
-            
-            ! Set observation information
-            
-            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
-               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
-
-               iobs = iobs + 1
-
-               CALL jul2greg( isec,                   &
-                  &           imin,                   &
-                  &           ihou,                   &
-                  &           iday,                   &
-                  &           imon,                   &
-                  &           iyea,                   &
-                  &           inpfiles(jj)%ptim(ji), &
-                  &           irefdate(jj) )
-
-
-               ! seaice time coordinates
-               seaicedata%nyea(iobs) = iyea
-               seaicedata%nmon(iobs) = imon
-               seaicedata%nday(iobs) = iday
-               seaicedata%nhou(iobs) = ihou
-               seaicedata%nmin(iobs) = imin
-               
-               ! seaice space coordinates
-               seaicedata%rlam(iobs) = inpfiles(jj)%plam(ji)
-               seaicedata%rphi(iobs) = inpfiles(jj)%pphi(ji)
-
-               ! Coordinate search parameters
-               seaicedata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
-               seaicedata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
-               
-               ! Instrument type
-               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype
-901            IF ( ios /= 0 ) THEN
-                  IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' ) 
-                  ioserrcount = ioserrcount + 1
-                  itype = 0
-               ENDIF
-               seaicedata%ntyp(iobs) = itype
-               IF ( itype < iseaicemaxtype + 1 ) THEN
-                  ityp(itype+1) = ityp(itype+1) + 1
-               ELSE
-                  IF(lwp)WRITE(numout,*)'WARNING:Increase iseaicemaxtype in ',&
-                     &                  cpname
-               ENDIF
-
-               ! Bookkeeping data to match observations
-               seaicedata%nsidx(iobs) = iobs
-               seaicedata%nsfil(iobs) = iindx(jk)
-
-               ! QC flags
-               seaicedata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
-
-               ! Observed value
-               seaicedata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
-
-
-               ! Model and MDT is set to fbrmdi unless read from file
-               IF ( ldmod ) THEN
-                  seaicedata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
-               ELSE
-                  seaicedata%rmod(iobs,1) = fbrmdi
-               ENDIF
-            ENDIF
-         ENDIF
-
-      END DO
-
-      !-----------------------------------------------------------------------
-      ! Sum up over processors
-      !-----------------------------------------------------------------------
-      
-      CALL obs_mpp_sum_integer( iobs, iobsmpp )
-      
-      !-----------------------------------------------------------------------
-      ! Output number of observations.
-      !-----------------------------------------------------------------------
-      IF (lwp) THEN
-
-         WRITE(numout,*)
-         WRITE(numout,'(1X,A)')'Seaice data types'
-         WRITE(numout,'(1X,A)')'-----------------'
-         DO jj = 1,8
-            IF ( itypmpp(jj) > 0 ) THEN
-               WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj)
-            ENDIF
-         END DO
-         WRITE(numout,'(1X,A50)')'--------------------------------------------------'
-         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp
-         WRITE(numout,*)
-
-      ENDIF
-
-      !-----------------------------------------------------------------------
-      ! Deallocate temporary data
-      !-----------------------------------------------------------------------
-      DEALLOCATE( ifileidx, iseaiceidx, zdat )
-
-      !-----------------------------------------------------------------------
-      ! Deallocate input data
-      !-----------------------------------------------------------------------
-      DO jj = 1, inobf
-         CALL dealloc_obfbdata( inpfiles(jj) )
-      END DO
-      DEALLOCATE( inpfiles )
-
-   END SUBROUTINE obs_rea_seaice
-
-END MODULE obs_read_seaice
-
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90	(revision 6807)
+++ 	(revision )
@@ -1,548 +1,0 @@
-MODULE obs_read_sla
-   !!======================================================================
-   !!                       ***  MODULE obs_read_sla  ***
-   !! Observation diagnostics: Read the along track SLA data from
-   !!                          the AVISO/CLS database or any SLA data 
-   !!                          from feedback files
-   !!======================================================================
-
-   !!----------------------------------------------------------------------
-   !!   obs_rea_sla : Driver for reading SLA data from the AVISO/CLS/feedback
-   !!----------------------------------------------------------------------
-
-   !! * Modules used   
-   USE par_kind                 ! Precision variables
-   USE in_out_manager           ! I/O manager
-   USE dom_oce                  ! Ocean space and time domain variables
-   USE obs_mpp                  ! MPP support routines for observation diagnostics
-   USE julian                   ! Julian date routines
-   USE obs_utils                ! Observation operator utility functions
-   USE obs_grid                 ! Grid search
-   USE obs_sort                 ! Sorting observation arrays
-   USE obs_surf_def             ! Surface observation definitions
-   USE obs_types                ! Observation type definitions
-   USE obs_sla_io               ! I/O for sla files
-   USE netcdf                   ! NetCDF library
-
-   IMPLICIT NONE
-
-   !! * Routine accessibility
-   PRIVATE
-
-   PUBLIC obs_rea_sla  ! Read the SLA observations from the AVISO/SLA database
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE obs_rea_sla( kformat, &
-      &                    sladata, knumfiles, cfilenames, &
-      &                    kvars, kextr, kstp, ddobsini, ddobsend, &
-      &                    ldignmis, ldmod, ldobstd )
-      !!---------------------------------------------------------------------
-      !!
-      !!                   *** ROUTINE obs_rea_sla ***
-      !!
-      !! ** Purpose : Read from file the SLA data
-      !!
-      !! ** Method  : Depending on kformat either AVISO or
-      !!              feedback data files are read
-      !!
-      !! ** Action  : 
-      !!
-      !!
-      !! History :  
-      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
-      !!----------------------------------------------------------------------
-      !! * Modules used
-
-      !! * Arguments
-      INTEGER :: kformat    ! Format of input data
-      !                     ! 0: Feedback
-      !                     ! 1: AVISO
-      TYPE(obs_surf), INTENT(INOUT) :: sladata    ! SLA data to be read
-      INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in
-      CHARACTER(LEN=128), INTENT(IN) ::  &
-         & cfilenames(knumfiles) ! File names to read in
-      INTEGER, INTENT(IN) :: kvars     ! Number of variables in sladata
-      INTEGER, INTENT(IN) :: kextr     ! Number of extra fields for each var in sladata
-      INTEGER, INTENT(IN) :: kstp      ! Ocean time-step index
-      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files
-      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data
-      LOGICAL, INTENT(INOUT), optional :: &
-         & ldobstd        ! Read observation standard deviation from fb. file
-      REAL(KIND=dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS
-      REAL(KIND=dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS
-         
-      !! * Local declarations
-      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_sla'
-      INTEGER :: ji
-      INTEGER :: jj
-      INTEGER :: jk
-      INTEGER :: iflag
-      INTEGER :: inobf
-      INTEGER :: i_file_id
-      INTEGER :: inowin
-      INTEGER :: iyea
-      INTEGER :: imon
-      INTEGER :: iday
-      INTEGER :: ihou
-      INTEGER :: imin
-      INTEGER :: isec
-      INTEGER, DIMENSION(knumfiles) :: &
-         & irefdate
-      INTEGER :: iobsmpp
-      INTEGER, DIMENSION(imaxmissions+1) :: &
-         & ityp, &
-         & itypmpp
-      INTEGER, DIMENSION(:), ALLOCATABLE :: &
-         & iobsi,    &
-         & iobsj,    &
-         & iproc,    &
-         & iindx,    &
-         & ifileidx, &
-         & islaidx
-      INTEGER :: itype 
-      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
-         & zphi, &
-         & zlam
-      real(wp), DIMENSION(:), ALLOCATABLE :: &
-         & zdat
-      LOGICAL :: llvalprof
-      LOGICAL :: llobstd
-      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
-         & inpfiles
-      real(wp), DIMENSION(knumfiles) :: &
-         & djulini, &
-         & djulend
-      INTEGER, DIMENSION(knumfiles) :: &
-         & iobspos, &
-         & iobcpos
-      INTEGER :: iobs
-      INTEGER :: iobstot
-      INTEGER :: ios
-      INTEGER :: ioserrcount
-      CHARACTER(len=8) :: cl_refdate
-   
-      ! Local initialization
-      iobs = 0
-      IF ( PRESENT(ldobstd) ) THEN
-         IF (.NOT.ldmod) THEN
-            llobstd = .false.
-         ELSE
-            llobstd = ldobstd
-         ENDIF
-      ELSE
-         llobstd = .FALSE.
-      ENDIF
- 
-      !-----------------------------------------------------------------------
-      ! Check that the model part is just with feedback data files
-      !-----------------------------------------------------------------------
-      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
-         CALL ctl_stop( 'Model can only be read from feedback data' )
-         RETURN
-      ENDIF
-
-      !-----------------------------------------------------------------------
-      ! Check that the prescribed obs err is just with feedback data files
-      !-----------------------------------------------------------------------
-      IF ( llobstd .AND. ( kformat /= 0 ) ) THEN
-         CALL ctl_stop( 'Observation error can only be read from feedback files' )
-         RETURN
-      ENDIF
-
-      !-----------------------------------------------------------------------
-      ! Count the number of files needed and allocate the obfbdata type
-      !-----------------------------------------------------------------------
-      
-      inobf = knumfiles
-      
-      ALLOCATE( inpfiles(inobf) )
-
-      sla_files : DO jj = 1, inobf
-          
-         !---------------------------------------------------------------------
-         ! Prints
-         !---------------------------------------------------------------------
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) ' obs_rea_sla : Reading from file = ', &
-               & TRIM( TRIM( cfilenames(jj) ) )
-            WRITE(numout,*) ' ~~~~~~~~~~~'
-            WRITE(numout,*)
-         ENDIF
-
-         !---------------------------------------------------------------------
-         !  Initialization: Open file and get dimensions only
-         !---------------------------------------------------------------------
-         
-         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
-            &                      i_file_id )
-         
-         IF ( iflag /= nf90_noerr ) THEN
-
-            IF ( ldignmis ) THEN
-               inpfiles(jj)%nobs = 0
-               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
-                  &           ' not found' )
-            ELSE 
-               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
-                  &           ' not found' )
-            ENDIF
-
-         ELSE 
-            
-            !------------------------------------------------------------------
-            !  Close the file since it is opened in read_proffile
-            !------------------------------------------------------------------
-            
-            iflag = nf90_close( i_file_id )
-
-            !------------------------------------------------------------------
-            !  Read the profile file into inpfiles
-            !------------------------------------------------------------------
-            IF ( kformat == 0 ) THEN
-               CALL init_obfbdata( inpfiles(jj) )
-               IF(lwp) THEN
-                  WRITE(numout,*)
-                  WRITE(numout,*)'Reading from feedback file :', &
-                     &           TRIM( cfilenames(jj) )
-               ENDIF
-               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
-                  &                ldgrid = .TRUE. )
-               IF ( inpfiles(jj)%nvar < 1 ) THEN
-                  CALL ctl_stop( 'Feedback format error' )
-                  RETURN
-               ENDIF
-               IF ( TRIM(inpfiles(jj)%cname(1)) /= 'SLA' ) THEN
-                  CALL ctl_stop( 'Feedback format error' )
-                  RETURN
-               ENDIF 
-               IF ( ldmod .AND. ( ( inpfiles(jj)%nadd == 0 ) .OR.&
-                  &               ( inpfiles(jj)%next == 0 ) ) ) THEN
-                  CALL ctl_stop( 'Model not in input data' )
-                  RETURN
-               ENDIF
-            ELSEIF ( kformat == 1) THEN
-               CALL read_avisofile( TRIM( cfilenames(jj) ), inpfiles(jj), &
-               &                    numout, lwp, .TRUE. )
-            ELSE
-               CALL ctl_stop( 'File format unknown' )
-            ENDIF
-
-            !------------------------------------------------------------------
-            !  Change longitude (-180,180)
-            !------------------------------------------------------------------
-
-            DO ji = 1, inpfiles(jj)%nobs 
-
-               IF ( inpfiles(jj)%plam(ji) < -180. ) &
-                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
-
-               IF ( inpfiles(jj)%plam(ji) >  180. ) &
-                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
-
-            END DO
-
-            !------------------------------------------------------------------
-            !  Calculate the date  (change eventually)
-            !------------------------------------------------------------------
-            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
-            READ(cl_refdate,'(I8)') irefdate(jj)
-            
-            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
-            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
-               &           krefdate = irefdate(jj) )
-            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
-            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
-               &           krefdate = irefdate(jj) )
-            IF ( inpfiles(jj)%nobs > 0 ) THEN
-               inpfiles(jj)%iproc = -1
-               inpfiles(jj)%iobsi = -1
-               inpfiles(jj)%iobsj = -1
-            ENDIF
-            inowin = 0
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
-               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  inowin = inowin + 1
-               ENDIF
-            END DO
-            ALLOCATE( zlam(inowin)  )
-            ALLOCATE( zphi(inowin)  )
-            ALLOCATE( iobsi(inowin) )
-            ALLOCATE( iobsj(inowin) )
-            ALLOCATE( iproc(inowin) )
-            inowin = 0
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
-               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  inowin = inowin + 1
-                  zlam(inowin) = inpfiles(jj)%plam(ji)
-                  zphi(inowin) = inpfiles(jj)%pphi(ji)
-               ENDIF
-            END DO
-
-            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
-
-            inowin = 0
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
-               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  inowin = inowin + 1
-                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
-                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
-                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
-               ENDIF
-            END DO
-            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
-
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
-               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  IF ( nproc == 0 ) THEN
-                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
-                  ELSE
-                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
-                  ENDIF
-                  llvalprof = .FALSE.
-                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
-                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
-                     iobs = iobs + 1
-                  ENDIF
-               ENDIF
-            END DO
-
-         ENDIF
-      
-      END DO sla_files
-
-      IF (llobstd) THEN
-         
-         DO jj = 1, inobf
-            iobspos(jj) = -1
-            iobcpos(jj) = -1
-            DO ji = 1,inpfiles(jj)%nadd
-               IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'OSTD' ) THEN
-                  iobspos(jj)=ji
-               ENDIF
-               IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'OCNT' ) THEN
-                  iobcpos(jj)=ji
-               ENDIF
-            END DO
-         END DO
-         llobstd = ( ( MINVAL(iobspos) > 0 ) .AND. ( MINVAL(iobcpos) > 0 ) )
-         IF (llobstd) THEN
-            IF (lwp) WRITE(numout,*)'SLA superobs information present.'
-         ELSE
-            IF (lwp) WRITE(numout,*)'SLA superobs information not present.'
-         ENDIF
-
-      ENDIF
-      
-      !-----------------------------------------------------------------------
-      ! Get the time ordered indices of the input data
-      !-----------------------------------------------------------------------
-
-      !---------------------------------------------------------------------
-      !  Loop over input data files to count total number of profiles
-      !---------------------------------------------------------------------
-      iobstot = 0
-      DO jj = 1, inobf
-         DO ji = 1, inpfiles(jj)%nobs
-            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
-            IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
-            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-               iobstot = iobstot + 1
-            ENDIF
-         END DO
-      END DO
-
-      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
-         &      islaidx(iobstot), zdat(iobstot) )
-      jk = 0
-      DO jj = 1, inobf
-         DO ji = 1, inpfiles(jj)%nobs
-            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
-            IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
-            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-               jk = jk + 1
-               ifileidx(jk) = jj
-               islaidx(jk) = ji
-               zdat(jk)     = inpfiles(jj)%ptim(ji)
-            ENDIF
-         END DO
-      END DO
-      CALL sort_dp_indx( iobstot, &
-         &               zdat,     &
-         &               iindx   )
-      
-      CALL obs_surf_alloc( sladata, iobs, kvars, kextr, kstp, jpi, jpj )
-      
-      ! * Read obs/positions, QC, all variable and assign to sladata
- 
-      iobs = 0
-
-      ityp   (:) = 0
-      itypmpp(:) = 0
-
-      ioserrcount = 0
-      
-      DO jk = 1, iobstot
-         
-         jj = ifileidx(iindx(jk))
-         ji = islaidx(iindx(jk))
-
-         IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
-         IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
-
-         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
-            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
-            
-            IF ( nproc == 0 ) THEN
-               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
-            ELSE
-               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
-            ENDIF
-            
-            ! Set observation information
-            
-            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
-               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
-
-               iobs = iobs + 1
-
-               CALL jul2greg( isec,                   &
-                  &           imin,                   &
-                  &           ihou,                   &
-                  &           iday,                   &
-                  &           imon,                   &
-                  &           iyea,                   &
-                  &           inpfiles(jj)%ptim(ji), &
-                  &           irefdate(jj) )
-
-
-               ! SLA time coordinates
-               sladata%nyea(iobs) = iyea
-               sladata%nmon(iobs) = imon
-               sladata%nday(iobs) = iday
-               sladata%nhou(iobs) = ihou
-               sladata%nmin(iobs) = imin
-               
-               ! SLA space coordinates
-               sladata%rlam(iobs) = inpfiles(jj)%plam(ji)
-               sladata%rphi(iobs) = inpfiles(jj)%pphi(ji)
-
-               ! Coordinate search parameters
-               sladata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
-               sladata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
-               
-               ! Instrument type
-               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype
-901            IF ( ios /= 0 ) THEN
-                  IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' ) 
-                  ioserrcount = ioserrcount + 1
-                  itype = 0
-               ENDIF
-               sladata%ntyp(iobs) = itype
-               ityp(itype+1) = ityp(itype+1) + 1
-
-               ! Identifier
-               sladata%cwmo(iobs) = inpfiles(jj)%cdwmo(ji)
-
-               ! Bookkeeping data to match observations
-               sladata%nsidx(iobs) = iobs
-               sladata%nsfil(iobs) = iindx(jk)
-
-               ! QC flags
-               sladata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
-
-               ! Observed value
-               sladata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
-
-
-               ! Model and MDT is set to fbrmdi unless read from file
-               IF ( ldmod ) THEN
-                  sladata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
-                  sladata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1)
-                  sladata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1)
-                  IF (llobstd) THEN
-                     sladata%rext(iobs,3) = &
-                        & inpfiles(jj)%padd(1,ji,iobspos(jj),1)
-                     sladata%rext(iobs,4) = &
-                        & inpfiles(jj)%padd(1,ji,iobcpos(jj),1)
-                  ENDIF
-               ELSE
-                  sladata%rmod(iobs,1) = fbrmdi
-                  sladata%rext(iobs,:) = fbrmdi
-               ENDIF
-
-            ENDIF
-         ENDIF
-
-      END DO
-
-      !-----------------------------------------------------------------------
-      ! Sum up over processors
-      !-----------------------------------------------------------------------
-      
-      CALL obs_mpp_sum_integer( iobs, iobsmpp )
-      CALL obs_mpp_sum_integers( ityp, itypmpp, imaxmissions + 1 )
-      
-      !-----------------------------------------------------------------------
-      ! Output number of observations.
-      !-----------------------------------------------------------------------
-      IF (lwp) THEN
-
-         WRITE(numout,*)
-         WRITE(numout,'(1X,A)')'Altimeter satellites'
-         WRITE(numout,'(1X,A)')'--------------------'
-         DO jj = 1,8
-            IF ( itypmpp(jj) > 0 ) THEN
-               WRITE(numout,'(1X,A38,A2,I10)')calttyp(jj-1),'= ',itypmpp(jj)
-            ENDIF
-         END DO
-         WRITE(numout,'(1X,A50)')'--------------------------------------------------'
-         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp
-         WRITE(numout,*)
-
-      ENDIF
-
-      !-----------------------------------------------------------------------
-      ! Deallocate temporary data
-      !-----------------------------------------------------------------------
-      DEALLOCATE( ifileidx, islaidx, zdat )
-
-      !-----------------------------------------------------------------------
-      ! Deallocate input data
-      !-----------------------------------------------------------------------
-      DO jj = 1, inobf
-         CALL dealloc_obfbdata( inpfiles(jj) )
-      END DO
-      DEALLOCATE( inpfiles )
-
-      !-----------------------------------------------------------------------
-      ! Reset ldobstd if the data is present
-      !-----------------------------------------------------------------------
-      IF ( PRESENT(ldobstd) ) THEN
-         ldobstd = llobstd
-      ENDIF
-
-   END SUBROUTINE obs_rea_sla
-
-END MODULE obs_read_sla
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90	(revision 6807)
+++ 	(revision )
@@ -1,771 +1,0 @@
-MODULE obs_read_sst
-   !!======================================================================
-   !!                       ***  MODULE obs_read_sst  ***
-   !! Observation diagnostics: Read the SST data from the GHRSST database 
-   !!                          or any SST data from feedback files
-   !!======================================================================
-
-   !!----------------------------------------------------------------------
-   !!   obs_rea_sst : Driver for reading SST data from the GHRSST/feedback
-   !!   obs_rea_sst_rey : Driver for reading SST data from Reynolds
-   !!----------------------------------------------------------------------
-
-   !! * Modules used   
-   USE par_kind                 ! Precision variables
-   USE in_out_manager           ! I/O manager
-   USE dom_oce                  ! Ocean space and time domain variables
-   USE obs_mpp                  ! MPP support routines for observation diagnostics
-   USE julian                   ! Julian date routines
-   USE obs_utils                ! Observation operator utility functions
-   USE obs_grid                 ! Grid search
-   USE obs_sort                 ! Sorting observation arrays
-   USE obs_surf_def             ! Surface observation definitions
-   USE obs_types                ! Observation type definitions
-   USE obs_sst_io               ! I/O for sst files
-   USE iom                      ! I/O of fields for Reynolds data
-   USE netcdf                   ! NetCDF library
-
-   IMPLICIT NONE
-
-   !! * Routine accessibility
-   PRIVATE
-
-   PUBLIC obs_rea_sst      ! Read the SST observations from the point data
-   PUBLIC obs_rea_sst_rey  ! Read the gridded Reynolds SST 
-   
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE obs_rea_sst( kformat, &
-      &                    sstdata, knumfiles, cfilenames, &
-      &                    kvars, kextr, kstp, ddobsini, ddobsend, &
-      &                    ldignmis, ldmod )
-      !!---------------------------------------------------------------------
-      !!
-      !!                   *** ROUTINE obs_rea_sst ***
-      !!
-      !! ** Purpose : Read from file the SST data
-      !!
-      !! ** Method  : Depending on kformat either AVISO or
-      !!              feedback data files are read
-      !!
-      !! ** Action  : 
-      !!
-      !!
-      !! History :  
-      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
-      !!----------------------------------------------------------------------
-      !! * Modules used
-
-      !! * Arguments
-      INTEGER :: kformat   ! Format of input data
-      !                    ! 0: Feedback
-      !                    ! 1: GHRSST
-      TYPE(obs_surf), INTENT(INOUT) :: sstdata   ! SST data to be read
-      INTEGER, INTENT(IN) :: knumfiles    ! Number of corio format files to read in
-      CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in
-      INTEGER, INTENT(IN) :: kvars      ! Number of variables in sstdata
-      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in sstdata
-      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
-      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
-      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
-      REAL(KIND=dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS
-      REAL(KIND=dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS
-         
-      !! * Local declarations
-      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_sst'
-      INTEGER :: ji
-      INTEGER :: jj
-      INTEGER :: jk
-      INTEGER :: iflag
-      INTEGER :: inobf
-      INTEGER :: i_file_id
-      INTEGER :: inowin
-      INTEGER :: iyea
-      INTEGER :: imon
-      INTEGER :: iday
-      INTEGER :: ihou
-      INTEGER :: imin
-      INTEGER :: isec
-      INTEGER, DIMENSION(knumfiles) :: irefdate
-      INTEGER :: iobsmpp
-      INTEGER, PARAMETER :: isstmaxtype = 1024
-      INTEGER, DIMENSION(0:isstmaxtype) :: &
-         & ityp, &
-         & itypmpp
-      INTEGER, DIMENSION(:), ALLOCATABLE :: &
-         & iobsi,    &
-         & iobsj,    &
-         & iproc,    &
-         & iindx,    &
-         & ifileidx, &
-         & isstidx
-      INTEGER :: itype
-      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
-         & zphi, &
-         & zlam
-      real(wp), DIMENSION(:), ALLOCATABLE :: &
-         & zdat
-      LOGICAL :: llvalprof
-      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
-         & inpfiles
-      real(wp), DIMENSION(knumfiles) :: &
-         & djulini, &
-         & djulend
-      INTEGER :: iobs
-      INTEGER :: iobstot
-      INTEGER :: ios
-      INTEGER :: ioserrcount
-      CHARACTER(len=8) :: cl_refdate
-   
-      ! Local initialization
-      iobs = 0
- 
-      !-----------------------------------------------------------------------
-      ! Check data the model part is just with feedback data files
-      !-----------------------------------------------------------------------
-      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
-         CALL ctl_stop( 'Model can only be read from feedback data' )
-         RETURN
-      ENDIF
-
-      !-----------------------------------------------------------------------
-      ! Count the number of files needed and allocate the obfbdata type
-      !-----------------------------------------------------------------------
-      
-      inobf = knumfiles
-      
-      ALLOCATE( inpfiles(inobf) )
-
-      sst_files : DO jj = 1, inobf
-
-         CALL init_obfbdata( inpfiles(jj) )
-          
-         !---------------------------------------------------------------------
-         ! Prints
-         !---------------------------------------------------------------------
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) ' obs_rea_sst : Reading from file = ', &
-               & TRIM( TRIM( cfilenames(jj) ) )
-            WRITE(numout,*) ' ~~~~~~~~~~~'
-            WRITE(numout,*)
-         ENDIF
-
-         !---------------------------------------------------------------------
-         !  Initialization: Open file and get dimensions only
-         !---------------------------------------------------------------------
-         
-         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
-            &                      i_file_id )
-         
-         IF ( iflag /= nf90_noerr ) THEN
-
-            IF ( ldignmis ) THEN
-               inpfiles(jj)%nobs = 0
-               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
-                  &           ' not found' )
-            ELSE 
-               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
-                  &           ' not found' )
-            ENDIF
-
-         ELSE 
-            
-            !------------------------------------------------------------------
-            !  Close the file since it is opened in read_proffile
-            !------------------------------------------------------------------
-            
-            iflag = nf90_close( i_file_id )
-
-            !------------------------------------------------------------------
-            !  Read the profile file into inpfiles
-            !------------------------------------------------------------------
-            IF ( kformat == 0 ) THEN
-               IF(lwp) THEN
-                  WRITE(numout,*)
-                  WRITE(numout,*)'Reading from feedback file :', &
-                     &           TRIM( cfilenames(jj) )
-               ENDIF
-               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
-                  &                ldgrid = .TRUE. )
-               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
-                  CALL ctl_stop( 'Model not in input data' )
-                  RETURN
-               ENDIF
-            ELSEIF ( kformat == 1) THEN
-               CALL read_ghrsst( TRIM( cfilenames(jj) ), inpfiles(jj), &
-               &                 numout, lwp, .TRUE. )
-            ELSE
-               CALL ctl_stop( 'File format unknown' )
-            ENDIF
-
-            !------------------------------------------------------------------
-            !  Change longitude (-180,180)
-            !------------------------------------------------------------------
-
-            DO ji = 1, inpfiles(jj)%nobs 
-
-               IF ( inpfiles(jj)%plam(ji) < -180. ) &
-                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
-
-               IF ( inpfiles(jj)%plam(ji) >  180. ) &
-                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
-
-            END DO
-
-            !------------------------------------------------------------------
-            !  Calculate the date  (change eventually)
-            !------------------------------------------------------------------
-            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
-            READ(cl_refdate,'(I8)') irefdate(jj)
-            
-            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
-            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
-               &           krefdate = irefdate(jj) )
-            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
-            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
-               &           krefdate = irefdate(jj) )
-            IF ( inpfiles(jj)%nobs > 0 ) THEN
-               inpfiles(jj)%iproc = -1
-               inpfiles(jj)%iobsi = -1
-               inpfiles(jj)%iobsj = -1
-            ENDIF
-            inowin = 0
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  inowin = inowin + 1
-               ENDIF
-            END DO
-            ALLOCATE( zlam(inowin)  )
-            ALLOCATE( zphi(inowin)  )
-            ALLOCATE( iobsi(inowin) )
-            ALLOCATE( iobsj(inowin) )
-            ALLOCATE( iproc(inowin) )
-            inowin = 0
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  inowin = inowin + 1
-                  zlam(inowin) = inpfiles(jj)%plam(ji)
-                  zphi(inowin) = inpfiles(jj)%pphi(ji)
-               ENDIF
-            END DO
-
-            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
-
-            inowin = 0
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  inowin = inowin + 1
-                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
-                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
-                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
-               ENDIF
-            END DO
-            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
-
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  IF ( nproc == 0 ) THEN
-                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
-                  ELSE
-                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
-                  ENDIF
-                  llvalprof = .FALSE.
-                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
-                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
-                     iobs = iobs + 1
-                  ENDIF
-               ENDIF
-            END DO
-
-         ENDIF
-
-      END DO sst_files
-
-      !-----------------------------------------------------------------------
-      ! Get the time ordered indices of the input data
-      !-----------------------------------------------------------------------
-
-      !---------------------------------------------------------------------
-      !  Loop over input data files to count total number of profiles
-      !---------------------------------------------------------------------
-      iobstot = 0
-      DO jj = 1, inobf
-         DO ji = 1, inpfiles(jj)%nobs
-            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-               iobstot = iobstot + 1
-            ENDIF
-         END DO
-      END DO
-
-      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
-         &      isstidx(iobstot), zdat(iobstot) )
-      jk = 0
-      DO jj = 1, inobf
-         DO ji = 1, inpfiles(jj)%nobs
-            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-               jk = jk + 1
-               ifileidx(jk) = jj
-               isstidx(jk) = ji
-               zdat(jk)     = inpfiles(jj)%ptim(ji)
-            ENDIF
-         END DO
-      END DO
-      CALL sort_dp_indx( iobstot, &
-         &               zdat,     &
-         &               iindx   )
-      
-      CALL obs_surf_alloc( sstdata, iobs, kvars, kextr, kstp, jpi, jpj )
-      
-      ! * Read obs/positions, QC, all variable and assign to sstdata
- 
-      iobs = 0
-
-      ityp   (:) = 0
-      itypmpp(:) = 0
-      
-      ioserrcount = 0
-      
-      DO jk = 1, iobstot
-         
-         jj = ifileidx(iindx(jk))
-         ji = isstidx(iindx(jk))
-         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
-            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
-            
-            IF ( nproc == 0 ) THEN
-               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
-            ELSE
-               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
-            ENDIF
-            
-            ! Set observation information
-            
-            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
-               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
-
-               iobs = iobs + 1
-
-               CALL jul2greg( isec,                   &
-                  &           imin,                   &
-                  &           ihou,                   &
-                  &           iday,                   &
-                  &           imon,                   &
-                  &           iyea,                   &
-                  &           inpfiles(jj)%ptim(ji), &
-                  &           irefdate(jj) )
-
-
-               ! SST time coordinates
-               sstdata%nyea(iobs) = iyea
-               sstdata%nmon(iobs) = imon
-               sstdata%nday(iobs) = iday
-               sstdata%nhou(iobs) = ihou
-               sstdata%nmin(iobs) = imin
-               
-               ! SST space coordinates
-               sstdata%rlam(iobs) = inpfiles(jj)%plam(ji)
-               sstdata%rphi(iobs) = inpfiles(jj)%pphi(ji)
-
-               ! Coordinate search parameters
-               sstdata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
-               sstdata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
-               
-               ! Instrument type
-               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype
-901            IF ( ios /= 0 ) THEN
-                  IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' ) 
-                  ioserrcount = ioserrcount + 1
-                  itype = 0
-               ENDIF
-               sstdata%ntyp(iobs) = itype
-               IF ( itype < isstmaxtype + 1 ) THEN
-                  ityp(itype+1) = ityp(itype+1) + 1
-               ELSE
-                  IF(lwp)WRITE(numout,*)'WARNING:Increase isstmaxtype in ',&
-                     &                  cpname
-               ENDIF
-
-               ! Bookkeeping data to match observations
-               sstdata%nsidx(iobs) = iobs
-               sstdata%nsfil(iobs) = iindx(jk)
-
-               ! QC flags
-               sstdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
-
-               ! Observed value
-               sstdata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
-
-
-               ! Model and MDT is set to fbrmdi unless read from file
-               IF ( ldmod ) THEN
-                  sstdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
-               ELSE
-                  sstdata%rmod(iobs,1) = fbrmdi
-               ENDIF
-            ENDIF
-         ENDIF
-
-      END DO
-
-      !-----------------------------------------------------------------------
-      ! Sum up over processors
-      !-----------------------------------------------------------------------
-      
-      CALL obs_mpp_sum_integer( iobs, iobsmpp )
-      
-      !-----------------------------------------------------------------------
-      ! Output number of observations.
-      !-----------------------------------------------------------------------
-      IF (lwp) THEN
-
-         WRITE(numout,*)
-         WRITE(numout,'(1X,A)')'SST data types'
-         WRITE(numout,'(1X,A)')'--------------'
-         DO jj = 1,8
-            IF ( itypmpp(jj) > 0 ) THEN
-               WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj)
-            ENDIF
-         END DO
-         WRITE(numout,'(1X,A50)')'--------------------------------------------------'
-         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp
-         WRITE(numout,*)
-
-      ENDIF
-
-      !-----------------------------------------------------------------------
-      ! Deallocate temporary data
-      !-----------------------------------------------------------------------
-      DEALLOCATE( ifileidx, isstidx, zdat )
-
-      !-----------------------------------------------------------------------
-      ! Deallocate input data
-      !-----------------------------------------------------------------------
-      DO jj = 1, inobf
-         IF ( inpfiles(jj)%lalloc ) THEN
-            CALL dealloc_obfbdata( inpfiles(jj) )
-         ENDIF
-      END DO
-      DEALLOCATE( inpfiles )
-
-   END SUBROUTINE obs_rea_sst
-
-   SUBROUTINE obs_rea_sst_rey( sstname, cdsstfmt, sstdata, kvars, kextra, &
-      &                        kstp, ddobsini, ddobsend )
-      !!---------------------------------------------------------------------
-      !!
-      !!                   *** ROUTINE obs_rea_sst ***
-      !!
-      !! ** Purpose : Read from file the pseudo SST data from Reynolds
-      !!
-      !! ** Method  : 
-      !!
-      !! ** Action  : 
-      !!
-      !! References : 
-      !!
-      !! History :  
-      !!      ! :  
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE par_oce          ! Ocean parameters
-   
-      !! * Arguments
-      CHARACTER(len=128), INTENT(IN) :: sstname   ! Generic file name
-      CHARACTER(len=12), INTENT(IN) :: cdsstfmt   ! Format of SST files (yearly/monthly)
-      TYPE(obs_surf), INTENT(INOUT) :: sstdata    ! SST data
-      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS
-      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS
-      INTEGER, INTENT(IN) :: kvars      ! Number of variables in sstdata structures
-      INTEGER, INTENT(IN) :: kextra     ! Number of extra variables in sstdata structures
-      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
-      
-      INTEGER :: iyear
-      INTEGER :: imon
-      INTEGER :: iday
-      INTEGER :: ihour
-      INTEGER :: imin
-      INTEGER :: isec
-      INTEGER :: ihhmmss
-      INTEGER :: iyear1
-      INTEGER :: iyear2
-      INTEGER :: imon1
-      INTEGER :: imon2
-      INTEGER :: iyearf
-      INTEGER :: imonf
-      REAL(KIND=wp) :: pjulini
-      REAL(KIND=wp) :: pjulend
-      REAL(KIND=wp) :: pjulb
-      REAL(KIND=wp) :: pjule
-      REAL(KIND=wp) :: pjul
-      INTEGER :: inumsst
-      INTEGER :: itotrec
-      INTEGER :: inumobs
-      INTEGER :: irec
-      INTEGER :: ifld
-      INTEGER :: inum
-      INTEGER :: ji, jj
-      CHARACTER(len=128) :: clname
-      CHARACTER(len=4) :: cdyear
-      CHARACTER(len=2) :: cdmon
-      REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:) :: zsstin
-
-      IF (lwp) WRITE(numout,*)'In obs_rea_sst_rey',sstname
-
-      !-----------------------------------------------------------------------
-      ! Convert observation window to julian dates.
-      !-----------------------------------------------------------------------
-      iyear1 = NINT( ddobsini / 10000 )
-      imon1 = NINT( ( ddobsini - iyear1 * 10000 ) / 100 )
-      iday = MOD( NINT( ddobsini ), 100 )
-      ihhmmss = ( ddobsini - NINT( ddobsini ) ) * 1000000
-      ihour = ihhmmss / 10000
-      imin = ( ihhmmss - ihour * 100 ) / 100
-      isec = MOD( ihhmmss, 100 )
-      CALL greg2jul ( isec, imin, ihour, iday, imon1, iyear1, pjulini )
-      IF (lwp) WRITE(numout,*)'dateini',ddobsini,iyear1,imon1,iday,ihour, &
-         & imin,isec,pjulini
-
-      iyear2 = NINT( ddobsini / 10000 )
-      imon2 = NINT( ( ddobsend - iyear2 * 10000 ) / 100 )
-      iday = MOD( NINT( ddobsend ), 100 )
-      ihhmmss = ( ddobsend - NINT( ddobsend ) ) * 1000000
-      ihour = ihhmmss / 10000
-      imin = ( ihhmmss - ihour * 100 ) / 100
-      isec = MOD( ihhmmss, 100 )
-      CALL greg2jul ( isec, imin, ihour, iday, imon2, iyear2, pjulend )
-      IF (lwp) WRITE(numout,*)'dateend',ddobsend,iyear2,imon2,iday,ihour, &
-         & imin,isec,pjulend
-
-      itotrec = NINT( pjulend - pjulini ) 
-      ALLOCATE( &
-         & zsstin( jpi, jpj, itotrec) &
-         & )
-      
-      pjul = pjulini + 1
-      
-      iyearf = -1 
-      imonf = -1
-
-      IF ( TRIM(cdsstfmt) == 'yearly' ) THEN
-
-         DO
-         
-            CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
-               &           pjul, 19500101 )
-            !
-            IF ( iyear /= iyearf ) THEN
-               
-               CALL greg2jul ( 0, 0, 0, 1, 1, iyear, pjulb )
-               
-               IF ( iyearf /= -1 ) THEN
-                  
-                  CALL iom_close ( inumsst )      
-                  
-               ENDIF
-               
-               clname = sstname
-               jj = INDEX( clname, 'YYYY' )
-               
-               IF ( jj == 0 ) THEN
-                  
-                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
-                  &           'Error processing filename ' // TRIM(sstname) )
-                  
-               ENDIF
-               
-               WRITE(cdyear,'(I4.4)') iyear
-               clname(jj:jj+3) = cdyear
-               IF(lwp) WRITE(numout,*)'Reading from Reynolds SST file : ',&
-                  & TRIM(clname)
-               
-               inumsst = 0
-               
-               CALL iom_open ( clname, inumsst )
-               
-               IF ( inumsst == 0 ) THEN
-                  
-                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
-                     &           'Error reading ' // TRIM(clname) )
-                  
-               ENDIF
-               
-               iyearf = iyear
-               
-            ENDIF
-            
-            irec = pjul - pjulb + 1
-            ifld = pjul - pjulini
-            
-            CALL iom_get ( inumsst, jpdom_data, 'sst', zsstin(:,:,ifld), irec )
-            
-            pjul = pjul + 1
-            
-            IF ( pjul > pjulend ) EXIT
-         
-         END DO
-
-      ELSEIF ( TRIM(cdsstfmt) == 'monthly' ) THEN
-
-         DO
-         
-            CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
-               &           pjul, 19500101 )
-            !
-            IF ( iyear /= iyearf .OR. imon /= imonf ) THEN
-               
-               CALL greg2jul ( 0, 0, 0, 1, imon, iyear, pjulb )
-               
-               IF ( iyearf /= -1 .AND. imonf /= -1 ) THEN
-                  
-                  CALL iom_close ( inumsst )      
-                  
-               ENDIF
-               
-               clname = sstname
-
-               jj = INDEX( clname, 'YYYY' )
-
-               IF ( jj == 0 ) THEN
-                  
-                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
-                  &           'Error processing filename ' // TRIM(sstname) )
-                  
-               ENDIF
-               
-               WRITE(cdyear,'(I4.4)') iyear
-               clname(jj:jj+3) = cdyear
-
-               jj = INDEX( clname, 'MM' )
-               
-               IF ( jj == 0 ) THEN
-                  
-                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
-                  &           'Error processing filename ' // TRIM(sstname) )
-                  
-               ENDIF
-               
-               WRITE(cdmon,'(I2.2)') imon
-               clname(jj:jj+1) = cdmon
-
-
-               IF(lwp) WRITE(numout,*)'Reading from Reynolds SST file : ',&
-                  & TRIM(clname)
-               
-               inumsst = 0
-               
-               CALL iom_open ( clname, inumsst )
-               
-               IF ( inumsst == 0 ) THEN
-                  
-                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
-                     &           'Error reading ' // TRIM(clname) )
-                  
-               ENDIF
-               
-               iyearf = iyear
-               imonf = iyear
-               
-            ENDIF
-            
-            irec = pjul - pjulb + 1
-            ifld = pjul - pjulini
-            
-            CALL iom_get ( inumsst, jpdom_data, 'sst', zsstin(:,:,ifld), irec )
-            
-            pjul = pjul + 1
-            
-            IF ( pjul > pjulend ) EXIT
-         
-         END DO
-
-      ELSE
-         
-         CALL ctl_stop('Unknown REYNOLDS sst input data file format')
-
-      ENDIF
-
-      CALL iom_close ( inumsst )      
-
-      inumobs = 0
-      DO jj = nldj, nlej
-         DO ji = nldi, nlei
-            IF ( tmask(ji,jj,1) == 1.0_wp ) inumobs = inumobs + 1
-         END DO
-      END DO
-      inumobs = inumobs * itotrec
-
-      ! Allocate obs_surf data structure for time sorted data
-         
-      CALL obs_surf_alloc( sstdata, inumobs, kvars, kextra, kstp, jpi, jpj )
-
-      pjul = pjulini + 1
-
-      inumobs = 0
-
-      DO
-
-         CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
-            &           pjul, 19500101 )
-
-         ifld = pjul - pjulini
-
-         DO jj = nldj, nlej
-            DO ji = nldi, nlei
-
-               IF ( tmask(ji,jj,1) == 1.0_wp ) THEN
-
-                  inumobs = inumobs + 1
-                  
-                  ! Integer values
-                  IF (ln_grid_global) THEN
-                     sstdata%mi(inumobs)     = MAX(mig(ji),2)
-                     sstdata%mj(inumobs)     = MAX(mjg(jj),2)
-                  ELSE
-                     sstdata%mi(inumobs)     = MAX(ji,2)
-                     sstdata%mj(inumobs)     = MAX(jj,2)
-                  ENDIF
-                  sstdata%nsidx(inumobs)  = 0
-                  sstdata%nsfil(inumobs)  = 0
-                  sstdata%nyea(inumobs)   = iyear
-                  sstdata%nmon(inumobs)   = imon
-                  sstdata%nday(inumobs)   = iday
-                  sstdata%nhou(inumobs)   = ihour
-                  sstdata%nmin(inumobs)   = imin
-                  sstdata%mstp(inumobs)   = 0
-                  sstdata%nqc(inumobs)    = 0
-                  sstdata%ntyp(inumobs)   = 0
-         
-                  ! Real values
-                  sstdata%rlam(inumobs)   = glamt(ji,jj)
-                  sstdata%rphi(inumobs)   = gphit(ji,jj)
-                  sstdata%robs(inumobs,1) = zsstin(ji,jj,ifld)
-                  sstdata%rmod(inumobs,1) = fbrmdi
-                  sstdata%rext(inumobs,:) = fbrmdi
-
-               ENDIF
-
-            END DO
-         END DO
-
-         pjul = pjul + 1
-
-         IF ( pjul > pjulend ) EXIT
-
-      END DO
-
-   END SUBROUTINE obs_rea_sst_rey
-
-END MODULE obs_read_sst
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90	(revision 6808)
@@ -0,0 +1,498 @@
+MODULE obs_read_surf
+   !!======================================================================
+   !!                       ***  MODULE obs_read_surf  ***
+   !! Observation diagnostics: Read the surface data from feedback files
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_surf : Driver for reading surface data from feedback files
+   !!----------------------------------------------------------------------
+
+   !! * Modules used
+   USE par_kind                 ! Precision variables
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_surf_def             ! Surface observation definitions
+   USE obs_types                ! Observation type definitions
+   USE obs_fbm                  ! Feedback routines
+   USE netcdf                   ! NetCDF library
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_surf      ! Read the surface observations from the point data
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obs_read_surf.F90 4990 2014-12-15 16:42:49Z timgraham $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_rea_surf( surfdata, knumfiles, cdfilenames, &
+      &                     kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                     ldignmis, ldmod, ldnightav )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_surf ***
+      !!
+      !! ** Purpose : Read from file the surface data
+      !!
+      !! ** Method  : Read in the data from feedback format files and 
+      !!              put into the NEMO internal surface data structure
+      !!
+      !! ** Action  : 
+      !!
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
+      !!      ! :  2015-02 (M. Martin)   Unify the different surface data type reading.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & surfdata                     ! Surface data to be read
+      INTEGER, INTENT(IN) :: knumfiles  ! Number of corio format files to read
+      CHARACTER(LEN=128), INTENT(IN) :: &
+         & cdfilenames(knumfiles)       ! File names to read in
+      INTEGER, INTENT(IN) :: kvars      ! Number of variables in surfdata
+      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var
+      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
+      LOGICAL, INTENT(IN) :: ldnightav  ! Observations represent a night-time average
+      REAL(dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS
+
+      !! * Local declarations
+      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_surf'
+      CHARACTER(len=8) :: clrefdate
+      CHARACTER(len=6), DIMENSION(:), ALLOCATABLE :: clvars
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER :: itype
+      INTEGER :: iobsmpp
+      INTEGER :: iobs
+      INTEGER :: iobstot
+      INTEGER :: ios
+      INTEGER :: ioserrcount
+      INTEGER, PARAMETER :: jpsurfmaxtype = 1024
+      INTEGER, DIMENSION(knumfiles) :: irefdate
+      INTEGER, DIMENSION(jpsurfmaxtype+1) :: &
+         & ityp, &
+         & itypmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & isurfidx
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      REAL(wp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      LOGICAL :: llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+
+      ! Local initialization
+      iobs = 0
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+
+      inobf = knumfiles
+
+      ALLOCATE( inpfiles(inobf) )
+
+      surf_files : DO jj = 1, inobf
+
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_surf : Reading from file = ', &
+               & TRIM( TRIM( cdfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+
+         iflag = nf90_open( TRIM( TRIM( cdfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cdfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cdfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_obfbdata
+            !------------------------------------------------------------------
+
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            CALL init_obfbdata( inpfiles(jj) )
+            CALL read_obfbdata( TRIM( cdfilenames(jj) ), inpfiles(jj), &
+               &                ldgrid = .TRUE. )
+
+            IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
+               CALL ctl_stop( 'Model not in input data' )
+               RETURN
+            ENDIF
+
+            IF ( jj == 1 ) THEN
+               ALLOCATE( clvars( inpfiles(jj)%nvar ) )
+               DO ji = 1, inpfiles(jj)%nvar
+                 clvars(ji) = inpfiles(jj)%cname(ji)
+               END DO
+            ELSE
+               DO ji = 1, inpfiles(jj)%nvar
+                  IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN
+                     CALL ctl_stop( 'Feedback file variables not consistent', &
+                        &           ' with previous files for this type' )
+                  ENDIF
+               END DO
+            ENDIF
+
+            IF (lwp) WRITE(numout,*)'Observation file contains ',inpfiles(jj)%nobs,' observations'
+
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            clrefdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(clrefdate,'(I8)') irefdate(jj)
+
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+
+            IF ( ldnightav ) THEN
+
+               IF ( lwp ) THEN
+                  WRITE(numout,*)'Resetting time of night-time averaged observations', &
+                     &             ' to the end of the day'
+               ENDIF
+
+               DO ji = 1, inpfiles(jj)%nobs
+                  !  for night-time averaged data force the time
+                  !  to be the last time-step of the day, but still within the day.
+                  IF ( inpfiles(jj)%ptim(ji) >= 0. ) THEN
+                     inpfiles(jj)%ptim(ji) = &
+                        & INT(inpfiles(jj)%ptim(ji)) + 0.9999
+                  ELSE
+                     inpfiles(jj)%ptim(ji) = &
+                        & INT(inpfiles(jj)%ptim(ji)) - 0.0001
+                  ENDIF
+               END DO
+            ENDIF
+
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+                     iobs = iobs + 1
+                  ENDIF
+               ENDIF
+            END DO
+
+         ENDIF
+
+      END DO surf_files
+
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iobstot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iobstot = iobstot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
+         &      isurfidx(iobstot), zdat(iobstot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               isurfidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iobstot, &
+         &               zdat,     &
+         &               iindx   )
+
+      CALL obs_surf_alloc( surfdata, iobs, kvars, kextr, kstp, jpi, jpj )
+
+      ! Read obs/positions, QC, all variable and assign to surfdata
+
+      iobs = 0
+
+      surfdata%cvars(:)  = clvars(:)
+
+      ityp   (:) = 0
+      itypmpp(:) = 0
+
+      ioserrcount = 0
+
+      DO jk = 1, iobstot
+
+         jj = ifileidx(iindx(jk))
+         ji = isurfidx(iindx(jk))
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+
+            ! Set observation information
+
+            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+
+               iobs = iobs + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! Surface time coordinates
+               surfdata%nyea(iobs) = iyea
+               surfdata%nmon(iobs) = imon
+               surfdata%nday(iobs) = iday
+               surfdata%nhou(iobs) = ihou
+               surfdata%nmin(iobs) = imin
+
+               ! Surface space coordinates
+               surfdata%rlam(iobs) = inpfiles(jj)%plam(ji)
+               surfdata%rphi(iobs) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               surfdata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
+               surfdata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
+
+               ! WMO number
+               surfdata%cwmo(iobs) = inpfiles(jj)%cdwmo(ji)
+
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype
+901            IF ( ios /= 0 ) THEN
+                  IF (ioserrcount == 0) THEN
+                     CALL ctl_warn ( 'Problem converting an instrument type ', &
+                        &            'to integer. Setting type to zero' )
+                  ENDIF
+                  ioserrcount = ioserrcount + 1
+                  itype = 0
+               ENDIF
+               surfdata%ntyp(iobs) = itype
+               IF ( itype < jpsurfmaxtype + 1 ) THEN
+                  ityp(itype+1) = ityp(itype+1) + 1
+               ELSE
+                  IF(lwp)WRITE(numout,*)'WARNING:Increase jpsurfmaxtype in ',&
+                     &                  cpname
+               ENDIF
+
+               ! Bookkeeping data to match observations
+               surfdata%nsidx(iobs) = iobs
+               surfdata%nsfil(iobs) = iindx(jk)
+
+               ! QC flags
+               surfdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
+
+               ! Observed value
+               surfdata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
+
+
+               ! Model and MDT is set to fbrmdi unless read from file
+               IF ( ldmod ) THEN
+                  surfdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
+                  IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) THEN
+                     surfdata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1)
+                     surfdata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1)
+                  ENDIF
+                ELSE
+                  surfdata%rmod(iobs,1) = fbrmdi
+                  IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) surfdata%rext(iobs,:) = fbrmdi
+               ENDIF
+            ENDIF
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+
+      CALL obs_mpp_sum_integer( iobs, iobsmpp )
+      CALL obs_mpp_sum_integers( ityp, itypmpp, jpsurfmaxtype + 1 )
+
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF (lwp) THEN
+
+         WRITE(numout,*)
+         WRITE(numout,'(1X,A)')TRIM( surfdata%cvars(1) )//' data'
+         WRITE(numout,'(1X,A)')'--------------'
+         DO jj = 1,8
+            IF ( itypmpp(jj) > 0 ) THEN
+               WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,'(1X,A,I8)') &
+            & 'Total data for variable '//TRIM( surfdata%cvars(1) )// &
+            & '           = ', iobsmpp
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,*)
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, isurfidx, zdat, clvars )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         IF ( inpfiles(jj)%lalloc ) THEN
+            CALL dealloc_obfbdata( inpfiles(jj) )
+         ENDIF
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_surf
+
+END MODULE obs_read_surf
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90	(revision 6807)
+++ 	(revision )
@@ -1,653 +1,0 @@
-MODULE obs_read_vel
-   !!======================================================================
-   !!                       ***  MODULE obs_read_vel  ***
-   !! Observation diagnostics: Read the velocity profile observations
-   !!======================================================================
-
-   !!----------------------------------------------------------------------
-   !!   obs_rea_vel_dri : Driver for reading profile obs
-   !!----------------------------------------------------------------------
-
-   !! * Modules used   
-   USE par_kind                 ! Precision variables
-   USE par_oce                  ! Ocean parameters
-   USE in_out_manager           ! I/O manager
-   USE dom_oce                  ! Ocean space and time domain variables
-   USE obs_mpp                  ! MPP support routines for observation diagnostics
-   USE julian                   ! Julian date routines
-   USE obs_utils                ! Observation operator utility functions
-   USE obs_prep                 ! Prepare observation arrays
-   USE obs_grid                 ! Grid search
-   USE obs_sort                 ! Sorting observation arrays
-   USE obs_profiles_def         ! Profile definitions
-   USE obs_conv                 ! Various conversion routines
-   USE obs_types                ! Observation type definitions
-   USE netcdf                   ! NetCDF library
-   USE obs_oper                 ! Observation operators
-   USE obs_vel_io               ! Velocity profile files I/O (non-FB files)
-   USE lib_mpp                  ! For ctl_warn/stop
-
-   IMPLICIT NONE
-
-   !! * Routine accessibility
-   PRIVATE
-
-   PUBLIC obs_rea_vel_dri  ! Read the profile observations 
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
- 
-   SUBROUTINE obs_rea_vel_dri( kformat, &
-      &                        profdata, knumfiles, cfilenames, &
-      &                        kvars, kextr, kstp, ddobsini, ddobsend, &
-      &                        ldignmis, ldavtimset, ldmod )
-      !!---------------------------------------------------------------------
-      !!
-      !!                   *** ROUTINE obs_rea_pro_dri ***
-      !!
-      !! ** Purpose : Read from file the profile observations
-      !!
-      !! ** Method  : Depending on kformat either ENACT, CORIOLIS or
-      !!              feedback data files are read
-      !!
-      !! ** Action  : 
-      !!
-      !! References : 
-      !!
-      !! History :  
-      !!      ! :  2009-01 (K. Mogensen) : New merged version of old routines
-      !!----------------------------------------------------------------------
-      !! * Modules used
-   
-      !! * Arguments
-      INTEGER :: kformat   ! Format of input data
-      !                    ! 1: ENACT
-      !                    ! 2: Coriolis
-      TYPE(obs_prof), INTENT(OUT) :: profdata    ! Profile data to be read
-      INTEGER, INTENT(IN) :: knumfiles           ! Number of files to read in
-      CHARACTER(LEN=128), INTENT(IN) ::  cfilenames(knumfiles) ! File names to read in
-      INTEGER, INTENT(IN) :: kvars       ! Number of variables in profdata
-      INTEGER, INTENT(IN) :: kextr       ! Number of extra fields for each var in profdata
-      INTEGER, INTENT(IN) :: kstp        !  Ocean time-step index
-      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files
-      LOGICAL, INTENT(IN) :: ldavtimset  ! Set time to be equal to the end of the day
-      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data
-      REAL(KIND=dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS
-      REAL(KIND=dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS
-
-      !! * Local declarations
-      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_vel_dri'
-      INTEGER :: jvar
-      INTEGER :: ji
-      INTEGER :: jj
-      INTEGER :: jk
-      INTEGER :: ij
-      INTEGER :: iflag
-      INTEGER :: inobf
-      INTEGER :: i_file_id
-      INTEGER :: inowin
-      INTEGER :: iyea
-      INTEGER :: imon
-      INTEGER :: iday
-      INTEGER :: ihou
-      INTEGER :: imin
-      INTEGER :: isec
-      INTEGER, DIMENSION(knumfiles) :: &
-         & irefdate
-      INTEGER, DIMENSION(ntyp1770+1) :: &
-         & itypuv,    &
-         & itypuvmpp 
-      INTEGER :: iuv3dtmpp
-      INTEGER, DIMENSION(:), ALLOCATABLE :: &
-         & iobsiu,   &
-         & iobsju,   &
-         & iprocu,   &
-         & iobsiv,   &
-         & iobsjv,   &
-         & iprocv,   &
-         & iindx,    &
-         & ifileidx, &
-         & iprofidx
-      INTEGER :: itype
-      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
-         & zphi, &
-         & zlam
-      real(wp), DIMENSION(:), ALLOCATABLE :: &
-         & zdat
-      LOGICAL :: &
-         & llvalprof
-      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
-         & inpfiles
-      real(wp), DIMENSION(knumfiles) :: &
-         & djulini, &
-         & djulend
-      INTEGER :: iprof
-      INTEGER :: iproftot
-      INTEGER :: iuv3dt
-      INTEGER :: ios
-      INTEGER :: ioserrcount
-      INTEGER, DIMENSION(kvars) :: iv3dt
-      CHARACTER(len=8) :: cl_refdate
-   
-      ! Local initialization
-      iprof = 0
-      iuv3dt = 0
-
-      !-----------------------------------------------------------------------
-      ! Check data the model part is just with feedback data files
-      !-----------------------------------------------------------------------
-      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
-         CALL ctl_stop( 'Model can only be read from feedback data' )
-         RETURN
-      ENDIF
-
-      !-----------------------------------------------------------------------
-      ! Count the number of files needed and allocate the obfbdata type
-      !-----------------------------------------------------------------------
-      
-      inobf = knumfiles
-
-      ALLOCATE( inpfiles(inobf) )
-
-      prof_files : DO jj = 1, inobf
-          
-         !---------------------------------------------------------------------
-         ! Prints
-         !---------------------------------------------------------------------
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) ' obs_rea_vel_dri : Reading from file = ', &
-               & TRIM( TRIM( cfilenames(jj) ) )
-            WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
-            WRITE(numout,*)
-         ENDIF
-
-         !---------------------------------------------------------------------
-         !  Initialization: Open file and get dimensions only
-         !---------------------------------------------------------------------
-         
-         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
-            &                      i_file_id )
-         
-         IF ( iflag /= nf90_noerr ) THEN
-
-            IF ( ldignmis ) THEN
-               inpfiles(jj)%nobs = 0
-               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
-                  &           ' not found' )
-            ELSE 
-               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
-                  &           ' not found' )
-            ENDIF
-
-         ELSE 
-            
-            !------------------------------------------------------------------
-            !  Close the file since it is opened in read_proffile
-            !------------------------------------------------------------------
-            
-            iflag = nf90_close( i_file_id )
-
-            !------------------------------------------------------------------
-            !  Read the profile file into inpfiles
-            !------------------------------------------------------------------
-            IF ( kformat == 0 ) THEN
-               CALL init_obfbdata( inpfiles(jj) )
-               IF(lwp) THEN
-                  WRITE(numout,*)
-                  WRITE(numout,*)'Reading from feedback file :', &
-                     &           TRIM( cfilenames(jj) )
-               ENDIF
-               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
-                  &                ldgrid = .TRUE. )
-               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
-                  CALL ctl_stop( 'Model not in input data' )
-                  RETURN
-               ENDIF
-            ELSEIF ( kformat == 1 ) THEN
-               CALL read_taondbc( TRIM( cfilenames(jj) ), inpfiles(jj), &
-                  &               numout, lwp, .TRUE. )
-            ELSE
-               CALL ctl_stop( 'File format unknown' )
-            ENDIF
-            
-            !------------------------------------------------------------------
-            !  Change longitude (-180,180)
-            !------------------------------------------------------------------
-
-            DO ji = 1, inpfiles(jj)%nobs 
-
-               IF ( inpfiles(jj)%plam(ji) < -180. ) &
-                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
-
-               IF ( inpfiles(jj)%plam(ji) >  180. ) &
-                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
-
-            END DO
-
-            !------------------------------------------------------------------
-            !  Calculate the date  (change eventually)
-            !------------------------------------------------------------------
-            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
-            READ(cl_refdate,'(I8)') irefdate(jj)
-            
-            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
-            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
-               &           krefdate = irefdate(jj) )
-            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
-            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
-               &           krefdate = irefdate(jj) )
-
-            IF ( ldavtimset ) THEN
-               DO ji = 1, inpfiles(jj)%nobs
-                  ! 
-                  !  for daily averaged data force the time
-                  !  to be the  end of the day
-                  !
-                  inpfiles(jj)%ptim(ji) = &
-                     & INT(inpfiles(jj)%ptim(ji)) + 1
-               END DO
-            ENDIF
-            
-            IF ( inpfiles(jj)%nobs > 0 ) THEN
-               inpfiles(jj)%iproc = -1
-               inpfiles(jj)%iobsi = -1
-               inpfiles(jj)%iobsj = -1
-            ENDIF
-            inowin = 0
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  inowin = inowin + 1
-               ENDIF
-            END DO
-            ALLOCATE( zlam(inowin)  )
-            ALLOCATE( zphi(inowin)  )
-            ALLOCATE( iobsiu(inowin) )
-            ALLOCATE( iobsju(inowin) )
-            ALLOCATE( iprocu(inowin) )
-            ALLOCATE( iobsiv(inowin) )
-            ALLOCATE( iobsjv(inowin) )
-            ALLOCATE( iprocv(inowin) )
-            inowin = 0
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  inowin = inowin + 1
-                  zlam(inowin) = inpfiles(jj)%plam(ji)
-                  zphi(inowin) = inpfiles(jj)%pphi(ji)
-               ENDIF
-            END DO
-
-            CALL obs_grid_search( inowin, zlam, zphi, iobsiu, iobsju, iprocu, &
-               & 'U' )
-            CALL obs_grid_search( inowin, zlam, zphi, iobsiv, iobsjv, iprocv, &
-               & 'V' )
-
-            inowin = 0
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  inowin = inowin + 1
-                  inpfiles(jj)%iproc(ji,1) = iprocu(inowin)
-                  inpfiles(jj)%iobsi(ji,1) = iobsiu(inowin)
-                  inpfiles(jj)%iobsj(ji,1) = iobsju(inowin)
-                  inpfiles(jj)%iproc(ji,2) = iprocv(inowin)
-                  inpfiles(jj)%iobsi(ji,2) = iobsiv(inowin)
-                  inpfiles(jj)%iobsj(ji,2) = iobsjv(inowin)
-                  IF ( inpfiles(jj)%iproc(ji,1) /= &
-                     & inpfiles(jj)%iproc(ji,2) ) THEN
-                     CALL ctl_stop( 'Error in obs_read_vel:', &
-                        & 'U and V observation on different processors')
-                  ENDIF
-               ENDIF
-            END DO
-            DEALLOCATE( zlam, zphi, iobsiu, iobsju, iprocu,  &
-               & iobsiv, iobsjv, iprocv )
-
-            DO ji = 1, inpfiles(jj)%nobs
-               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-                  IF ( nproc == 0 ) THEN
-                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
-                  ELSE
-                     IF ( inpfiles(jj)%iproc(ji,1) /=  nproc ) CYCLE
-                  ENDIF
-                  llvalprof = .FALSE.
-                  IF ( ( ( nproc == 0 ) .AND. &
-                     & ( inpfiles(jj)%iproc(ji,1) <=  nproc ) ) .OR. &
-                     & ( inpfiles(jj)%iproc(ji,1) ==  nproc ) ) THEN
-                     loop_uv_count : DO ij = 1,inpfiles(jj)%nlev
-                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
-                           & CYCLE
-                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
-                           & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
-                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                           iuv3dt = iuv3dt + 1
-                           llvalprof = .TRUE.
-                        ENDIF
-                     END DO loop_uv_count
-                  ENDIF
-                  IF ( llvalprof ) iprof = iprof + 1
-               ENDIF
-            END DO
-
-         ENDIF
-         
-      END DO prof_files
-
-      !-----------------------------------------------------------------------
-      ! Get the time ordered indices of the input data
-      !-----------------------------------------------------------------------
-
-      !---------------------------------------------------------------------
-      !  Loop over input data files to count total number of profiles
-      !---------------------------------------------------------------------
-      iproftot = 0
-      DO jj = 1, inobf
-         DO ji = 1, inpfiles(jj)%nobs
-            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-               iproftot = iproftot + 1
-            ENDIF
-         END DO
-      END DO
-
-      ALLOCATE( iindx(iproftot), ifileidx(iproftot), &
-         &      iprofidx(iproftot), zdat(iproftot) )
-      jk = 0
-      DO jj = 1, inobf
-         DO ji = 1, inpfiles(jj)%nobs
-            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
-               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
-               jk = jk + 1
-               ifileidx(jk) = jj
-               iprofidx(jk) = ji
-               zdat(jk)     = inpfiles(jj)%ptim(ji)
-            ENDIF
-         END DO
-      END DO
-      CALL sort_dp_indx( iproftot, &
-         &               zdat,     &
-         &               iindx   )
-      
-      iv3dt(:) = -1
-      iv3dt(1:2) = iuv3dt
-      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, &
-         &                 kstp, jpi, jpj, jpk )
-      
-      ! * Read obs/positions, QC, all variable and assign to profdata
-
-      profdata%nprof     = 0
-      profdata%nvprot(:) = 0
-
-      iprof = 0
-
-      iuv3dt = 0
-      itypuv   (:) = 0
-      itypuvmpp(:) = 0
-      
-      DO jk = 1, iproftot
-         
-         jj = ifileidx(iindx(jk))
-         ji = iprofidx(iindx(jk))
-         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
-            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
-            
-            IF ( nproc == 0 ) THEN
-               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
-            ELSE
-               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
-            ENDIF
-            
-            llvalprof = .FALSE.
-
-            loop_prof : DO ij = 1, inpfiles(jj)%nlev
-               
-               IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
-                  & CYCLE
-               
-               IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
-                  & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
-                  & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-
-                  llvalprof = .TRUE.
-                  EXIT loop_prof
-
-               ENDIF
-
-            END DO loop_prof
-            
-            ! Set profile information
-            
-            IF ( llvalprof ) THEN
-               
-               iprof = iprof + 1
-
-               CALL jul2greg( isec,                   &
-                  &           imin,                   &
-                  &           ihou,                   &
-                  &           iday,                   &
-                  &           imon,                   &
-                  &           iyea,                   &
-                  &           inpfiles(jj)%ptim(ji), &
-                  &           irefdate(jj) )
-
-
-               ! Profile time coordinates
-               profdata%nyea(iprof) = iyea
-               profdata%nmon(iprof) = imon
-               profdata%nday(iprof) = iday
-               profdata%nhou(iprof) = ihou
-               profdata%nmin(iprof) = imin
-               
-               ! Profile space coordinates
-               profdata%rlam(iprof) = inpfiles(jj)%plam(ji)
-               profdata%rphi(iprof) = inpfiles(jj)%pphi(ji)
-
-               ! Coordinate search parameters
-               profdata%mi  (iprof,1) = inpfiles(jj)%iobsi(ji,1)
-               profdata%mj  (iprof,1) = inpfiles(jj)%iobsj(ji,1)
-               profdata%mi  (iprof,2) = inpfiles(jj)%iobsi(ji,2)
-               profdata%mj  (iprof,2) = inpfiles(jj)%iobsj(ji,2)
-               
-               ! Profile WMO number
-               profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji)
-               
-               ! Instrument type
-               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype
-901            IF ( ios /= 0 ) THEN
-                  IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' ) 
-                  ioserrcount = ioserrcount + 1
-                  itype = 0
-               ENDIF
-               profdata%ntyp(iprof) = itype
-               
-               ! QC stuff
-
-               profdata%nqc(iprof)     = inpfiles(jj)%ioqc(ji)
-               profdata%nqcf(:,iprof)  = inpfiles(jj)%ioqcf(:,ji)
-               profdata%ipqc(iprof)    = inpfiles(jj)%ipqc(ji)
-               profdata%ipqcf(:,iprof) = inpfiles(jj)%ipqcf(:,ji)
-               profdata%itqc(iprof)    = inpfiles(jj)%itqc(ji)
-               profdata%itqcf(:,iprof) = inpfiles(jj)%itqcf(:,ji)
-               profdata%ivqc(iprof,:)  = inpfiles(jj)%ivqc(ji,:)
-               profdata%ivqcf(:,iprof,:) = inpfiles(jj)%ivqcf(:,ji,:)
-
-               ! Bookkeeping data to match profiles
-               profdata%npidx(iprof) = iprof
-               profdata%npfil(iprof) = iindx(jk)
-
-               ! Observation QC flag (whole profile)
-               profdata%nqc(iprof)  = 0 !TODO
-
-               loop_uv : DO ij = 1, inpfiles(jj)%nlev            
-                   
-                  IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
-                     & CYCLE
-
-                  IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
-                     & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
-                     & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                     iuv3dt = iuv3dt + 1
-                  ELSE
-                     CYCLE
-                  ENDIF
-
-                  ! Depth of U observation
-                  profdata%var(1)%vdep(iuv3dt) = &
-                     &                inpfiles(jj)%pdep(ij,ji)
-                  
-                  ! Depth of U observation QC
-                  profdata%var(1)%idqc(iuv3dt) = &
-                     &                inpfiles(jj)%idqc(ij,ji)
-                  
-                  ! Depth of U observation QC flags
-                  profdata%var(1)%idqcf(:,iuv3dt) = &
-                     &                inpfiles(jj)%idqcf(:,ij,ji)
-                  
-                  ! Profile index
-                  profdata%var(1)%nvpidx(iuv3dt) = iprof
-                  
-                  ! Vertical index in original profile
-                  profdata%var(1)%nvlidx(iuv3dt) = ij
-
-                  ! Profile U value
-
-                  profdata%var(1)%vobs(iuv3dt) = &
-                     &                inpfiles(jj)%pob(ij,ji,1)
-                  IF ( ldmod ) THEN
-                     profdata%var(1)%vmod(iuv3dt) = &
-                        &                inpfiles(jj)%padd(ij,ji,1,1)
-                  ENDIF
-                  
-                  ! Profile U qc
-                  profdata%var(1)%nvqc(iuv3dt) = &
-                     & inpfiles(jj)%ivlqc(ij,ji,1)
-                  
-                  ! Profile U qc flags
-                  profdata%var(1)%nvqcf(:,iuv3dt) = &
-                     & inpfiles(jj)%ivlqcf(:,ij,ji,1)
-                  
-                  
-                  ! Depth of V observation
-                  profdata%var(2)%vdep(iuv3dt) = &
-                     &                inpfiles(jj)%pdep(ij,ji)
-                  
-                  ! Depth of V observation QC
-                  profdata%var(2)%idqc(iuv3dt) = &
-                     &                inpfiles(jj)%idqc(ij,ji)
-                  
-                  ! Depth of V observation QC flags
-                  profdata%var(2)%idqcf(:,iuv3dt) = &
-                     &                inpfiles(jj)%idqcf(:,ij,ji)
-                  
-                  ! Profile index
-                  profdata%var(2)%nvpidx(iuv3dt) = iprof
-                  
-                  ! Vertical index in original profile
-                  profdata%var(2)%nvlidx(iuv3dt) = ij
-                  
-                  ! Profile V value
-                  profdata%var(2)%vobs(iuv3dt) = &
-                     &                inpfiles(jj)%pob(ij,ji,2)
-                  IF ( ldmod ) THEN
-                     profdata%var(2)%vmod(iuv3dt) = &
-                        &                inpfiles(jj)%padd(ij,ji,1,2)
-                  ENDIF
-                     
-                  ! Profile V qc
-                  profdata%var(2)%nvqc(iuv3dt) = &
-                     & inpfiles(jj)%ivlqc(ij,ji,2)
-                  
-                  ! Profile V qc flags
-                  profdata%var(2)%nvqcf(:,iuv3dt) = &
-                        & inpfiles(jj)%ivlqcf(:,ij,ji,2)
-                  
-                  ! Observation type
-                  itypuv( profdata%ntyp(iprof) + 1 ) = &
-                     & itypuv( profdata%ntyp(iprof) + 1 ) + 1
-
-
-               END DO loop_uv
-
-            ENDIF
-
-         ENDIF
-
-      END DO
-
-      !-----------------------------------------------------------------------
-      ! Sum up over processors
-      !-----------------------------------------------------------------------
-      
-      CALL obs_mpp_sum_integer ( iuv3dt, iuv3dtmpp )
-      
-      CALL obs_mpp_sum_integers( itypuv, itypuvmpp, ntyp1770 + 1 )
-      
-      !-----------------------------------------------------------------------
-      ! Output number of observations.
-      !-----------------------------------------------------------------------
-      IF(lwp) THEN
-         WRITE(numout,*) 
-         WRITE(numout,'(1X,A)') 'Profile U,V velocity data'
-         WRITE(numout,'(1X,A)') '-------------------------'
-         WRITE(numout,*) 
-         DO ji = 0, ntyp1770
-            IF ( itypuvmpp(ji+1) > 0 ) THEN
-               WRITE(numout,'(1X,A3,A3,I8)') ctypshort(ji), ' = ', &
-                  & itypuvmpp(ji+1)
-            ENDIF
-         END DO
-         WRITE(numout,'(1X,A)') '--------------'
-         WRITE(numout,'(1X,A6,I8)') &
-            & 'Total profile UV data                                 = ',&
-            & iuv3dtmpp
-         WRITE(numout,'(1X,A)') '--------------'
-      ENDIF
-      
-      profdata%nvprot(1)    = iuv3dt
-      profdata%nvprot(2)    = iuv3dt
-      profdata%nvprotmpp(1) = iuv3dtmpp
-      profdata%nvprotmpp(2) = iuv3dtmpp
-      profdata%nprof        = iprof
-
-      !-----------------------------------------------------------------------
-      ! Model level search
-      !-----------------------------------------------------------------------
-      CALL obs_level_search( jpk, gdept_1d,          &
-         & profdata%nvprot(1), profdata%var(1)%vdep, &
-         & profdata%var(1)%mvk )
-      CALL obs_level_search( jpk, gdept_1d,          &
-         & profdata%nvprot(2), profdata%var(2)%vdep, &
-         & profdata%var(2)%mvk )
-      
-      !-----------------------------------------------------------------------
-      ! Set model equivalent to 99999
-      !-----------------------------------------------------------------------
-      IF ( .NOT. ldmod ) THEN
-         DO jvar = 1, kvars
-            profdata%var(jvar)%vmod(:) = fbrmdi
-         END DO
-      ENDIF
-      !-----------------------------------------------------------------------
-      ! Deallocate temporary data
-      !-----------------------------------------------------------------------
-      DEALLOCATE( ifileidx, iprofidx, zdat )
-
-      !-----------------------------------------------------------------------
-      ! Deallocate input data
-      !-----------------------------------------------------------------------
-      DO jj = 1, inobf
-         CALL dealloc_obfbdata( inpfiles(jj) )
-      END DO
-      DEALLOCATE( inpfiles )
-
-   END SUBROUTINE obs_rea_vel_dri
-   
-END MODULE obs_read_vel
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 6808)
@@ -24,5 +24,5 @@
    USE lib_mpp          ! MPP library
    USE dom_oce, ONLY : &                  ! Domain variables
-      &                    tmask, tmask_i, e1t, e2t, gphit, glamt
+      &                    tmask, tmask_i, e1e2t, gphit, glamt
    USE obs_const, ONLY :   obfillflt      ! Fillvalue
    USE oce      , ONLY :   sshn           ! Model variables
@@ -31,10 +31,10 @@
    PRIVATE
    
-   PUBLIC   obs_rea_mdt     ! called by ?
-   PUBLIC   obs_offset_mdt  ! called by ?
-
-   INTEGER , PUBLIC ::   nmsshc    = 1         ! MDT correction scheme
-   REAL(wp), PUBLIC ::   mdtcorr   = 1.61_wp   ! User specified MDT correction
-   REAL(wp), PUBLIC ::   mdtcutoff = 65.0_wp   ! MDT cutoff for computed correction
+   PUBLIC   obs_rea_mdt     ! called by dia_obs_init
+   PUBLIC   obs_offset_mdt  ! called by obs_rea_mdt
+
+   INTEGER , PUBLIC :: nn_msshc    = 1         ! MDT correction scheme
+   REAL(wp), PUBLIC :: rn_mdtcorr   = 1.61_wp  ! User specified MDT correction
+   REAL(wp), PUBLIC :: rn_mdtcutoff = 65.0_wp  ! MDT cutoff for computed correction
 
    !!----------------------------------------------------------------------
@@ -45,5 +45,5 @@
 CONTAINS
 
-   SUBROUTINE obs_rea_mdt( kslano, sladata, k2dint )
+   SUBROUTINE obs_rea_mdt( sladata, k2dint )
       !!---------------------------------------------------------------------
       !!
@@ -58,12 +58,10 @@
       USE iom
       !
-      INTEGER                          , INTENT(IN)    ::   kslano    ! Number of SLA Products
-      TYPE(obs_surf), DIMENSION(kslano), INTENT(inout) ::   sladata   ! SLA data
-      INTEGER                          , INTENT(in)    ::   k2dint    ! ?
+      TYPE(obs_surf), INTENT(inout) ::   sladata   ! SLA data
+      INTEGER       , INTENT(in)    ::   k2dint    ! ?
       !
       CHARACTER(LEN=12), PARAMETER ::   cpname  = 'obs_rea_mdt'
       CHARACTER(LEN=20), PARAMETER ::   mdtname = 'slaReferenceLevel.nc'
 
-      INTEGER ::   jslano              ! Data set loop variable
       INTEGER ::   jobs                ! Obs loop variable
       INTEGER ::   jpimdt, jpjmdt      ! Number of grid point in lat/lon for the MDT
@@ -88,4 +86,5 @@
       IF(lwp)WRITE(numout,*) ' obs_rea_mdt : Read MDT for referencing altimeter anomalies'
       IF(lwp)WRITE(numout,*) ' ------------- '
+      CALL FLUSH(numout)
 
       CALL iom_open( mdtname, nummdt )       ! Open the file
@@ -109,71 +108,70 @@
 
       ! Remove the offset between the MDT used with the sla and the model MDT
-      IF( nmsshc == 1 .OR. nmsshc == 2 )   CALL obs_offset_mdt( z_mdt, zfill )
+      IF( nn_msshc == 1 .OR. nn_msshc == 2 ) &
+         & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill )
 
       ! Intepolate the MDT already on the model grid at the observation point
   
-      DO jslano = 1, kslano
-         ALLOCATE( &
-            & igrdi(2,2,sladata(jslano)%nsurf), &
-            & igrdj(2,2,sladata(jslano)%nsurf), &
-            & zglam(2,2,sladata(jslano)%nsurf), &
-            & zgphi(2,2,sladata(jslano)%nsurf), &
-            & zmask(2,2,sladata(jslano)%nsurf), &
-            & zmdtl(2,2,sladata(jslano)%nsurf)  &
-            & )
+      ALLOCATE( &
+         & igrdi(2,2,sladata%nsurf), &
+         & igrdj(2,2,sladata%nsurf), &
+         & zglam(2,2,sladata%nsurf), &
+         & zgphi(2,2,sladata%nsurf), &
+         & zmask(2,2,sladata%nsurf), &
+         & zmdtl(2,2,sladata%nsurf)  &
+         & )
          
-         DO jobs = 1, sladata(jslano)%nsurf
-
-            igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1
-            igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1
-            igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1
-            igrdj(1,2,jobs) = sladata(jslano)%mj(jobs)
-            igrdi(2,1,jobs) = sladata(jslano)%mi(jobs)
-            igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1
-            igrdi(2,2,jobs) = sladata(jslano)%mi(jobs)
-            igrdj(2,2,jobs) = sladata(jslano)%mj(jobs)
-
-         END DO
-
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, glamt  , zglam )
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, gphit  , zgphi )
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, mdtmask, zmask )
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, z_mdt  , zmdtl )
-
-         DO jobs = 1, sladata(jslano)%nsurf
+      DO jobs = 1, sladata%nsurf
+
+         igrdi(1,1,jobs) = sladata%mi(jobs)-1
+         igrdj(1,1,jobs) = sladata%mj(jobs)-1
+         igrdi(1,2,jobs) = sladata%mi(jobs)-1
+         igrdj(1,2,jobs) = sladata%mj(jobs)
+         igrdi(2,1,jobs) = sladata%mi(jobs)
+         igrdj(2,1,jobs) = sladata%mj(jobs)-1
+         igrdi(2,2,jobs) = sladata%mi(jobs)
+         igrdj(2,2,jobs) = sladata%mj(jobs)
+
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, glamt  , zglam )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, gphit  , zgphi )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, mdtmask, zmask )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, z_mdt  , zmdtl )
+
+      DO jobs = 1, sladata%nsurf
             
-            zlam = sladata(jslano)%rlam(jobs)
-            zphi = sladata(jslano)%rphi(jobs)
-
-            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
-               &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
-               &                   zmask(:,:,jobs), zweig, zobsmask )
+         zlam = sladata%rlam(jobs)
+         zphi = sladata%rphi(jobs)
+
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
+            &                   zmask(:,:,jobs), zweig, zobsmask )
             
-            CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs),  zext )
+         CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs),  zext )
  
-            sladata(jslano)%rext(jobs,2) = zext(1)
+         sladata%rext(jobs,2) = zext(1)
 
 ! mark any masked data with a QC flag
-            IF( zobsmask(1) == 0 )   sladata(jslano)%nqc(jobs) = 11
+         IF( zobsmask(1) == 0 )   sladata%nqc(jobs) = 11
 
          END DO
          
-         DEALLOCATE( &
-            & igrdi, &
-            & igrdj, &
-            & zglam, &
-            & zgphi, &
-            & zmask, &
-            & zmdtl  &
-            & )
-
-      END DO
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zmdtl  &
+         & )
 
       CALL wrk_dealloc(jpi,jpj,z_mdt,mdtmask) 
+      IF(lwp)WRITE(numout,*) ' ------------- '
       !
    END SUBROUTINE obs_rea_mdt
 
 
-   SUBROUTINE obs_offset_mdt( mdt, zfill )
+   SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill )
       !!---------------------------------------------------------------------
       !!
@@ -188,6 +186,7 @@
       !! ** Action  : 
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   mdt     ! MDT used on the model grid
-      REAL(wp)                    , INTENT(in   ) ::   zfill 
+      INTEGER, INTENT(IN) ::  kpi, kpj
+      REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) ::   mdt     ! MDT used on the model grid
+      REAL(wp)                    , INTENT(IN   ) ::   zfill 
       ! 
       INTEGER  :: ji, jj
@@ -205,6 +204,6 @@
         DO jj = 1, jpj
            zpromsk(ji,jj) = tmask_i(ji,jj)
-           IF (    ( gphit(ji,jj) .GT.  mdtcutoff ) &
-              &.OR.( gphit(ji,jj) .LT. -mdtcutoff ) &
+           IF (    ( gphit(ji,jj) .GT.  rn_mdtcutoff ) &
+              &.OR.( gphit(ji,jj) .LT. -rn_mdtcutoff ) &
               &.OR.( mdt(ji,jj) .EQ. zfill ) ) &
               &        zpromsk(ji,jj) = 0.0
@@ -212,5 +211,5 @@
       END DO 
 
-      ! Compute MSSH mean over [0,360] x [-mdtcutoff,mdtcutoff]
+      ! Compute MSSH mean over [0,360] x [-rn_mdtcutoff,rn_mdtcutoff]
 
       zarea = 0.0
@@ -220,5 +219,5 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-          zdxdy = e1t(ji,jj) * e2t(ji,jj) * zpromsk(ji,jj)
+          zdxdy = e1e2t(ji,jj) * zpromsk(ji,jj)
           zarea = zarea + zdxdy
           zeta1 = zeta1 + mdt(ji,jj) * zdxdy
@@ -240,22 +239,22 @@
       !  Correct spatial mean of the MSSH
 
-      IF( nmsshc == 1 )   mdt(:,:) = mdt(:,:) - zcorr  
+      IF( nn_msshc == 1 )   mdt(:,:) = mdt(:,:) - zcorr  
 
       ! User defined value : 1.6 m for the Rio MDT compared to ORCA2 MDT
 
-      IF( nmsshc == 2 )   mdt(:,:) = mdt(:,:) - mdtcorr
+      IF( nn_msshc == 2 )   mdt(:,:) = mdt(:,:) - rn_mdtcorr
 
       IF(lwp) THEN
          WRITE(numout,*)
-         WRITE(numout,*) ' obs_readmdt : mdtcutoff     = ', mdtcutoff
+         WRITE(numout,*) ' obs_readmdt : rn_mdtcutoff     = ', rn_mdtcutoff
          WRITE(numout,*) ' -----------   zcorr_mdt     = ', zcorr_mdt
          WRITE(numout,*) '               zcorr_bcketa  = ', zcorr_bcketa
          WRITE(numout,*) '               zcorr         = ', zcorr
-         WRITE(numout,*) '               nmsshc        = ', nmsshc
+         WRITE(numout,*) '               nn_msshc        = ', nn_msshc
       ENDIF
 
-      IF ( nmsshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied'
-      IF ( nmsshc == 1 ) WRITE(numout,*) '           MSSH correction is applied'
-      IF ( nmsshc == 2 ) WRITE(numout,*) '           User defined MSSH correction' 
+      IF ( nn_msshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied'
+      IF ( nn_msshc == 1 ) WRITE(numout,*) '           MSSH correction is applied'
+      IF ( nn_msshc == 2 ) WRITE(numout,*) '           User defined MSSH correction' 
 
       CALL wrk_dealloc( jpi,jpj, zpromsk )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90	(revision 6808)
@@ -140,23 +140,23 @@
       END DO
 
-      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
          &                  glamu, zglamu )
-      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
          &                  gphiu, zgphiu )
-      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
          &                  umask(:,:,1), zmasku )
-      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
          &                  zsingu, zsinlu )
-      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
          &                  zcosgu, zcoslu )
-      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
          &                  glamv, zglamv )
-      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
          &                  gphiv, zgphiv )
-      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
          &                  vmask(:,:,1), zmaskv )
-      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
          &                  zsingv, zsinlv )
-      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
          &                  zcosgv, zcoslv )
 
@@ -195,7 +195,7 @@
          DO jk = profdata%npvsta(ji,1), profdata%npvend(ji,1)
             IF ( ( profdata%var(1)%vmod(jk) /= fbrmdi ) .AND. &
-               & ( profdata%var(1)%vmod(jk) /= fbrmdi ) ) THEN
+               & ( profdata%var(2)%vmod(jk) /= fbrmdi ) ) THEN
                pu(jk) = profdata%var(1)%vmod(jk) * zcos - &
-                  &     profdata%var(2)%vmod(jk) * zsin 
+                  &     profdata%var(2)%vmod(jk) * zsin
                pv(jk) = profdata%var(2)%vmod(jk) * zcos + &
                   &     profdata%var(1)%vmod(jk) * zsin
@@ -204,4 +204,5 @@
                pv(jk) = fbrmdi
             ENDIF
+
          END DO
 
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice.F90	(revision 6807)
+++ 	(revision )
@@ -1,35 +1,0 @@
-MODULE obs_seaice
-   !!=====================================================================
-   !!                       ***  MODULE  obs_seaice  ***
-   !! Observation diagnostics: Storage space for sea ice observations
-   !!                          arrays and additional flags etc.
-   !!=====================================================================
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   
-   !! * Modules used 
-   USE obs_surf_def ! Definition of sea ice data types and tools
-
-   IMPLICIT NONE
-   
-   SAVE
-
-   !! * Routine accessibility
-   PRIVATE
-
-   PUBLIC nseaicevars, nseaiceextr, nseaicesets, seaicedata, seaicedatqc
-
-   !! * Shared Module variables
-   INTEGER :: nseaicevars                               ! Number of seaicedata variables
-   INTEGER :: nseaiceextr                               ! Number of seaicedata extra 
-                                                     ! variables
-   INTEGER :: nseaicesets                               ! Number of seaicedata sets
-   TYPE(obs_surf), POINTER, DIMENSION(:) :: seaicedata  ! Initial sea ice data
-   TYPE(obs_surf), POINTER, DIMENSION(:) :: seaicedatqc ! Sea ice data after quality control
-
-END MODULE obs_seaice
-
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice_io.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice_io.F90	(revision 6807)
+++ 	(revision )
@@ -1,30 +1,0 @@
-MODULE obs_seaice_io
-   !!======================================================================
-   !!                       ***  MODULE obs_seaice_io  ***
-   !! Observation operators : I/O for GHRSEAICE files
-   !!======================================================================
-   !! History : 
-   !!             !  09-01  (K. Mogensen) Initial version
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   read_seaicefile    :  Read a obfbdata structure from an GHRSEAICE file
-   !!----------------------------------------------------------------------
-   USE par_kind
-   USE obs_utils
-   USE obs_fbm
-   USE julian
-   USE netcdf
-
-   IMPLICIT NONE
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-#include "obsseaice_io.h90"
-
-END MODULE obs_seaice_io
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla.F90	(revision 6807)
+++ 	(revision )
@@ -1,33 +1,0 @@
-MODULE obs_sla
-   !!=====================================================================
-   !!                       ***  MODULE  obs_sla  ***
-   !! Observation diagnostics: Storage space for SLA observations
-   !!                          arrays and additional flags etc.
-   !!=====================================================================
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-   
-   !! * Modules used 
-   USE obs_surf_def ! Definition of SLA data types and tools
-
-   IMPLICIT NONE
-   
-   SAVE
-
-   !! * Routine accessibility
-   PRIVATE
-
-   PUBLIC nslavars, nslaextr, nslasets, sladata, sladatqc
-
-   !! * Shared Module variables
-   INTEGER :: nslavars                               ! Number of sladata variables
-   INTEGER :: nslaextr                               ! Number of sladata extra 
-                                                     ! variables
-   INTEGER :: nslasets                               ! Number of sladata sets                                               
-   TYPE(obs_surf), POINTER, DIMENSION(:) :: sladata  ! Initial SLA data
-   TYPE(obs_surf), POINTER, DIMENSION(:) :: sladatqc ! SLA data after quality control
-
-END MODULE obs_sla
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_io.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_io.F90	(revision 6807)
+++ 	(revision )
@@ -1,30 +1,0 @@
-MODULE obs_sla_io
-   !!======================================================================
-   !!                       ***  MODULE obs_sla_io  ***
-   !! Observation operators : I/O for AVISO SLA files
-   !!======================================================================
-   !! History : 
-   !!             !  09-01  (K. Mogensen) Initial version
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   read_enactfile    :  Read a obfbdata structure from an AVISO SLA file
-   !!----------------------------------------------------------------------
-   USE par_kind
-   USE obs_utils
-   USE obs_fbm
-   use obs_sla_types
-   USE netcdf
-
-   IMPLICIT NONE
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-#include "obssla_io.h90"
-
-END MODULE obs_sla_io
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_types.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_types.F90	(revision 6807)
+++ 	(revision )
@@ -1,19 +1,0 @@
-MODULE obs_sla_types
-   !!======================================================================
-   !!                       ***  MODULE obs_sla_type  ***
-   !! Observation operators : Satellite identifiers for SLA data
-   !!======================================================================
-   !! History : 
-   !!             !  09-01  (K. Mogensen) Initial version
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   IMPLICIT NONE
-
-#include "obssla_types.h90"
-
-END MODULE obs_sla_types
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst.F90	(revision 6807)
+++ 	(revision )
@@ -1,35 +1,0 @@
-MODULE obs_sst
-   !!=====================================================================
-   !!                       ***  MODULE  obs_sst  ***
-   !! Observation diagnostics: Storage space for SST observations
-   !!                          arrays and additional flags etc.
-   !!=====================================================================
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   
-   !! * Modules used 
-   USE obs_surf_def ! Definition of SST data types and tools
-
-   IMPLICIT NONE
-   
-   SAVE
-
-   !! * Routine accessibility
-   PRIVATE
-
-   PUBLIC nsstvars, nsstextr, nsstsets, sstdata, sstdatqc
-
-   !! * Shared Module variables
-   INTEGER :: nsstvars                               ! Number of sstdata variables
-   INTEGER :: nsstextr                               ! Number of sstdata extra 
-                                                     ! variables
-   INTEGER :: nsstsets                               ! Number of sstdata sets
-   TYPE(obs_surf), POINTER, DIMENSION(:) :: sstdata  ! Initial SST data
-   TYPE(obs_surf), POINTER, DIMENSION(:) :: sstdatqc ! SST data after quality control
-
-END MODULE obs_sst
-
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst_io.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst_io.F90	(revision 6807)
+++ 	(revision )
@@ -1,30 +1,0 @@
-MODULE obs_sst_io
-   !!======================================================================
-   !!                       ***  MODULE obs_sst_io  ***
-   !! Observation operators : I/O for GHRSST files
-   !!======================================================================
-   !! History : 
-   !!             !  09-01  (K. Mogensen) Initial version
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   read_sstfile    :  Read a obfbdata structure from an GHRSST file
-   !!----------------------------------------------------------------------
-   USE par_kind
-   USE obs_utils
-   USE obs_fbm
-   USE julian
-   USE netcdf
-
-   IMPLICIT NONE
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-#include "obssst_io.h90"
-
-END MODULE obs_sst_io
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sstbias.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sstbias.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sstbias.F90	(revision 6808)
@@ -0,0 +1,244 @@
+MODULE obs_sstbias
+   !!======================================================================
+   !!                       ***  MODULE obs_readsstbias  ***
+   !! Observation diagnostics: Read the bias for SLA data
+   !!======================================================================
+   !!----------------------------------------------------------------------
+   !!   obs_rea_sstbias : Driver for reading altimeter bias
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE par_kind, ONLY : &       ! Precision variables
+      & wp, &
+      & dp, &
+      & sp
+   USE par_oce, ONLY : &        ! Domain parameters
+      & jpi, &
+      & jpj, &
+      & jpim1
+   USE in_out_manager, ONLY : & ! I/O manager
+      & lwp,    &
+      & numout 
+   USE obs_surf_def             ! Surface observation definitions
+   USE dom_oce, ONLY : &        ! Domain variables
+      & tmask, &
+      & tmask_i, &
+      & e1t,   &
+      & e2t,   &
+      & gphit, &
+      & glamt
+   USE oce, ONLY : &           ! Model variables
+      & sshn
+   USE obs_inter_h2d
+   USE obs_utils               ! Various observation tools
+   USE obs_inter_sup
+   IMPLICIT NONE
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC obs_app_sstbias     ! Read the altimeter bias
+CONTAINS
+   SUBROUTINE obs_app_sstbias( sstdata, k2dint, knumtypes, &
+                               cl_bias_files )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_app_sstbias ***
+      !!
+      !! ** Purpose : Read SST bias data from files and apply correction to
+      !!             observations
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  :
+      !!
+      !! References :
+      !!
+      !! History : 
+      !!      ! :  2014-08 (J. While) Bias correction code for SST obs,
+      !!      !                      based on obs_rea_altbias
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE iom
+      USE netcdf
+      !! * Arguments
+
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata       ! SST data
+      INTEGER, INTENT(IN) :: k2dint
+      INTEGER, INTENT(IN) :: knumtypes !number of bias types to read in
+      CHARACTER(LEN=128), DIMENSION(knumtypes), INTENT(IN) :: &
+                          cl_bias_files !List of files to read
+      !! * Local declarations
+      INTEGER :: jobs         ! Obs loop variable
+      INTEGER :: jpisstbias   ! Number of grid point in latitude for the bias
+      INTEGER :: jpjsstbias   ! Number of grid point in longitude for the bias
+      INTEGER :: iico         ! Grid point indices
+      INTEGER :: ijco
+      INTEGER :: jt
+      INTEGER :: i_nx_id      ! Index to read the NetCDF file
+      INTEGER :: i_ny_id      !
+      INTEGER :: i_file_id    !
+      INTEGER :: i_var_id
+      INTEGER, DIMENSION(knumtypes) :: &
+         & ibiastypes             ! Array of the bias types in each file
+      REAL(wp), DIMENSION(jpi,jpj,knumtypes) :: & 
+         & z_sstbias              ! Array to store the SST bias values
+      REAL(wp), DIMENSION(jpi,jpj) :: & 
+         & z_sstbias_2d           ! Array to store the SST bias values   
+      REAL(wp), DIMENSION(1) :: &
+         & zext, &
+         & zobsmask
+      REAL(wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zglam, &
+         & zgphi
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask_tmp, &
+         & zglam_tmp, &
+         & zgphi_tmp   
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  zbias   
+      REAL(wp) :: zlam
+      REAL(wp) :: zphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi_tmp, &
+         & igrdj_tmp   
+      INTEGER :: numsstbias
+      INTEGER(KIND=NF90_INT) :: ifile_source
+     
+      INTEGER :: incfile
+      INTEGER :: jtype
+      INTEGER :: iret 
+      INTEGER :: inumtype
+      IF(lwp)WRITE(numout,*) 
+      IF(lwp)WRITE(numout,*) 'obs_rea_sstbias : '
+      IF(lwp)WRITE(numout,*) '----------------- '
+      IF(lwp)WRITE(numout,*) 'Read SST bias '
+      ! Open and read the files
+      z_sstbias(:,:,:)=0.0_wp
+      DO jtype = 1, knumtypes
+     
+         numsstbias=0
+         IF(lwp)WRITE(numout,*) 'Opening ',cl_bias_files(jtype)
+         CALL iom_open( cl_bias_files(jtype), numsstbias, ldstop=.FALSE. )       
+         IF (numsstbias > 0) THEN
+     
+            !Read the bias type from the file
+            !No IOM get attribute command at time of writing, 
+            !so have to use NETCDF
+            !routines directly - should be upgraded in the future
+            iret=NF90_OPEN(TRIM(cl_bias_files(jtype)), NF90_NOWRITE, incfile)
+            iret=NF90_GET_ATT( incfile, NF90_GLOBAL, "SST_source", &
+                              ifile_source )
+            ibiastypes(jtype) = ifile_source                 
+            iret=NF90_CLOSE(incfile)       
+           
+            IF ( iret /= 0  ) CALL ctl_stop( &
+               'obs_rea_sstbias : Cannot read bias type from file '// &
+               cl_bias_files(jtype) )
+            ! Get the SST bias data
+            CALL iom_get( numsstbias, jpdom_data, 'sst', z_sstbias_2d(:,:), 1 )
+            z_sstbias(:,:,jtype) = z_sstbias_2d(:,:)       
+            ! Close the file
+            CALL iom_close(numsstbias)       
+         ELSE
+            CALL ctl_stop('obs_read_sstbias: File '// & 
+                           TRIM( cl_bias_files(jtype) )//' Not found')
+         ENDIF
+      END DO
+           
+      ! Interpolate the bias already on the model grid at the observation point
+      ALLOCATE( &
+         & igrdi(2,2,sstdata%nsurf), &
+         & igrdj(2,2,sstdata%nsurf), &
+         & zglam(2,2,sstdata%nsurf), &
+         & zgphi(2,2,sstdata%nsurf), &
+         & zmask(2,2,sstdata%nsurf)  )
+       
+      DO jobs = 1, sstdata%nsurf 
+         igrdi(1,1,jobs) = sstdata%mi(jobs)-1
+         igrdj(1,1,jobs) = sstdata%mj(jobs)-1
+         igrdi(1,2,jobs) = sstdata%mi(jobs)-1
+         igrdj(1,2,jobs) = sstdata%mj(jobs)
+         igrdi(2,1,jobs) = sstdata%mi(jobs)
+         igrdj(2,1,jobs) = sstdata%mj(jobs)-1
+         igrdi(2,2,jobs) = sstdata%mi(jobs)
+         igrdj(2,2,jobs) = sstdata%mj(jobs)
+      END DO
+      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, tmask(:,:,1), zmask )
+      DO jtype = 1, knumtypes
+         
+         !Find the number observations of type and allocate tempory arrays
+         inumtype = COUNT( sstdata%ntyp(:) == ibiastypes(jtype) )
+         ALLOCATE( &
+            & igrdi_tmp(2,2,inumtype), &
+            & igrdj_tmp(2,2,inumtype), &
+            & zglam_tmp(2,2,inumtype), &
+            & zgphi_tmp(2,2,inumtype), &
+            & zmask_tmp(2,2,inumtype), &
+            & zbias( 2,2,inumtype ) )
+         jt=1
+         DO jobs = 1, sstdata%nsurf 
+            IF ( sstdata%ntyp(jobs) == ibiastypes(jtype) ) THEN
+               igrdi_tmp(:,:,jt) = igrdi(:,:,jobs) 
+               igrdj_tmp(:,:,jt) = igrdj(:,:,jobs)
+               zglam_tmp(:,:,jt) = zglam(:,:,jobs)
+               zgphi_tmp(:,:,jt) = zgphi(:,:,jobs)
+               zgphi_tmp(:,:,jt) = zgphi(:,:,jobs)
+               zmask_tmp(:,:,jt) = zmask(:,:,jobs)
+               jt = jt +1
+            ENDIF
+         END DO
+                         
+         CALL obs_int_comm_2d( 2, 2, inumtype, jpi, jpj, &
+               &           igrdi_tmp(:,:,:), igrdj_tmp(:,:,:), &
+               &           z_sstbias(:,:,jtype), zbias(:,:,:) )
+         jt=1
+         DO jobs = 1, sstdata%nsurf
+            IF ( sstdata%ntyp(jobs) == ibiastypes(jtype) ) THEN
+               zlam = sstdata%rlam(jobs)
+               zphi = sstdata%rphi(jobs)
+               iico = sstdata%mi(jobs)
+               ijco = sstdata%mj(jobs)         
+               CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+                  &                   zglam_tmp(:,:,jt), &
+                  &                   zgphi_tmp(:,:,jt), &
+                  &                   zmask_tmp(:,:,jt), zweig, zobsmask )
+               CALL obs_int_h2d( 1, 1, zweig, zbias(:,:,jt),  zext )
+               ! adjust sst with bias field
+               sstdata%robs(jobs,1) = sstdata%robs(jobs,1) - zext(1)
+               jt=jt+1
+            ENDIF
+         END DO 
+               
+         !Deallocate arrays
+         DEALLOCATE( &
+         & igrdi_tmp, &
+         & igrdj_tmp, &
+         & zglam_tmp, &
+         & zgphi_tmp, &
+         & zmask_tmp, &
+         & zbias )           
+      END DO
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask )
+
+      IF(lwp) THEN
+         WRITE(numout,*) " "
+         WRITE(numout,*) "SST bias correction applied successfully"
+         WRITE(numout,*) "Obs types: ",ibiastypes(:), &
+                              " Have all been bias corrected\n"
+      ENDIF
+   END SUBROUTINE obs_app_sstbias
+ 
+END MODULE obs_sstbias
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90	(revision 6808)
@@ -67,4 +67,7 @@
          & ntyp           !: Type of surface observation product
 
+      CHARACTER(len=6), POINTER, DIMENSION(:) :: &
+         & cvars          !: Variable names
+
       CHARACTER(LEN=8), POINTER, DIMENSION(:) :: &
          & cwmo           !: WMO indentifier
@@ -130,4 +133,5 @@
       !!* Local variables
       INTEGER :: ji
+      INTEGER :: jvar
 
       ! Set bookkeeping variables
@@ -140,4 +144,14 @@
       surf%npi      = kpi
       surf%npj      = kpj
+
+      ! Allocate arrays of size number of variables
+
+      ALLOCATE( &
+         & surf%cvars(kvar)    &
+         & )
+
+      DO jvar = 1, kvar
+         surf%cvars(jvar) = "NotSet"
+      END DO
       
       ! Allocate arrays of number of surface data size
@@ -271,4 +285,10 @@
          & )
 
+      ! Dellocate arrays of size number of variables
+
+      DEALLOCATE( &
+         & surf%cvars     &
+         & )
+
    END SUBROUTINE obs_surf_dealloc
 
@@ -392,5 +412,6 @@
       ! Set book keeping variables which do not depend on number of obs.
 
-      newsurf%nstp  = surf%nstp
+      newsurf%nstp     = surf%nstp
+      newsurf%cvars(:) = surf%cvars(:)
  
       ! Deallocate temporary data
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90	(revision 6808)
@@ -117,5 +117,5 @@
 
          cwmonam1770(ji) = 'Not defined'
-         ctypshort(ji) = 'XBT'
+         ctypshort(ji) = '---'
 
 !         IF ( ji < 1000 ) THEN
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_vel_io.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_vel_io.F90	(revision 6807)
+++ 	(revision )
@@ -1,32 +1,0 @@
-MODULE obs_vel_io
-   !!======================================================================
-   !!                       ***  MODULE obs_vel_io  ***
-   !! Observation operators : I/O for TAO velocity data
-   !!======================================================================
-   !! History : 
-   !!             !  09-01  (K. Mogensen) Initial version based on obs_read_taovel
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   read_taofile    :  Read a obfbdata structure from an TAO velocity file.
-   !!----------------------------------------------------------------------
-   USE par_kind
-   USE obs_utils
-   USE obs_fbm
-   USE obs_conv
-   USE in_out_manager
-   USE netcdf
-   IMPLICIT NONE
-
-   INTEGER, PARAMETER :: imaxlev = 10000
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-#include "obsvel_io.h90"
-
-END MODULE obs_vel_io
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 6808)
@@ -6,9 +6,6 @@
 
    !!----------------------------------------------------------------------
-   !!   obs_wri_p3d   : Write profile observation diagnostics in NetCDF format
-   !!   obs_wri_sla   : Write SLA observation related diagnostics
-   !!   obs_wri_sst   : Write SST observation related diagnostics
-   !!   obs_wri_seaice: Write seaice observation related diagnostics
-   !!   obs_wri_vel   : Write velocity observation diagnostics in NetCDF format
+   !!   obs_wri_prof   : Write profile observations in feedback format
+   !!   obs_wri_surf   : Write surface observations in feedback format
    !!   obs_wri_stats : Print basic statistics on the data being written out
    !!----------------------------------------------------------------------
@@ -30,6 +27,4 @@
    USE obs_conv             ! Conversion between units
    USE obs_const
-   USE obs_sla_types
-   USE obs_rot_vel          ! Rotation of velocities
    USE obs_mpp              ! MPP support routines for observation diagnostics
    USE lib_mpp		    ! MPP routines
@@ -39,10 +34,6 @@
    !! * Routine accessibility
    PRIVATE
-   PUBLIC obs_wri_p3d, &    ! Write profile observation related diagnostics
-      &   obs_wri_sla, &    ! Write SLA observation related diagnostics
-      &   obs_wri_sst, &    ! Write SST observation related diagnostics
-      &   obs_wri_sss, &    ! Write SSS observation related diagnostics
-      &   obs_wri_seaice, & ! Write seaice observation related diagnostics
-      &   obs_wri_vel, &    ! Write velocity observation related diagnostics
+   PUBLIC obs_wri_prof, &    ! Write profile observation files
+      &   obs_wri_surf, &    ! Write surface observation files
       &   obswriinfo
    
@@ -63,11 +54,10 @@
 CONTAINS
 
-   SUBROUTINE obs_wri_p3d( cprefix, profdata, padd, pext )
+   SUBROUTINE obs_wri_prof( profdata, padd, pext )
       !!-----------------------------------------------------------------------
       !!
-      !!                     *** ROUTINE obs_wri_p3d  ***
-      !!
-      !! ** Purpose : Write temperature and salinity (profile) observation 
-      !!              related diagnostics
+      !!                     *** ROUTINE obs_wri_prof  ***
+      !!
+      !! ** Purpose : Write profile feedback files
       !!
       !! ** Method  : NetCDF
@@ -82,17 +72,16 @@
       !!      ! 07-03  (K. Mogensen) General handling of profiles
       !!      ! 09-01  (K. Mogensen) New feedback format
+      !!      ! 15-02  (M. Martin) Combined routine for writing profiles
       !!-----------------------------------------------------------------------
 
-      !! * Modules used
-
       !! * Arguments
-      CHARACTER(LEN=*), INTENT(IN) :: cprefix        ! Prefix for output files
       TYPE(obs_prof), INTENT(INOUT) :: profdata      ! Full set of profile data
       TYPE(obswriinfo), OPTIONAL :: padd             ! Additional info for each variable
       TYPE(obswriinfo), OPTIONAL :: pext             ! Extra info
-      
+
       !! * Local declarations
       TYPE(obfbdata) :: fbdata
-      CHARACTER(LEN=40) :: cfname
+      CHARACTER(LEN=40) :: clfname
+      CHARACTER(LEN=6) :: clfiletype
       INTEGER :: ilevel
       INTEGER :: jvar
@@ -102,20 +91,20 @@
       INTEGER :: ja
       INTEGER :: je
+      INTEGER :: iadd
+      INTEGER :: iext
       REAL(wp) :: zpres
-      INTEGER :: nadd
-      INTEGER :: next
 
       IF ( PRESENT( padd ) ) THEN
-         nadd = padd%inum
+         iadd = padd%inum
       ELSE
-         nadd = 0
+         iadd = 0
       ENDIF
 
       IF ( PRESENT( pext ) ) THEN
-         next = pext%inum
+         iext = pext%inum
       ELSE
-         next = 0
-      ENDIF
-      
+         iext = 0
+      ENDIF
+
       CALL init_obfbdata( fbdata )
 
@@ -125,45 +114,79 @@
          ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) )
       END DO
-      CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, &
-         &                 1 + nadd, 1 + next, .TRUE. )
-
-      fbdata%cname(1)      = 'POTM'
-      fbdata%cname(2)      = 'PSAL'
-      fbdata%coblong(1)    = 'Potential temperature'
-      fbdata%coblong(2)    = 'Practical salinity'
-      fbdata%cobunit(1)    = 'Degrees centigrade'
-      fbdata%cobunit(2)    = 'PSU'
-      fbdata%cextname(1)   = 'TEMP'
-      fbdata%cextlong(1)   = 'Insitu temperature'
-      fbdata%cextunit(1)   = 'Degrees centigrade'
-      DO je = 1, next
-         fbdata%cextname(1+je) = pext%cdname(je)
-         fbdata%cextlong(1+je) = pext%cdlong(je,1)
-         fbdata%cextunit(1+je) = pext%cdunit(je,1)
-      END DO
+
+      SELECT CASE ( TRIM(profdata%cvars(1)) )
+      CASE('POTM')
+
+         clfiletype='profb'
+         CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, &
+            &                 1 + iadd, 1 + iext, .TRUE. )
+         fbdata%cname(1)      = profdata%cvars(1)
+         fbdata%cname(2)      = profdata%cvars(2)
+         fbdata%coblong(1)    = 'Potential temperature'
+         fbdata%coblong(2)    = 'Practical salinity'
+         fbdata%cobunit(1)    = 'Degrees centigrade'
+         fbdata%cobunit(2)    = 'PSU'
+         fbdata%cextname(1)   = 'TEMP'
+         fbdata%cextlong(1)   = 'Insitu temperature'
+         fbdata%cextunit(1)   = 'Degrees centigrade'
+         fbdata%caddlong(1,1) = 'Model interpolated potential temperature'
+         fbdata%caddlong(1,2) = 'Model interpolated practical salinity'
+         fbdata%caddunit(1,1) = 'Degrees centigrade'
+         fbdata%caddunit(1,2) = 'PSU'
+         fbdata%cgrid(:)      = 'T'
+         DO je = 1, iext
+            fbdata%cextname(1+je) = pext%cdname(je)
+            fbdata%cextlong(1+je) = pext%cdlong(je,1)
+            fbdata%cextunit(1+je) = pext%cdunit(je,1)
+         END DO
+         DO ja = 1, iadd
+            fbdata%caddname(1+ja) = padd%cdname(ja)
+            DO jvar = 1, 2
+               fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar)
+               fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar)
+            END DO
+         END DO
+
+      CASE('UVEL')
+
+         clfiletype='velfb'
+         CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 1, 0, .TRUE. )
+         fbdata%cname(1)      = profdata%cvars(1)
+         fbdata%cname(2)      = profdata%cvars(2)
+         fbdata%coblong(1)    = 'Zonal velocity'
+         fbdata%coblong(2)    = 'Meridional velocity'
+         fbdata%cobunit(1)    = 'm/s'
+         fbdata%cobunit(2)    = 'm/s'
+         DO je = 1, iext
+            fbdata%cextname(je) = pext%cdname(je)
+            fbdata%cextlong(je) = pext%cdlong(je,1)
+            fbdata%cextunit(je) = pext%cdunit(je,1)
+         END DO
+         fbdata%caddlong(1,1) = 'Model interpolated zonal velocity'
+         fbdata%caddlong(1,2) = 'Model interpolated meridional velocity'
+         fbdata%caddunit(1,1) = 'm/s'
+         fbdata%caddunit(1,2) = 'm/s'
+         fbdata%cgrid(1)      = 'U' 
+         fbdata%cgrid(2)      = 'V'
+         DO ja = 1, iadd
+            fbdata%caddname(1+ja) = padd%cdname(ja)
+            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
+            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
+         END DO
+
+      END SELECT
+
       fbdata%caddname(1)   = 'Hx'
-      fbdata%caddlong(1,1) = 'Model interpolated potential temperature'
-      fbdata%caddlong(1,2) = 'Model interpolated practical salinity'
-      fbdata%caddunit(1,1) = 'Degrees centigrade'
-      fbdata%caddunit(1,2) = 'PSU'
-      fbdata%cgrid(:)      = 'T'
-      DO ja = 1, nadd
-         fbdata%caddname(1+ja) = padd%cdname(ja)
-         DO jvar = 1, 2
-            fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar)
-            fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar)
-         END DO
-      END DO
-         
-      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc
 
       IF(lwp) THEN
          WRITE(numout,*)
-         WRITE(numout,*)'obs_wri_p3d :'
+         WRITE(numout,*)'obs_wri_prof :'
          WRITE(numout,*)'~~~~~~~~~~~~~'
-         WRITE(numout,*)'Writing profile feedback file : ',TRIM(cfname)
-      ENDIF
-
-      ! Transform obs_prof data structure into obfbdata structure
+         WRITE(numout,*)'Writing '//TRIM(clfiletype)//' feedback file : ',TRIM(clfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfb data structure
       fbdata%cdjuldref = '19500101000000'
       DO jo = 1, profdata%nprof
@@ -222,13 +245,14 @@
                ENDIF
                fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk)
-               DO ja = 1, nadd
+               DO ja = 1, iadd
                   fbdata%padd(ik,jo,1+ja,jvar) = &
                      & profdata%var(jvar)%vext(jk,padd%ipoint(ja))
                END DO
-               DO je = 1, next
+               DO je = 1, iext
                   fbdata%pext(ik,jo,1+je) = &
                      & profdata%var(jvar)%vext(jk,pext%ipoint(je))
                END DO
-               IF ( jvar == 1 ) THEN
+               IF ( ( jvar == 1 ) .AND. &
+                  & ( TRIM(profdata%cvars(1)) == 'POTM' ) ) THEN
                   fbdata%pext(ik,jo,1) = profdata%var(jvar)%vext(jk,1)
                ENDIF 
@@ -237,26 +261,28 @@
       END DO
 
-      ! Convert insitu temperature to potential temperature using the model
-      ! salinity if no potential temperature
-      DO jo = 1, fbdata%nobs
-         IF ( fbdata%pphi(jo) < 9999.0 ) THEN
-            DO jk = 1, fbdata%nlev
-               IF ( ( fbdata%pob(jk,jo,1) >= 9999.0 ) .AND. &
-                  & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. &
-                  & ( fbdata%padd(jk,jo,1,2) < 9999.0 ) .AND. &
-                  & ( fbdata%pext(jk,jo,1) < 9999.0 ) ) THEN
-                  zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), &
-                     &              REAL(fbdata%pphi(jo),wp) )
-                  fbdata%pob(jk,jo,1) = potemp( &
-                     &                     REAL(fbdata%padd(jk,jo,1,2), wp),  &
-                     &                     REAL(fbdata%pext(jk,jo,1), wp), &
-                     &                     zpres, 0.0_wp )
-               ENDIF
-            END DO
-         ENDIF
-      END DO
-      
+      IF ( TRIM(profdata%cvars(1)) == 'POTM' ) THEN
+         ! Convert insitu temperature to potential temperature using the model
+         ! salinity if no potential temperature
+         DO jo = 1, fbdata%nobs
+            IF ( fbdata%pphi(jo) < 9999.0 ) THEN
+               DO jk = 1, fbdata%nlev
+                  IF ( ( fbdata%pob(jk,jo,1) >= 9999.0 ) .AND. &
+                     & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. &
+                     & ( fbdata%padd(jk,jo,1,2) < 9999.0 ) .AND. &
+                     & ( fbdata%pext(jk,jo,1) < 9999.0 ) ) THEN
+                     zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), &
+                        &              REAL(fbdata%pphi(jo),wp) )
+                     fbdata%pob(jk,jo,1) = potemp( &
+                        &                     REAL(fbdata%padd(jk,jo,1,2), wp),  &
+                        &                     REAL(fbdata%pext(jk,jo,1), wp), &
+                        &                     zpres, 0.0_wp )
+                  ENDIF
+               END DO
+            ENDIF
+         END DO
+      ENDIF
+
       ! Write the obfbdata structure
-      CALL write_obfbdata( cfname, fbdata )
+      CALL write_obfbdata( clfname, fbdata )
 
       ! Output some basic statistics
@@ -264,14 +290,13 @@
 
       CALL dealloc_obfbdata( fbdata )
-     
-   END SUBROUTINE obs_wri_p3d
-
-   SUBROUTINE obs_wri_sla( cprefix, sladata, padd, pext )
+
+   END SUBROUTINE obs_wri_prof
+
+   SUBROUTINE obs_wri_surf( surfdata, padd, pext )
       !!-----------------------------------------------------------------------
       !!
-      !!                     *** ROUTINE obs_wri_sla  ***
-      !!
-      !! ** Purpose : Write SLA observation diagnostics
-      !!              related 
+      !!                     *** ROUTINE obs_wri_surf  ***
+      !!
+      !! ** Purpose : Write surface observation files
       !!
       !! ** Method  : NetCDF
@@ -281,4 +306,5 @@
       !!      ! 07-03  (K. Mogensen) Original
       !!      ! 09-01  (K. Mogensen) New feedback format.
+      !!      ! 15-02  (M. Martin) Combined surface writing routine.
       !!-----------------------------------------------------------------------
 
@@ -287,6 +313,5 @@
 
       !! * Arguments
-      CHARACTER(LEN=*), INTENT(IN) :: cprefix          ! Prefix for output files
-      TYPE(obs_surf), INTENT(INOUT) :: sladata         ! Full set of SLAa
+      TYPE(obs_surf), INTENT(INOUT) :: surfdata         ! Full set of surface data
       TYPE(obswriinfo), OPTIONAL :: padd               ! Additional info for each variable
       TYPE(obswriinfo), OPTIONAL :: pext               ! Extra info
@@ -294,76 +319,130 @@
       !! * Local declarations
       TYPE(obfbdata) :: fbdata
-      CHARACTER(LEN=40) :: cfname         ! netCDF filename
-      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sla'
+      CHARACTER(LEN=40) :: clfname         ! netCDF filename
+      CHARACTER(LEN=6)  :: clfiletype
+      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf'
       INTEGER :: jo
       INTEGER :: ja
       INTEGER :: je
-      INTEGER :: nadd
-      INTEGER :: next
+      INTEGER :: iadd
+      INTEGER :: iext
 
       IF ( PRESENT( padd ) ) THEN
-         nadd = padd%inum
+         iadd = padd%inum
       ELSE
-         nadd = 0
+         iadd = 0
       ENDIF
 
       IF ( PRESENT( pext ) ) THEN
-         next = pext%inum
+         iext = pext%inum
       ELSE
-         next = 0
+         iext = 0
       ENDIF
 
       CALL init_obfbdata( fbdata )
 
-      CALL alloc_obfbdata( fbdata, 1, sladata%nsurf, 1, &
-         &                 2 + nadd, 1 + next, .TRUE. )
-
-      fbdata%cname(1)      = 'SLA'
-      fbdata%coblong(1)    = 'Sea level anomaly'
-      fbdata%cobunit(1)    = 'Metres'
-      fbdata%cextname(1)   = 'MDT'
-      fbdata%cextlong(1)   = 'Mean dynamic topography'
-      fbdata%cextunit(1)   = 'Metres'
-      DO je = 1, next
-         fbdata%cextname(1+je) = pext%cdname(je)
-         fbdata%cextlong(1+je) = pext%cdlong(je,1)
-         fbdata%cextunit(1+je) = pext%cdunit(je,1)
-      END DO
+      SELECT CASE ( TRIM(surfdata%cvars(1)) )
+      CASE('SLA')
+
+         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, &
+            &                 2 + iadd, 1 + iext, .TRUE. )
+
+         clfiletype = 'slafb'
+         fbdata%cname(1)      = surfdata%cvars(1)
+         fbdata%coblong(1)    = 'Sea level anomaly'
+         fbdata%cobunit(1)    = 'Metres'
+         fbdata%cextname(1)   = 'MDT'
+         fbdata%cextlong(1)   = 'Mean dynamic topography'
+         fbdata%cextunit(1)   = 'Metres'
+         DO je = 1, iext
+            fbdata%cextname(je) = pext%cdname(je)
+            fbdata%cextlong(je) = pext%cdlong(je,1)
+            fbdata%cextunit(je) = pext%cdunit(je,1)
+         END DO
+         fbdata%caddlong(1,1) = 'Model interpolated SSH - MDT'
+         fbdata%caddunit(1,1) = 'Metres' 
+         fbdata%caddname(2)   = 'SSH'
+         fbdata%caddlong(2,1) = 'Model Sea surface height'
+         fbdata%caddunit(2,1) = 'Metres'
+         fbdata%cgrid(1)      = 'T'
+         DO ja = 1, iadd
+            fbdata%caddname(2+ja) = padd%cdname(ja)
+            fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1)
+            fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1)
+         END DO
+
+      CASE('SST')
+
+         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, &
+            &                 1 + iadd, iext, .TRUE. )
+
+         clfiletype = 'sstfb'
+         fbdata%cname(1)      = surfdata%cvars(1)
+         fbdata%coblong(1)    = 'Sea surface temperature'
+         fbdata%cobunit(1)    = 'Degree centigrade'
+         DO je = 1, iext
+            fbdata%cextname(je) = pext%cdname(je)
+            fbdata%cextlong(je) = pext%cdlong(je,1)
+            fbdata%cextunit(je) = pext%cdunit(je,1)
+         END DO
+         fbdata%caddlong(1,1) = 'Model interpolated SST'
+         fbdata%caddunit(1,1) = 'Degree centigrade'
+         fbdata%cgrid(1)      = 'T'
+         DO ja = 1, iadd
+            fbdata%caddname(1+ja) = padd%cdname(ja)
+            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
+            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
+         END DO
+
+      CASE('ICECON')
+
+         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, &
+            &                 1 + iadd, iext, .TRUE. )
+
+         clfiletype = 'sicfb'
+         fbdata%cname(1)      = surfdata%cvars(1)
+         fbdata%coblong(1)    = 'Sea ice'
+         fbdata%cobunit(1)    = 'Fraction'
+         DO je = 1, iext
+            fbdata%cextname(je) = pext%cdname(je)
+            fbdata%cextlong(je) = pext%cdlong(je,1)
+            fbdata%cextunit(je) = pext%cdunit(je,1)
+         END DO
+         fbdata%caddlong(1,1) = 'Model interpolated ICE'
+         fbdata%caddunit(1,1) = 'Fraction'
+         fbdata%cgrid(1)      = 'T'
+         DO ja = 1, iadd
+            fbdata%caddname(1+ja) = padd%cdname(ja)
+            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
+            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
+         END DO
+
+      END SELECT
+
       fbdata%caddname(1)   = 'Hx'
-      fbdata%caddlong(1,1) = 'Model interpolated SSH - MDT'
-      fbdata%caddunit(1,1) = 'Metres' 
-      fbdata%caddname(2)   = 'SSH'
-      fbdata%caddlong(2,1) = 'Model Sea surface height'
-      fbdata%caddunit(2,1) = 'Metres'
-      fbdata%cgrid(1)      = 'T'
-      DO ja = 1, nadd
-         fbdata%caddname(2+ja) = padd%cdname(ja)
-         fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1)
-         fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1)
-      END DO
-
-      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc
 
       IF(lwp) THEN
          WRITE(numout,*)
-         WRITE(numout,*)'obs_wri_sla :'
+         WRITE(numout,*)'obs_wri_surf :'
          WRITE(numout,*)'~~~~~~~~~~~~~'
-         WRITE(numout,*)'Writing SLA feedback file : ',TRIM(cfname)
-      ENDIF
-
-      ! Transform obs_prof data structure into obfbdata structure
+         WRITE(numout,*)'Writing '//TRIM(surfdata%cvars(1))//' feedback file : ',TRIM(clfname)
+      ENDIF
+
+      ! Transform surf data structure into obfbdata structure
       fbdata%cdjuldref = '19500101000000'
-      DO jo = 1, sladata%nsurf
-         fbdata%plam(jo)      = sladata%rlam(jo)
-         fbdata%pphi(jo)      = sladata%rphi(jo)
-         WRITE(fbdata%cdtyp(jo),'(I4)') sladata%ntyp(jo)
+      DO jo = 1, surfdata%nsurf
+         fbdata%plam(jo)      = surfdata%rlam(jo)
+         fbdata%pphi(jo)      = surfdata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') surfdata%ntyp(jo)
          fbdata%ivqc(jo,:)    = 0
          fbdata%ivqcf(:,jo,:) = 0
-         IF ( sladata%nqc(jo) > 10 ) THEN
+         IF ( surfdata%nqc(jo) > 10 ) THEN
             fbdata%ioqc(jo)    = 4
             fbdata%ioqcf(1,jo) = 0
-            fbdata%ioqcf(2,jo) = sladata%nqc(jo) - 10
+            fbdata%ioqcf(2,jo) = surfdata%nqc(jo) - 10
          ELSE
-            fbdata%ioqc(jo)    = sladata%nqc(jo)
+            fbdata%ioqc(jo)    = surfdata%nqc(jo)
             fbdata%ioqcf(:,jo) = 0
          ENDIF
@@ -372,51 +451,51 @@
          fbdata%itqc(jo)      = 0
          fbdata%itqcf(:,jo)   = 0
-         fbdata%cdwmo(jo)     = sladata%cwmo(jo)
-         fbdata%kindex(jo)    = sladata%nsfil(jo)
+         fbdata%cdwmo(jo)     = surfdata%cwmo(jo)
+         fbdata%kindex(jo)    = surfdata%nsfil(jo)
          IF (ln_grid_global) THEN
-            fbdata%iobsi(jo,1) = sladata%mi(jo)
-            fbdata%iobsj(jo,1) = sladata%mj(jo)
+            fbdata%iobsi(jo,1) = surfdata%mi(jo)
+            fbdata%iobsj(jo,1) = surfdata%mj(jo)
          ELSE
-            fbdata%iobsi(jo,1) = mig(sladata%mi(jo))
-            fbdata%iobsj(jo,1) = mjg(sladata%mj(jo))
+            fbdata%iobsi(jo,1) = mig(surfdata%mi(jo))
+            fbdata%iobsj(jo,1) = mjg(surfdata%mj(jo))
          ENDIF
          CALL greg2jul( 0, &
-            &           sladata%nmin(jo), &
-            &           sladata%nhou(jo), &
-            &           sladata%nday(jo), &
-            &           sladata%nmon(jo), &
-            &           sladata%nyea(jo), &
+            &           surfdata%nmin(jo), &
+            &           surfdata%nhou(jo), &
+            &           surfdata%nday(jo), &
+            &           surfdata%nmon(jo), &
+            &           surfdata%nyea(jo), &
             &           fbdata%ptim(jo),   &
             &           krefdate = 19500101 )
-         fbdata%padd(1,jo,1,1) = sladata%rmod(jo,1)
-         fbdata%padd(1,jo,2,1) = sladata%rext(jo,1)
-         fbdata%pob(1,jo,1)    = sladata%robs(jo,1) 
+         fbdata%padd(1,jo,1,1) = surfdata%rmod(jo,1)
+         IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%padd(1,jo,2,1) = surfdata%rext(jo,1)
+         fbdata%pob(1,jo,1)    = surfdata%robs(jo,1) 
          fbdata%pdep(1,jo)     = 0.0
          fbdata%idqc(1,jo)     = 0
          fbdata%idqcf(:,1,jo)  = 0
-         IF ( sladata%nqc(jo) > 10 ) THEN
+         IF ( surfdata%nqc(jo) > 10 ) THEN
             fbdata%ivqc(jo,1)       = 4
             fbdata%ivlqc(1,jo,1)    = 4
             fbdata%ivlqcf(1,1,jo,1) = 0
-            fbdata%ivlqcf(2,1,jo,1) = sladata%nqc(jo) - 10
+            fbdata%ivlqcf(2,1,jo,1) = surfdata%nqc(jo) - 10
          ELSE
-            fbdata%ivqc(jo,1)       = sladata%nqc(jo)
-            fbdata%ivlqc(1,jo,1)    = sladata%nqc(jo)
+            fbdata%ivqc(jo,1)       = surfdata%nqc(jo)
+            fbdata%ivlqc(1,jo,1)    = surfdata%nqc(jo)
             fbdata%ivlqcf(:,1,jo,1) = 0
          ENDIF
          fbdata%iobsk(1,jo,1)  = 0
-         fbdata%pext(1,jo,1) = sladata%rext(jo,2)
-         DO ja = 1, nadd
+         IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%pext(1,jo,1) = surfdata%rext(jo,2)
+         DO ja = 1, iadd
             fbdata%padd(1,jo,2+ja,1) = &
-               & sladata%rext(jo,padd%ipoint(ja))
-         END DO
-         DO je = 1, next
+               & surfdata%rext(jo,padd%ipoint(ja))
+         END DO
+         DO je = 1, iext
             fbdata%pext(1,jo,1+je) = &
-               & sladata%rext(jo,pext%ipoint(je))
+               & surfdata%rext(jo,pext%ipoint(je))
          END DO
       END DO
 
       ! Write the obfbdata structure
-      CALL write_obfbdata( cfname, fbdata )
+      CALL write_obfbdata( clfname, fbdata )
 
       ! Output some basic statistics
@@ -425,508 +504,5 @@
       CALL dealloc_obfbdata( fbdata )
 
-   END SUBROUTINE obs_wri_sla
-
-   SUBROUTINE obs_wri_sst( cprefix, sstdata, padd, pext )
-      !!-----------------------------------------------------------------------
-      !!
-      !!                     *** ROUTINE obs_wri_sst  ***
-      !!
-      !! ** Purpose : Write SST observation diagnostics
-      !!              related 
-      !!
-      !! ** Method  : NetCDF
-      !! 
-      !! ** Action  :
-      !!
-      !!      ! 07-07  (S. Ricci) Original
-      !!      ! 09-01  (K. Mogensen) New feedback format.
-      !!-----------------------------------------------------------------------
-
-      !! * Modules used
-      IMPLICIT NONE
-
-      !! * Arguments
-      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files
-      TYPE(obs_surf), INTENT(INOUT) :: sstdata      ! Full set of SST
-      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable
-      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info
-
-      !! * Local declarations 
-      TYPE(obfbdata) :: fbdata
-      CHARACTER(LEN=40) ::  cfname             ! netCDF filename
-      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sst'
-      INTEGER :: jo
-      INTEGER :: ja
-      INTEGER :: je
-      INTEGER :: nadd
-      INTEGER :: next
-
-      IF ( PRESENT( padd ) ) THEN
-         nadd = padd%inum
-      ELSE
-         nadd = 0
-      ENDIF
-
-      IF ( PRESENT( pext ) ) THEN
-         next = pext%inum
-      ELSE
-         next = 0
-      ENDIF
-
-      CALL init_obfbdata( fbdata )
-
-      CALL alloc_obfbdata( fbdata, 1, sstdata%nsurf, 1, &
-         &                 1 + nadd, next, .TRUE. )
-
-      fbdata%cname(1)      = 'SST'
-      fbdata%coblong(1)    = 'Sea surface temperature'
-      fbdata%cobunit(1)    = 'Degree centigrade'
-      DO je = 1, next
-         fbdata%cextname(je) = pext%cdname(je)
-         fbdata%cextlong(je) = pext%cdlong(je,1)
-         fbdata%cextunit(je) = pext%cdunit(je,1)
-      END DO
-      fbdata%caddname(1)   = 'Hx'
-      fbdata%caddlong(1,1) = 'Model interpolated SST'
-      fbdata%caddunit(1,1) = 'Degree centigrade'
-      fbdata%cgrid(1)      = 'T'
-      DO ja = 1, nadd
-         fbdata%caddname(1+ja) = padd%cdname(ja)
-         fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
-         fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
-      END DO
-
-      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*)'obs_wri_sst :'
-         WRITE(numout,*)'~~~~~~~~~~~~~'
-         WRITE(numout,*)'Writing SST feedback file : ',TRIM(cfname)
-      ENDIF
-
-      ! Transform obs_prof data structure into obfbdata structure
-      fbdata%cdjuldref = '19500101000000'
-      DO jo = 1, sstdata%nsurf
-         fbdata%plam(jo)      = sstdata%rlam(jo)
-         fbdata%pphi(jo)      = sstdata%rphi(jo)
-         WRITE(fbdata%cdtyp(jo),'(I4)') sstdata%ntyp(jo)
-         fbdata%ivqc(jo,:)    = 0
-         fbdata%ivqcf(:,jo,:) = 0
-         IF ( sstdata%nqc(jo) > 10 ) THEN
-            fbdata%ioqc(jo)    = 4
-            fbdata%ioqcf(1,jo) = 0
-            fbdata%ioqcf(2,jo) = sstdata%nqc(jo) - 10
-         ELSE
-            fbdata%ioqc(jo)    = MAX(sstdata%nqc(jo),1)
-            fbdata%ioqcf(:,jo) = 0
-         ENDIF
-         fbdata%ipqc(jo)      = 0
-         fbdata%ipqcf(:,jo)   = 0
-         fbdata%itqc(jo)      = 0
-         fbdata%itqcf(:,jo)   = 0
-         fbdata%cdwmo(jo)     = ''
-         fbdata%kindex(jo)    = sstdata%nsfil(jo)
-         IF (ln_grid_global) THEN
-            fbdata%iobsi(jo,1) = sstdata%mi(jo)
-            fbdata%iobsj(jo,1) = sstdata%mj(jo)
-         ELSE
-            fbdata%iobsi(jo,1) = mig(sstdata%mi(jo))
-            fbdata%iobsj(jo,1) = mjg(sstdata%mj(jo))
-         ENDIF
-         CALL greg2jul( 0, &
-            &           sstdata%nmin(jo), &
-            &           sstdata%nhou(jo), &
-            &           sstdata%nday(jo), &
-            &           sstdata%nmon(jo), &
-            &           sstdata%nyea(jo), &
-            &           fbdata%ptim(jo),   &
-            &           krefdate = 19500101 )
-         fbdata%padd(1,jo,1,1) = sstdata%rmod(jo,1)
-         fbdata%pob(1,jo,1)    = sstdata%robs(jo,1)
-         fbdata%pdep(1,jo)     = 0.0
-         fbdata%idqc(1,jo)     = 0
-         fbdata%idqcf(:,1,jo)  = 0
-         IF ( sstdata%nqc(jo) > 10 ) THEN
-            fbdata%ivqc(jo,1)       = 4
-            fbdata%ivlqc(1,jo,1)    = 4
-            fbdata%ivlqcf(1,1,jo,1) = 0
-            fbdata%ivlqcf(2,1,jo,1) = sstdata%nqc(jo) - 10
-         ELSE
-            fbdata%ivqc(jo,1)       = MAX(sstdata%nqc(jo),1)
-            fbdata%ivlqc(1,jo,1)    = MAX(sstdata%nqc(jo),1)
-            fbdata%ivlqcf(:,1,jo,1) = 0
-         ENDIF
-         fbdata%iobsk(1,jo,1)  = 0
-         DO ja = 1, nadd
-            fbdata%padd(1,jo,1+ja,1) = &
-               & sstdata%rext(jo,padd%ipoint(ja))
-         END DO
-         DO je = 1, next
-            fbdata%pext(1,jo,je) = &
-               & sstdata%rext(jo,pext%ipoint(je))
-         END DO
-
-      END DO
-
-      ! Write the obfbdata structure
-
-      CALL write_obfbdata( cfname, fbdata )
-
-      ! Output some basic statistics
-      CALL obs_wri_stats( fbdata )
-
-      CALL dealloc_obfbdata( fbdata )
-
-   END SUBROUTINE obs_wri_sst
-
-   SUBROUTINE obs_wri_sss
-   END SUBROUTINE obs_wri_sss
-
-   SUBROUTINE obs_wri_seaice( cprefix, seaicedata, padd, pext )
-      !!-----------------------------------------------------------------------
-      !!
-      !!                     *** ROUTINE obs_wri_seaice  ***
-      !!
-      !! ** Purpose : Write sea ice observation diagnostics
-      !!              related 
-      !!
-      !! ** Method  : NetCDF
-      !! 
-      !! ** Action  :
-      !!
-      !!      ! 07-07  (S. Ricci) Original
-      !!      ! 09-01  (K. Mogensen) New feedback format.
-      !!-----------------------------------------------------------------------
-
-      !! * Modules used
-      IMPLICIT NONE
-
-      !! * Arguments
-      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files
-      TYPE(obs_surf), INTENT(INOUT) :: seaicedata   ! Full set of sea ice
-      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable
-      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info
-
-      !! * Local declarations 
-      TYPE(obfbdata) :: fbdata
-      CHARACTER(LEN=40) :: cfname             ! netCDF filename
-      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_seaice'
-      INTEGER :: jo
-      INTEGER :: ja
-      INTEGER :: je
-      INTEGER :: nadd
-      INTEGER :: next
-
-      IF ( PRESENT( padd ) ) THEN
-         nadd = padd%inum
-      ELSE
-         nadd = 0
-      ENDIF
-
-      IF ( PRESENT( pext ) ) THEN
-         next = pext%inum
-      ELSE
-         next = 0
-      ENDIF
-
-      CALL init_obfbdata( fbdata )
-
-      CALL alloc_obfbdata( fbdata, 1, seaicedata%nsurf, 1, 1, 0, .TRUE. )
-
-      fbdata%cname(1)      = 'SEAICE'
-      fbdata%coblong(1)    = 'Sea ice'
-      fbdata%cobunit(1)    = 'Fraction'
-      DO je = 1, next
-         fbdata%cextname(je) = pext%cdname(je)
-         fbdata%cextlong(je) = pext%cdlong(je,1)
-         fbdata%cextunit(je) = pext%cdunit(je,1)
-      END DO
-      fbdata%caddname(1)   = 'Hx'
-      fbdata%caddlong(1,1) = 'Model interpolated ICE'
-      fbdata%caddunit(1,1) = 'Fraction'
-      fbdata%cgrid(1)      = 'T'
-      DO ja = 1, nadd
-         fbdata%caddname(1+ja) = padd%cdname(ja)
-         fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
-         fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
-      END DO
-
-      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*)'obs_wri_seaice :'
-         WRITE(numout,*)'~~~~~~~~~~~~~~~~'
-         WRITE(numout,*)'Writing SEAICE feedback file : ',TRIM(cfname)
-      ENDIF
-
-      ! Transform obs_prof data structure into obfbdata structure
-      fbdata%cdjuldref = '19500101000000'
-      DO jo = 1, seaicedata%nsurf
-         fbdata%plam(jo)      = seaicedata%rlam(jo)
-         fbdata%pphi(jo)      = seaicedata%rphi(jo)
-         WRITE(fbdata%cdtyp(jo),'(I4)') seaicedata%ntyp(jo)
-         fbdata%ivqc(jo,:)    = 0
-         fbdata%ivqcf(:,jo,:) = 0
-         IF ( seaicedata%nqc(jo) > 10 ) THEN
-            fbdata%ioqc(jo)    = 4
-            fbdata%ioqcf(1,jo) = 0
-            fbdata%ioqcf(2,jo) = seaicedata%nqc(jo) - 10
-         ELSE
-            fbdata%ioqc(jo)    = MAX(seaicedata%nqc(jo),1)
-            fbdata%ioqcf(:,jo) = 0
-         ENDIF
-         fbdata%ipqc(jo)      = 0
-         fbdata%ipqcf(:,jo)   = 0
-         fbdata%itqc(jo)      = 0
-         fbdata%itqcf(:,jo)   = 0
-         fbdata%cdwmo(jo)     = ''
-         fbdata%kindex(jo)    = seaicedata%nsfil(jo)
-         IF (ln_grid_global) THEN
-            fbdata%iobsi(jo,1) = seaicedata%mi(jo)
-            fbdata%iobsj(jo,1) = seaicedata%mj(jo)
-         ELSE
-            fbdata%iobsi(jo,1) = mig(seaicedata%mi(jo))
-            fbdata%iobsj(jo,1) = mjg(seaicedata%mj(jo))
-         ENDIF
-         CALL greg2jul( 0, &
-            &           seaicedata%nmin(jo), &
-            &           seaicedata%nhou(jo), &
-            &           seaicedata%nday(jo), &
-            &           seaicedata%nmon(jo), &
-            &           seaicedata%nyea(jo), &
-            &           fbdata%ptim(jo),   &
-            &           krefdate = 19500101 )
-         fbdata%padd(1,jo,1,1) = seaicedata%rmod(jo,1)
-         fbdata%pob(1,jo,1)    = seaicedata%robs(jo,1)
-         fbdata%pdep(1,jo)     = 0.0
-         fbdata%idqc(1,jo)     = 0
-         fbdata%idqcf(:,1,jo)  = 0
-         IF ( seaicedata%nqc(jo) > 10 ) THEN
-            fbdata%ivlqc(1,jo,1) = 4
-            fbdata%ivlqcf(1,1,jo,1) = 0
-            fbdata%ivlqcf(2,1,jo,1) = seaicedata%nqc(jo) - 10
-         ELSE
-            fbdata%ivlqc(1,jo,1) = MAX(seaicedata%nqc(jo),1)
-            fbdata%ivlqcf(:,1,jo,1) = 0
-         ENDIF
-         fbdata%iobsk(1,jo,1)  = 0
-         DO ja = 1, nadd
-            fbdata%padd(1,jo,1+ja,1) = &
-               & seaicedata%rext(jo,padd%ipoint(ja))
-         END DO
-         DO je = 1, next
-            fbdata%pext(1,jo,je) = &
-               & seaicedata%rext(jo,pext%ipoint(je))
-         END DO
-
-      END DO
-
-      ! Write the obfbdata structure
-      CALL write_obfbdata( cfname, fbdata )
-
-      ! Output some basic statistics
-      CALL obs_wri_stats( fbdata )
-
-      CALL dealloc_obfbdata( fbdata )
-
-   END SUBROUTINE obs_wri_seaice
-
-   SUBROUTINE obs_wri_vel( cprefix, profdata, k2dint, padd, pext )
-      !!-----------------------------------------------------------------------
-      !!
-      !!                     *** ROUTINE obs_wri_vel  ***
-      !!
-      !! ** Purpose : Write current (profile) observation 
-      !!              related diagnostics
-      !!
-      !! ** Method  : NetCDF
-      !! 
-      !! ** Action  :
-      !!
-      !! History :
-      !!      ! 09-01  (K. Mogensen) New feedback format routine
-      !!-----------------------------------------------------------------------
-
-      !! * Modules used
-
-      !! * Arguments
-      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files
-      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data
-      INTEGER, INTENT(IN) :: k2dint                 ! Horizontal interpolation method
-      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable
-      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info
-
-      !! * Local declarations
-      TYPE(obfbdata) :: fbdata
-      CHARACTER(LEN=40) :: cfname
-      INTEGER :: ilevel
-      INTEGER :: jvar
-      INTEGER :: jk
-      INTEGER :: ik
-      INTEGER :: jo
-      INTEGER :: ja
-      INTEGER :: je
-      INTEGER :: nadd
-      INTEGER :: next
-      REAL(wp) :: zpres
-      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
-         & zu, &
-         & zv
-
-      IF ( PRESENT( padd ) ) THEN
-         nadd = padd%inum
-      ELSE
-         nadd = 0
-      ENDIF
-
-      IF ( PRESENT( pext ) ) THEN
-         next = pext%inum
-      ELSE
-         next = 0
-      ENDIF
-
-      CALL init_obfbdata( fbdata )
-
-      ! Find maximum level
-      ilevel = 0
-      DO jvar = 1, 2
-         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) )
-      END DO
-      CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 2, 0, .TRUE. )
-
-      fbdata%cname(1)      = 'UVEL'
-      fbdata%cname(2)      = 'VVEL'
-      fbdata%coblong(1)    = 'Zonal velocity'
-      fbdata%coblong(2)    = 'Meridional velocity'
-      fbdata%cobunit(1)    = 'm/s'
-      fbdata%cobunit(2)    = 'm/s'
-      DO je = 1, next
-         fbdata%cextname(je) = pext%cdname(je)
-         fbdata%cextlong(je) = pext%cdlong(je,1)
-         fbdata%cextunit(je) = pext%cdunit(je,1)
-      END DO
-      fbdata%caddname(1)   = 'Hx'
-      fbdata%caddlong(1,1) = 'Model interpolated zonal velocity'
-      fbdata%caddlong(1,2) = 'Model interpolated meridional velocity'
-      fbdata%caddunit(1,1) = 'm/s'
-      fbdata%caddunit(1,2) = 'm/s'
-      fbdata%caddname(2)   = 'HxG'
-      fbdata%caddlong(2,1) = 'Model interpolated zonal velocity (model grid)'
-      fbdata%caddlong(2,2) = 'Model interpolated meridional velocity (model grid)'
-      fbdata%caddunit(2,1) = 'm/s'
-      fbdata%caddunit(2,2) = 'm/s' 
-      fbdata%cgrid(1)      = 'U' 
-      fbdata%cgrid(2)      = 'V'
-      DO ja = 1, nadd
-         fbdata%caddname(2+ja) = padd%cdname(ja)
-         fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1)
-         fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1)
-      END DO
-
-      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*)'obs_wri_vel :'
-         WRITE(numout,*)'~~~~~~~~~~~~~'
-         WRITE(numout,*)'Writing velocuty feedback file : ',TRIM(cfname)
-      ENDIF
-
-      ALLOCATE( &
-         & zu(profdata%nvprot(1)), &
-         & zv(profdata%nvprot(2))  &
-         & )
-      CALL obs_rotvel( profdata, k2dint, zu, zv )
-
-      ! Transform obs_prof data structure into obfbdata structure
-      fbdata%cdjuldref = '19500101000000'
-      DO jo = 1, profdata%nprof
-         fbdata%plam(jo)      = profdata%rlam(jo)
-         fbdata%pphi(jo)      = profdata%rphi(jo)
-         WRITE(fbdata%cdtyp(jo),'(I4)') profdata%ntyp(jo)
-         fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:)
-         fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:)
-         IF ( profdata%nqc(jo) > 10 ) THEN
-            fbdata%ioqc(jo)    = 4
-            fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo)
-            fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10
-         ELSE
-            fbdata%ioqc(jo)    = profdata%nqc(jo)
-            fbdata%ioqcf(:,jo) = profdata%nqcf(:,jo)
-         ENDIF
-         fbdata%ipqc(jo)      = profdata%ipqc(jo)
-         fbdata%ipqcf(:,jo)   = profdata%ipqcf(:,jo)
-         fbdata%itqc(jo)      = profdata%itqc(jo)
-         fbdata%itqcf(:,jo)   = profdata%itqcf(:,jo)
-         fbdata%cdwmo(jo)     = profdata%cwmo(jo)
-         fbdata%kindex(jo)    = profdata%npfil(jo)
-         DO jvar = 1, profdata%nvar
-            IF (ln_grid_global) THEN
-               fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar)
-               fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar)
-            ELSE
-               fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar))
-               fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar))
-            ENDIF
-         END DO
-         CALL greg2jul( 0, &
-            &           profdata%nmin(jo), &
-            &           profdata%nhou(jo), &
-            &           profdata%nday(jo), &
-            &           profdata%nmon(jo), &
-            &           profdata%nyea(jo), &
-            &           fbdata%ptim(jo),   &
-            &           krefdate = 19500101 )
-         ! Reform the profiles arrays for output
-         DO jvar = 1, 2
-            DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar)
-               ik = profdata%var(jvar)%nvlidx(jk)
-               IF ( jvar == 1 ) THEN
-                  fbdata%padd(ik,jo,1,jvar) = zu(jk)
-               ELSE
-                  fbdata%padd(ik,jo,1,jvar) = zv(jk)
-               ENDIF
-               fbdata%padd(ik,jo,2,jvar) = profdata%var(jvar)%vmod(jk)
-               fbdata%pob(ik,jo,jvar)    = profdata%var(jvar)%vobs(jk)
-               fbdata%pdep(ik,jo)        = profdata%var(jvar)%vdep(jk)
-               fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk)
-               fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk)
-               IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN
-                  fbdata%ivlqc(ik,jo,jvar) = 4
-                  fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk)
-                  fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10
-               ELSE
-                  fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk)
-                  fbdata%ivlqcf(:,ik,jo,jvar) = profdata%var(jvar)%nvqcf(:,jk)
-               ENDIF
-               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk)
-               DO ja = 1, nadd
-                  fbdata%padd(ik,jo,2+ja,jvar) = &
-                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja))
-               END DO
-               DO je = 1, next
-                  fbdata%pext(ik,jo,je) = &
-                     & profdata%var(jvar)%vext(jk,pext%ipoint(je))
-               END DO
-            END DO
-         END DO
-      END DO
-
-      ! Write the obfbdata structure
-      CALL write_obfbdata( cfname, fbdata )
-      
-      ! Output some basic statistics
-      CALL obs_wri_stats( fbdata )
-
-      CALL dealloc_obfbdata( fbdata )
-     
-      DEALLOCATE( &
-         & zu, &
-         & zv  &
-         & )
-
-   END SUBROUTINE obs_wri_vel
+   END SUBROUTINE obs_wri_surf
 
    SUBROUTINE obs_wri_stats( fbdata )
@@ -951,18 +527,15 @@
       INTEGER :: jo
       INTEGER :: jk
-
-!      INTEGER :: nlev
-!      INTEGER :: nlevmpp
-!      INTEGER :: nobsmpp
-      INTEGER :: numgoodobs
-      INTEGER :: numgoodobsmpp
+      INTEGER :: inumgoodobs
+      INTEGER :: inumgoodobsmpp
       REAL(wp) :: zsumx
       REAL(wp) :: zsumx2
       REAL(wp) :: zomb
+      
 
       IF (lwp) THEN
          WRITE(numout,*) ''
          WRITE(numout,*) 'obs_wri_stats :'
-         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
       ENDIF
 
@@ -970,5 +543,5 @@
          zsumx=0.0_wp
          zsumx2=0.0_wp
-         numgoodobs=0
+         inumgoodobs=0
          DO jo = 1, fbdata%nobs
             DO jk = 1, fbdata%nlev
@@ -976,24 +549,24 @@
                   & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. &
                   & ( fbdata%padd(jk,jo,1,jvar) < 9999.0 ) ) THEN
-	    
-	          zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar)
+
+                  zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar)
                   zsumx=zsumx+zomb
                   zsumx2=zsumx2+zomb**2
-                  numgoodobs=numgoodobs+1
-	       ENDIF
+                  inumgoodobs=inumgoodobs+1
+               ENDIF
             ENDDO
          ENDDO
 
-         CALL obs_mpp_sum_integer( numgoodobs, numgoodobsmpp )
+         CALL obs_mpp_sum_integer( inumgoodobs, inumgoodobsmpp )
          CALL mpp_sum(zsumx)
          CALL mpp_sum(zsumx2)
 
          IF (lwp) THEN
-	    WRITE(numout,*) 'Type: ',fbdata%cname(jvar),'  Total number of good observations: ',numgoodobsmpp 
-	    WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/numgoodobsmpp
-            WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/numgoodobsmpp )
-	    WRITE(numout,*) ''
+            WRITE(numout,*) 'Type: ',fbdata%cname(jvar),'  Total number of good observations: ',inumgoodobsmpp 
+            WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/inumgoodobsmpp
+            WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/inumgoodobsmpp )
+            WRITE(numout,*) ''
          ENDIF
- 
+
       ENDDO
 
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obsprof_io.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obsprof_io.h90	(revision 6807)
+++ 	(revision )
@@ -1,834 +1,0 @@
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE read_enactfile( cdfilename, inpfile, kunit, ldwp, ldgrid )
-      !!---------------------------------------------------------------------
-      !!
-      !!                     ** ROUTINE read_enactfile **
-      !!
-      !! ** Purpose : Read from file the profile ENACT observations.
-      !!
-      !! ** Method  : The data file is a NetCDF file. 
-      !!
-      !! ** Action  :
-      !!
-      !! History : 
-      !!          ! 09-01 (K. Mogensen) Original based on old versions
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(LEN=*) :: cdfilename ! Input filename
-      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
-      INTEGER          :: kunit      ! Unit for output
-      LOGICAL          :: ldwp       ! Print info
-      LOGICAL          :: ldgrid     ! Save grid info in data structure
-      !! * Local declarations
-      INTEGER :: iobs                ! Number of observations
-      INTEGER :: ilev                      ! Number of levels
-      INTEGER :: i_file_id
-      INTEGER :: i_obs_id
-      INTEGER :: i_lev_id
-      INTEGER :: i_phi_id
-      INTEGER :: i_lam_id
-      INTEGER :: i_depth_id
-      INTEGER :: i_var_id
-      INTEGER :: i_pl_num_id
-      INTEGER :: i_reference_date_time_id
-      INTEGER :: i_format_version_id
-      INTEGER :: i_juld_id
-      INTEGER :: i_data_type_id
-      INTEGER :: i_wmo_inst_type_id
-      INTEGER :: i_qc_var_id
-      INTEGER :: i_dc_ref_id
-      INTEGER :: i_qc_flag_id
-      CHARACTER(LEN=40) :: cl_fld_lam
-      CHARACTER(LEN=40) :: cl_fld_phi
-      CHARACTER(LEN=40) :: cl_fld_depth 
-      CHARACTER(LEN=40) :: cl_fld_var_tp
-      CHARACTER(LEN=40) :: cl_fld_var_s
-      CHARACTER(LEN=40) :: cl_fld_var_ti
-      CHARACTER(LEN=40) :: cl_fld_var_juld_qc
-      CHARACTER(LEN=40) :: cl_fld_var_pos_qc
-      CHARACTER(LEN=40) :: cl_fld_var_depth_qc 
-      CHARACTER(LEN=40) :: cl_fld_var_qc_t
-      CHARACTER(LEN=40) :: cl_fld_var_qc_s
-      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_t
-      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_s
-      CHARACTER(LEN=40) :: cl_fld_reference_date_time
-      CHARACTER(LEN=40) :: cl_fld_juld
-      CHARACTER(LEN=40) :: cl_fld_data_type
-      CHARACTER(LEN=40) :: cl_fld_pl_num
-      CHARACTER(LEN=40) :: cl_fld_format_version
-      CHARACTER(LEN=40) :: cl_fld_wmo_inst_type
-      CHARACTER(LEN=40) :: cl_fld_qc_flags_profiles
-      CHARACTER(LEN=40) :: cl_fld_qc_flags_levels
-
-      CHARACTER(LEN=14), PARAMETER :: cl_name = 'read_enactfile'
-      CHARACTER(LEN=16)            :: cl_data_type = ''
-      CHARACTER(LEN=4 )            :: cl_format_version = ''
-      INTEGER, DIMENSION(1) :: istart1, icount1
-      INTEGER, DIMENSION(2) :: istart2, icount2
-      CHARACTER(len=imaxlev) :: clqc
-      CHARACTER(len=1) :: cqc
-      INTEGER :: ji, jk
-      INTEGER, ALLOCATABLE, DIMENSION(:) :: iqc1
-      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iqc2
-
-      !-----------------------------------------------------------------------
-      ! Initialization
-      !-----------------------------------------------------------------------
-
-      cl_fld_lam                 = 'LONGITUDE'
-      cl_fld_phi                 = 'LATITUDE'
-      cl_fld_depth               = 'DEPH_CORRECTED'
-      cl_fld_reference_date_time = 'REFERENCE_DATE_TIME'
-      cl_fld_juld                = 'JULD'
-      cl_fld_data_type           = 'DATA_TYPE'
-      cl_fld_format_version      = 'FORMAT_VERSION'
-      cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
-      cl_fld_pl_num              = 'PLATFORM_NUMBER'
-
-      cl_fld_var_qc_t            = 'POTM_CORRECTED_QC'
-      cl_fld_var_prof_qc_t       = 'PROFILE_POTM_QC'
-      cl_fld_var_tp              = 'POTM_CORRECTED'
-      cl_fld_var_qc_s            = 'PSAL_CORRECTED_QC'
-      cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
-      cl_fld_var_s               = 'PSAL_CORRECTED'
-      cl_fld_var_depth_qc        = 'DEPH_CORRECTED_QC'
-      cl_fld_var_juld_qc         = 'JULD_QC'
-      cl_fld_var_pos_qc          = 'POSITION_QC'
-      cl_fld_var_ti              = 'TEMP'
-      cl_fld_qc_flags_profiles   = 'QC_FLAGS_PROFILES'
-      cl_fld_qc_flags_levels     = 'QC_FLAGS_LEVELS'
-
-      icount1(1) = 1 
-
-      !-----------------------------------------------------------------------
-      ! Open file
-      !-----------------------------------------------------------------------
-
-      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
-            &      i_file_id ),           cl_name, __LINE__ )
-
-      !-----------------------------------------------------------------------
-      ! Read the heading of the file
-      !-----------------------------------------------------------------------
-
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_data_type,      &
-         &         i_data_type_id ),      cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_data_type_id,        &
-         &         cl_data_type ),        cl_name, __LINE__ )
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_format_version, &
-         &         i_format_version_id ), cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_format_version_id,   &
-         &         cl_format_version ),   cl_name, __LINE__ )
-      
-      CALL str_c_to_for( cl_data_type )
-      CALL str_c_to_for( cl_format_version )
-      
-      IF(ldwp)WRITE(kunit,*)
-      IF(ldwp)WRITE(kunit,*) ' read_enactfile :' 
-      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
-      IF(ldwp)WRITE(kunit,*) '               Data type           = ', &
-         &                TRIM( ADJUSTL( cl_data_type ) )
-      IF(ldwp)WRITE(kunit,*) '               Format version      = ',  &
-         &                TRIM( ADJUSTL( cl_format_version ) )
-      
-      IF ( ( ( INDEX( cl_data_type,"ENACT v1.0" ) == 1 ) .OR.   &
-         &   ( INDEX( cl_data_type,"ENACT v1.4" ) == 1 ) .OR.   &
-         &   ( INDEX( cl_data_type,"ENACT v1.5" ) == 1 ) .OR.   &
-         &   ( INDEX( cl_data_type,"ENSEMBLES EN3 v1" ) == 1 )      ) &
-         &   .AND.                                              &
-         &   ( INDEX( cl_format_version,"2.0"   ) == 1 ) ) THEN
-         IF(ldwp)WRITE(kunit,*)'               Valid input file'
-      ELSE
-         CALL fatal_error( 'Invalid input file', __LINE__ )
-      ENDIF
-
-      !---------------------------------------------------------------------
-      ! Read the number of observations and levels to allocate arrays
-      !---------------------------------------------------------------------
-
-      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_PROF', i_obs_id ),         &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ),     &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_LEVELS', i_lev_id ),     &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
-         &         cl_name, __LINE__ )
-      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
-      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
-      IF(ldwp)WRITE(kunit,*) 
-      IF (ilev > imaxlev) THEN
-         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
-      ENDIF
-
-      !---------------------------------------------------------------------
-      ! Allocate arrays
-      !---------------------------------------------------------------------
-
-      CALL init_obfbdata( inpfile )
-      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
-      inpfile%cname(1) = 'POTM'
-      inpfile%cname(2) = 'PSAL'
-      inpfile%coblong(1) = 'Potential temperature'
-      inpfile%coblong(2) = 'Practical salinity'
-      inpfile%cobunit(1) = 'Degrees Celsius'
-      inpfile%cobunit(2) = 'PSU'
-      inpfile%cextname(1) = 'TEMP'
-      inpfile%cextlong(1) = 'Insitu temperature'
-      inpfile%cextunit(1) = 'Degrees Celsius'
-
-      !---------------------------------------------------------------------
-      ! Read the QC atributes
-      !---------------------------------------------------------------------
-
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                         &
-         &         cl_name, __LINE__ )        
-      istart2(1) = 1
-      icount2(2) = 1
-      icount2(1) = ilev
-      DO ji = 1, iobs 
-         istart2(2) = ji
-         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
-            &                         start = istart2, count = icount2),                              &
-            &         cl_name, __LINE__ )
-         DO jk = 1, ilev
-            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
-         END DO
-      END DO
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ),                         &
-         &         cl_name, __LINE__ )
-      DO ji = 1, iobs
-         istart2(2) = ji
-         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
-            &                         start = istart2, count = icount2),                              &
-            &         cl_name, __LINE__ )
-         DO jk = 1, ilev
-            inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
-         END DO
-      END DO
-      ! No depth QC in files
-      DO ji = 1, iobs
-         DO jk = 1, ilev
-            inpfile%idqc(jk,ji)  = 1
-            inpfile%idqcf(:,jk,ji) = 0
-         END DO
-      END DO
-
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
-         &         cl_name,  __LINE__ )
-      DO ji = 1,iobs
-         istart1(1) = ji
-         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
-            &                         start = istart1, count = icount1),                              &
-            &         cl_name, __LINE__ )
-         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
-      END DO
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                    & 
-         &         cl_name, __LINE__ ) 
-      DO ji = 1,iobs
-         istart1(1) = ji
-         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
-            &                         start = istart1, count = icount1),                              &
-            &         cl_name, __LINE__ )
-         inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
-      END DO
-!!      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_juld_qc, i_qc_var_id ),                       &
-!!         &         cl_name, __LINE__ ) 
-!!      !DO ji = 1,iobs
-!!         istart1(1) = ji
-!!         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
-!!            &                         start = istart1, count = icount1),                              &
-!!            &         cl_name, __LINE__ )
-!!         inpfile%itqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
-!!         inpfile%itqcf(:,ji) = 0
-!!      END DO
-      ! Since the flags are not set in the ENACT files we reset them to 0
-      inpfile%itqc(:)    = 1      
-      inpfile%itqcf(:,:) = 0
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
-         &         cl_name, __LINE__ ) 
-      DO ji = 1,iobs
-         istart1(1) = ji
-         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
-            &                         start = istart1, count = icount1),                              &
-            &         cl_name, __LINE__ )
-         inpfile%ipqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
-         inpfile%ipqcf(:,ji) = 0
-      END DO
-      DO ji = 1,iobs
-         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
-      END DO
-      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_profiles, i_qc_flag_id ) == nf90_noerr ) THEN
-         ALLOCATE( &
-            & iqc1(iobs) &
-            & )
-         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc1 ),                                &
-            &         cl_name, __LINE__ )
-         DO ji = 1,iobs
-            inpfile%ioqcf(1,ji)   = iqc1(ji)
-            inpfile%ivqcf(1,ji,:) = iqc1(ji)
-            inpfile%ioqcf(2,ji)   = 0
-            inpfile%ivqcf(2,ji,:) = 0
-         END DO
-         DEALLOCATE( &
-            & iqc1 &
-            & )
-      ELSE
-         IF(ldwp) WRITE(kunit,*)'No QC profile flags in file'
-         inpfile%ioqcf(:,:)   = 0
-         inpfile%ivqcf(:,:,:) = 0
-      ENDIF
-      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_levels, i_qc_flag_id ) == nf90_noerr ) THEN
-         ALLOCATE( &
-            & iqc2(ilev,iobs) &
-            & )
-         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc2 ),                                &
-            &         cl_name, __LINE__ )
-         DO ji = 1,iobs
-            DO jk = 1,ilev
-               inpfile%ivlqcf(1,jk,ji,:) = iqc2(jk,ji)
-               inpfile%ivlqcf(2,jk,ji,:) = 0
-            END DO
-         END DO
-         DEALLOCATE( &
-            & iqc2 &
-            & )
-      ELSE
-         IF(ldwp) WRITE(kunit,*)'No QC level flags in file'
-         inpfile%ivlqcf(:,:,:,:) = 0
-      ENDIF
-
-      !---------------------------------------------------------------------
-      ! Read the time/position variables 
-      !---------------------------------------------------------------------
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
-         &         cl_name, __LINE__ )
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ),                             &
-            &         cl_name, __LINE__ )         
-      CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                             &
-         &         cl_name, __LINE__ )
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
-         &         cl_name, __LINE__ )
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
-         &         cl_name, __LINE__ )
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_reference_date_time, i_reference_date_time_id ), &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_reference_date_time_id, inpfile%cdjuldref ),          &
-         &         cl_name, __LINE__ )
-      
-      !---------------------------------------------------------------------
-      ! Read the platform information
-      !---------------------------------------------------------------------
-
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
-         &         cl_name, __LINE__ )          
-      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
-         &         cl_name, __LINE__ )
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
-         &         cl_name, __LINE__ )         
-      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
-         &         cl_name, __LINE__ )         
-
-      !---------------------------------------------------------------------
-      ! Read the variables
-      !---------------------------------------------------------------------
-
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_tp, i_var_id ),                              &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,1) ),                         &
-         &         cl_name, __LINE__ )
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                               &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                         &
-         &         cl_name, __LINE__ )
- 
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_ti, i_var_id ),                              &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
-         &         cl_name, __LINE__ )
-
-      !---------------------------------------------------------------------
-      ! Close file
-      !---------------------------------------------------------------------
-
-      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
-
-      !---------------------------------------------------------------------
-      ! Set file indexes
-      !---------------------------------------------------------------------
-      DO ji = 1, inpfile%nobs
-         inpfile%kindex(ji) = ji
-      END DO
-
-   END SUBROUTINE read_enactfile
-
-   SUBROUTINE read_coriofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
-      !!---------------------------------------------------------------------
-      !!
-      !!                     ** ROUTINE read_coriofile **
-      !!
-      !! ** Purpose : Read from file the profile CORIO observations.
-      !!
-      !! ** Method  : The data file is a NetCDF file. 
-      !!
-      !! ** Action  :
-      !!
-      !! History : 
-      !!          ! 09-01 (K. Mogensen) Original based on old versions
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(LEN=*) :: cdfilename ! Input filename
-      TYPE(obfbdata)   :: inpfile    ! Output enactfile structure
-      INTEGER          :: kunit      ! Unit for output
-      LOGICAL          :: ldwp       ! Print info
-      LOGICAL          :: ldgrid     ! Save grid info in data structure
-      INTEGER  :: &
-         & iobs, &
-         & ilev
-      !! * Local declarations
-      INTEGER :: &
-         & i_file_id,                &
-         & i_obs_id,                 &
-         & i_lev_id,                 &
-         & i_phi_id,                 & 
-         & i_lam_id,                 &
-         & i_depth_id,               &
-         & i_pres_id,                &
-         & i_var_id,                 &
-         & i_pl_num_id,              &
-         & i_format_version_id,      &
-         & i_juld_id,                &
-         & i_data_type_id,           &
-         & i_wmo_inst_type_id,       &
-         & i_qc_var_id,              &
-         & i_dc_ref_id
-      CHARACTER(LEN=40) :: & 
-         & cl_fld_lam,                 &
-         & cl_fld_phi,                 &
-         & cl_fld_depth,               & 
-         & cl_fld_depth_qc,            & 
-         & cl_fld_pres,                & 
-         & cl_fld_pres_qc,             & 
-         & cl_fld_var_t,               &
-         & cl_fld_var_s,               &
-         & cl_fld_var_ti,              &
-         & cl_fld_var_pos_qc,          &
-         & cl_fld_var_qc_t,            &
-         & cl_fld_var_qc_s,            &
-         & cl_fld_var_prof_qc_t,       &
-         & cl_fld_var_prof_qc_s,       &
-         & cl_fld_dc_ref,              &
-         & cl_fld_juld,                &
-         & cl_fld_pl_num,              &
-         & cl_fld_wmo_inst_type
-      CHARACTER(LEN=14), PARAMETER :: &
-         & cl_name = 'read_coriofile'
-      CHARACTER(LEN=4 )            :: &
-         & cl_format_version = ''
-      INTEGER, DIMENSION(1) :: &
-         & istart1, icount1
-      INTEGER, DIMENSION(2) :: &
-         & istart2, icount2
-      CHARACTER(len=imaxlev) :: &
-         & clqc
-      CHARACTER(len=1) :: &
-         & cqc
-      CHARACTER(len=256) :: &
-         & cdjulref
-      INTEGER :: &
-         & ji, jk
-      INTEGER :: &
-         & iformat
-      LOGICAL :: & 
-         & lsal
-      REAL(fbdp), DIMENSION(:,:), ALLOCATABLE :: &
-         & zpres
-      INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
-         & ipresqc
-      CHARACTER(len=256) :: &
-         & cerr
-      !-----------------------------------------------------------------------
-      ! Initialization
-      !-----------------------------------------------------------------------
-
-      icount1(1) = 1 
-      lsal = .TRUE.
-
-      !-----------------------------------------------------------------------
-      ! Open file
-      !-----------------------------------------------------------------------
-
-      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
-            &      i_file_id ),           cl_name, __LINE__ )
-
-      !-----------------------------------------------------------------------
-      ! Check format and set variables accordingly
-      !-----------------------------------------------------------------------
-
-      IF ( ( nf90_inq_dimid( i_file_id, 'N_PROF', i_obs_id ) == nf90_noerr ) .AND. &
-         & ( nf90_inq_dimid( i_file_id, 'N_LEVELS', i_lev_id ) == nf90_noerr ) ) THEN
-         iformat = 1
-      ELSEIF ( ( nf90_inq_dimid( i_file_id, 'mN_PROF', i_obs_id ) == nf90_noerr ) .AND. &
-         & ( nf90_inq_dimid( i_file_id, 'mN_ZLEV', i_lev_id ) == nf90_noerr ) ) THEN
-         iformat = 2
-      ELSE
-         WRITE(cerr,'(2A)')'Invalid data format in ',cl_name
-         CALL fatal_error( cerr, __LINE__ )
-      ENDIF
-      IF ( iformat == 1 ) THEN
-         cl_fld_lam                 = 'LONGITUDE'
-         cl_fld_phi                 = 'LATITUDE'  
-         cl_fld_depth               = 'DEPH'
-         cl_fld_depth_qc            = 'DEPH_QC'
-         cl_fld_pres                = 'PRES'
-         cl_fld_pres_qc             = 'PRES_QC'
-         cl_fld_juld                = 'JULD'
-         cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
-         cl_fld_dc_ref              = 'DC_REFERENCE'
-         cl_fld_pl_num              = 'PLATFORM_NUMBER'
-         cl_fld_var_qc_t            = 'TEMP_QC'
-         cl_fld_var_prof_qc_t       = 'PROFILE_TEMP_QC'
-         cl_fld_var_t               = 'TEMP'
-         cl_fld_var_qc_s            = 'PSAL_QC'
-         cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
-         cl_fld_var_s               = 'PSAL'
-         cl_fld_var_pos_qc          = 'POSITION_QC'
-      ELSEIF ( iformat==2 ) THEN
-         cl_fld_lam                 = 'LONGITUDE'
-         cl_fld_phi                 = 'LATITUDE'  
-         cl_fld_depth               = 'DEPH'
-         cl_fld_depth_qc            = 'QC_DEPH'
-         cl_fld_pres                = 'PRES'
-         cl_fld_pres_qc             = 'QC_PRES'
-         cl_fld_juld                = 'JULD'
-         cl_fld_wmo_inst_type       = 'INST_TYPE'
-         cl_fld_dc_ref              = 'REFERENCE'
-         cl_fld_pl_num              = 'PLATFORM_NUMBER'
-         cl_fld_var_qc_t            = 'QC_TEMP'
-         cl_fld_var_prof_qc_t       = 'Q_PROFILE_TEMP'
-         cl_fld_var_t               = 'TEMP'
-         cl_fld_var_qc_s            = 'QC_PSAL'
-         cl_fld_var_prof_qc_s       = 'Q_PROFILE_PSAL'
-         cl_fld_var_s               = 'PSAL'
-         cl_fld_var_pos_qc          = 'Q_POSITION'
-      ENDIF
-
-      !-----------------------------------------------------------------------
-      ! Read the heading of the file
-      !-----------------------------------------------------------------------
-
-      IF(ldwp)WRITE(kunit,*)
-      IF(ldwp)WRITE(kunit,*) ' read_coriofile :' 
-      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
-      IF(ldwp)WRITE(kunit,*) '               Format version      = ', iformat
-
-      !---------------------------------------------------------------------
-      ! Read the number of observations and levels to allocate arrays
-      !---------------------------------------------------------------------
-
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ), &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
-         &         cl_name, __LINE__ )
-      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
-      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
-      IF(ldwp)WRITE(kunit,*) 
-      IF (ilev > imaxlev) THEN
-         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
-      ENDIF
-
-      !---------------------------------------------------------------------
-      ! Allocate arrays
-      !---------------------------------------------------------------------
-
-      CALL init_obfbdata( inpfile )
-      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
-      inpfile%cname(1) = 'POTM'
-      inpfile%cname(2) = 'PSAL'
-      inpfile%coblong(1) = 'Potential temperature'
-      inpfile%coblong(2) = 'Practical salinity'
-      inpfile%cobunit(1) = 'Degrees Celsius'
-      inpfile%cobunit(2) = 'PSU'
-      inpfile%cextname(1) = 'TEMP'
-      inpfile%cextlong(1) = 'Insitu temperature'
-      inpfile%cextunit(1) = 'Degrees Celsius'
-      ALLOCATE( &
-         & zpres(ilev,iobs),  &
-         & ipresqc(ilev,iobs) &
-         & )
-      !---------------------------------------------------------------------
-      ! Get julian data reference (iformat==2)
-      !---------------------------------------------------------------------
-
-      IF (iformat==2) THEN
-         CALL chkerr ( nf90_get_att( i_file_id, nf90_global, &
-            &                        "Reference_date_time", cdjulref ), &
-            &         cl_name, __LINE__ )
-         inpfile%cdjuldref = cdjulref(7:10)//cdjulref(4:5)// &
-            & cdjulref(1:2)//cdjulref(12:13)//cdjulref(15:16)//cdjulref(18:19)
-      ENDIF
-
-      !---------------------------------------------------------------------
-      ! Read the QC attributes
-      !---------------------------------------------------------------------
-
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                                &
-         &         cl_name, __LINE__ )
-      istart2(1) = 1
-      icount2(2) = 1
-      icount2(1) = ilev
-      DO ji = 1, iobs 
-         istart2(2) = ji
-         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
-            &                         start = istart2, count = icount2),                              &
-            &         cl_name, __LINE__ )
-         DO jk = 1, ilev
-            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
-         END DO
-      END DO
-      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ) == nf90_noerr ) THEN
-         DO ji = 1, iobs
-            istart2(2) = ji
-            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
-               &                         start = istart2, count = icount2),                           &
-               &         cl_name, __LINE__ )
-            DO jk = 1, ilev
-               inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
-            END DO
-         END DO
-      ELSE
-         inpfile%ivlqc(:,:,2) = 4
-         inpfile%pob(:,:,2) = fbrmdi
-         lsal = .FALSE.
-      ENDIF
-
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
-         &         cl_name,  __LINE__ )
-      DO ji = 1,iobs
-         istart1(1) = ji
-         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
-            &                         start = istart1, count = icount1),                              &
-            &         cl_name, __LINE__ )
-         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
-      END DO
-      IF (lsal) THEN
-         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                 & 
-            &         cl_name, __LINE__ ) 
-         DO ji = 1,iobs
-            istart1(1) = ji
-            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                 &
-               &                         start = istart1, count = icount1),                           &
-               &         cl_name, __LINE__ )
-            inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
-         END DO
-      ELSE
-         inpfile%ivqc(:,2) = 4
-      ENDIF
-      DO ji = 1,iobs
-         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
-      END DO
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
-         &         cl_name, __LINE__ ) 
-      DO ji = 1, iobs
-         istart1(1) = ji
-         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
-            &                         start = istart1, count = icount1),                              &
-            &         cl_name, __LINE__ )
-         inpfile%ipqc(ji)  = IACHAR( cqc ) - IACHAR( '0' )
-      END DO
-      
-      !---------------------------------------------------------------------
-      ! Read the time/position variables 
-      !---------------------------------------------------------------------
-
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
-         &         cl_name, __LINE__ )
-      IF (iformat==1) THEN
-         CALL chkerr ( nf90_get_att( i_file_id, i_juld_id, &
-            &                        "units", cdjulref ), &
-            &         cl_name, __LINE__ )
-         inpfile%cdjuldref = cdjulref(12:15)//cdjulref(17:18)// &
-            & cdjulref(20:21)//cdjulref(23:24)//cdjulref(26:27)//&
-            & cdjulref(29:30)
-      ENDIF
-      
-      IF ( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ) == nf90_noerr ) THEN
-         CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                          &
-            &         cl_name, __LINE__ )
-         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth_qc, i_qc_var_id ),                      & 
-            &         cl_name, __LINE__ ) 
-         DO ji = 1, iobs
-            istart2(2) = ji
-            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
-               &                         start = istart2, count = icount2),                           &
-               &         cl_name, __LINE__ )
-            DO jk = 1, ilev
-               inpfile%idqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
-            END DO
-         END DO
-      ELSE
-         inpfile%pdep(:,:) = fbrmdi
-         inpfile%idqc(:,:) = 4
-      ENDIF
-
-      IF ( nf90_inq_varid( i_file_id, cl_fld_pres, i_pres_id ) == nf90_noerr ) THEN
-         CALL chkerr( nf90_get_var  ( i_file_id, i_pres_id, zpres ),                                  &
-            &         cl_name, __LINE__ )
-         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pres_qc, i_qc_var_id ),                       & 
-            &         cl_name, __LINE__ ) 
-         DO ji = 1, iobs
-            istart2(2) = ji
-            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
-               &                         start = istart2, count = icount2),                           &
-               &         cl_name, __LINE__ )
-            DO jk = 1, ilev
-               ipresqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
-            END DO
-         END DO
-      ELSE
-         zpres(:,:) = fbrmdi
-         ipresqc(:,:) = 4
-      ENDIF
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
-         &         cl_name, __LINE__ )
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
-         &         cl_name, __LINE__ )
-      
-      !---------------------------------------------------------------------
-      ! Read the platform information
-      !---------------------------------------------------------------------
-
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
-         &         cl_name, __LINE__ )          
-      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
-         &         cl_name, __LINE__ )
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
-         &         cl_name, __LINE__ )         
-      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
-         &         cl_name, __LINE__ )         
-
-      
-      !---------------------------------------------------------------------
-      ! Read the variables
-      !---------------------------------------------------------------------
-
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_t, i_var_id ),                               &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
-         &         cl_name, __LINE__ )
-
-      IF (lsal) THEN      
-         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                            &
-            &         cl_name, __LINE__ )
-         CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                      &
-            &         cl_name, __LINE__ )
-      ENDIF
-
-      !---------------------------------------------------------------------
-      ! Close file
-      !---------------------------------------------------------------------
-         
-      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
-
-      !---------------------------------------------------------------------
-      ! Set file indexes
-      !---------------------------------------------------------------------
-      DO ji = 1, inpfile%nobs
-         inpfile%kindex(ji) = ji
-      END DO
-      
-      !---------------------------------------------------------------------
-      !  Coriolis data conversion from insitu to potential temperature
-      !---------------------------------------------------------------------
-      !---------------------------------------------------------------------
-      !  Convert pressure to depth if depth not present
-      !---------------------------------------------------------------------
-      DO ji = 1, inpfile%nobs
-         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
-            DO jk = 1, inpfile%nlev
-               IF ( inpfile%pdep(jk,ji) >= 9999.0 ) THEN
-                  IF ( zpres(jk,ji) < 9999.0 ) THEN
-                     inpfile%pdep(jk,ji) = &
-                        & p_to_dep( REAL(zpres(jk,ji),wp), REAL(inpfile%pphi(ji),wp) )
-                     inpfile%idqc(jk,ji) = ipresqc(jk,ji)
-                  ENDIF
-               ENDIF
-            END DO
-         ENDIF
-      END DO
-      
-      !---------------------------------------------------------------------
-      !  Convert depth to pressure if pressure not present
-      !---------------------------------------------------------------------
-      DO ji = 1, inpfile%nobs
-         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
-            DO jk = 1, inpfile%nlev
-               IF ( zpres(jk,ji) >= 9999.0 ) THEN
-                  IF ( inpfile%pdep(jk,ji) < 9999.0 ) THEN
-                     zpres(jk,ji) = dep_to_p( REAL(inpfile%pdep(jk,ji),wp), &
-                        &                            REAL(inpfile%pphi(ji),wp) )
-                     ipresqc(jk,ji) = inpfile%idqc(jk,ji)
-                  ENDIF
-               ENDIF
-            END DO
-         ENDIF
-      END DO
-      
-      !---------------------------------------------------------------------
-      !  Convert insitu temperature to potential temperature if
-      !  salinity, insitu temperature and pressure are present
-      !---------------------------------------------------------------------
-      DO ji = 1, inpfile%nobs
-         DO jk = 1, inpfile%nlev
-            IF (( inpfile%pob(jk,ji,2) < 9999.0 ) .AND. &
-               &( inpfile%pext(jk,ji,1) < 9999.0 ) .AND. &
-               &( zpres(jk,ji) < 9999.0 ) ) THEN
-               inpfile%pob(jk,ji,1) = potemp( REAL(inpfile%pob(jk,ji,2), wp),  &
-                  &                           REAL(inpfile%pext(jk,ji,1), wp), &
-                  &                           REAL(zpres(jk,ji),wp),  &
-                  &                           0.0_wp )
-            ELSE
-               inpfile%pob(jk,ji,1) = fbrmdi
-            ENDIF
-         END DO
-      END DO
-
-      !---------------------------------------------------------------------
-      !  Initialize flags since they are not in the CORIOLIS input files
-      !---------------------------------------------------------------------
-
-      inpfile%ioqcf(:,:)      = 0
-      inpfile%ipqcf(:,:)      = 0
-      inpfile%itqcf(:,:)      = 0
-      inpfile%idqcf(:,:,:)    = 0
-      inpfile%ivqcf(:,:,:)    = 0
-      inpfile%ivlqcf(:,:,:,:) = 0
-
-   END SUBROUTINE read_coriofile
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obsseaice_io.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obsseaice_io.h90	(revision 6807)
+++ 	(revision )
@@ -1,270 +1,0 @@
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE read_seaice( cdfilename, inpfile, kunit, ldwp, ldgrid )
-      !!---------------------------------------------------------------------
-      !!
-      !!                     ** ROUTINE read_seaice **
-      !!
-      !! ** Purpose : Read from file the SEAICE observations.
-      !!
-      !! ** Method  : The data file is a NetCDF file. 
-      !!
-      !! ** Action  :
-      !!
-      !! References : 
-      !!
-      !! History : 
-      !!          ! 09-01 (K. Mogensen) Original based on old versions
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(LEN=*) :: cdfilename ! Input filename
-      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
-      INTEGER          :: kunit      ! Unit for output
-      LOGICAL          :: ldwp       ! Print info
-      LOGICAL          :: ldgrid     ! Save grid info in data structure
-      !! * Local declarations
-      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_seaice'
-      INTEGER :: i_file_id    ! netcdf IDS
-      INTEGER :: i_time_id
-      INTEGER :: i_ni_id
-      INTEGER :: i_data_id
-      INTEGER :: i_var_id
-      INTEGER :: i_data       ! Number of data per parameter in current file
-      INTEGER :: i_time       ! Number of reference times in file
-      INTEGER, DIMENSION(:), POINTER :: &
-         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
-      INTEGER, DIMENSION(:,:), POINTER :: &
-         & i_dtime, &       ! Offset in seconds since reference time
-         & i_qc,    &       ! Quality control flag.
-         & i_type           ! Type of seaice measurement.            
-      REAL(wp), DIMENSION(:), POINTER :: &
-         & z_phi,   &       ! Latitudes
-         & z_lam            ! Longitudes
-      REAL(wp), DIMENSION(:,:), POINTER :: &
-         & z_seaice         ! Seaice data     
-      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
-      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
-      INTEGER :: iilen          ! Length of netCDF attributes
-      INTEGER :: itype          ! Typeof netCDF attributes
-      REAL(KIND=wp) :: zsca      ! Scale factor
-      REAL(KIND=wp) :: zoff      ! Offset for data in netcdf file
-      REAL(KIND=wp) :: z_offset  ! Offset for time conversion
-      REAL(KIND=wp) :: zfill     ! Fill value in netcdf file
-      CHARACTER (len=33) ::creftime     ! Reference time of file
-      INTEGER :: i_refyear       ! Integer version of reference time
-      INTEGER :: i_refmonth
-      INTEGER :: i_refday
-      INTEGER :: i_refhour
-      INTEGER :: i_refmin
-      INTEGER :: i_refsec
-      INTEGER :: ichunk
-      INTEGER :: jtim
-      INTEGER :: jobs
-      INTEGER :: iobs
-
-      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
-         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
-      
-      ! Get the netCDF dimensions
-      
-      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
-         &       cpname, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
-         &                              len = i_time ),  &
-         &      cpname, __LINE__ )
-      
-      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
-         &       cpname, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
-         &                              len = i_data ),  &
-         &      cpname, __LINE__ )
-      
-      
-      ! Allocate NetCDF variables
-      
-      ALLOCATE( &
-         & i_reftime    ( i_time                 ), &
-         & i_dtime      ( i_data,i_time  ), &      
-         & i_qc         ( i_data,i_time  ), & 
-         & i_type       ( i_data,i_time  ), &     
-         & z_phi        ( i_data                 ), &   
-         & z_lam        ( i_data                 ), &  
-         & z_seaice        ( i_data,i_time  )  &
-         & )
-      
-      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
-         &       cpname, __LINE__ )
-      idims(1) = i_time
-      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
-         &       cpname, __LINE__ )
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
-         &                      == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                     "units",creftime), cpname,  __LINE__ )
-      ELSE
-         creftime = "seconds since 1981-01-01 00:00:00"
-      ENDIF
-      READ(creftime(15:18),*)i_refyear
-      READ(creftime(20:21),*)i_refmonth
-      READ(creftime(23:24),*)i_refday
-      READ(creftime(26:27),*)i_refhour
-      READ(creftime(29:30),*)i_refmin
-      READ(creftime(32:33),*)i_refsec
-      !Work out offset in days between reference time and 1/1/1950.
-      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
-         &           i_refmonth, i_refyear, z_offset)
-      
-      ! Get list of times for each ob in seconds relative to reference time
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'SeaIce_dtime', i_var_id ), & 
-         &       cpname, __LINE__ )
-      idims(1) = i_data
-      idims(2) = i_time
-      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
-         &       cpname, __LINE__ )
-      zsca = 1.0      
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
-         &                      == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                     "scale_factor",zsca), cpname,  __LINE__ )
-      ENDIF
-      zoff = 0.0
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
-         &                      == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                     "add_offset",zoff), cpname,  __LINE__ )
-      ENDIF
-      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
-         &                 + zoff)
-      
-      ! Get longitudes
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = i_data
-      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
-         &         cpname, __LINE__ )
-      
-      ! Get latitudes
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = i_data
-      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
-         &         cpname, __LINE__ )
-      
-      ! Get seaice data
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_ice_concentration', &
-         &                         i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = i_data
-      idims(2) = i_time
-      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_seaice), &
-         &       cpname, __LINE__ )
-      zoff = 0.
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
-         &                      == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                     "scale_factor",zsca), cpname, __LINE__ )
-      ENDIF
-      zsca = 1.0
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
-         &                       == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                       "scale_factor",zsca), cpname, __LINE__ )
-      ENDIF
-      zfill = 0.0
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
-         &                       == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                       "_FillValue",zfill), cpname, __LINE__ )
-      ENDIF
-      WHERE(z_seaice(:,:) /=  zfill)
-         z_seaice(:,:) = (zsca * z_seaice(:,:)) + zoff
-      ELSEWHERE
-         z_seaice(:,:) = fbrmdi
-      END WHERE
-      
-      ! Get QC flag
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
-         &       cpname, __LINE__ )
-      idims(1) = i_data
-      idims(2) = i_time
-      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
-            &       cpname, __LINE__ )
-      
-      ! Get seaice obs type
-      
-      i_type(:,:)=1
-      
-      ! Close the file
-      
-      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
-
-      ! Fill the obfbdata structure
-
-      ! Allocate obfbdata
-      
-      iobs = i_data * i_time
-      CALL init_obfbdata( inpfile )
-      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
-      inpfile%cname(1) = 'SEAICE'
-
-      ! Fill the obfbdata structure from input data
-
-      inpfile%cdjuldref = "19500101000000"
-      iobs = 0
-      DO jtim = 1, i_time
-         DO jobs = 1, i_data
-            iobs = iobs + 1
-            ! Characters
-            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'seaice','  '
-            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
-            ! Real values
-            inpfile%plam(iobs)         = z_lam(jobs)
-            inpfile%pphi(iobs)         = z_phi(jobs)
-            inpfile%pob(1,iobs,1)      = z_seaice(jobs,jtim)
-            inpfile%ptim(iobs)         = &
-               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
-               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
-            inpfile%pdep(1,iobs)       = 0.0
-            ! Integers
-            inpfile%kindex(iobs)       = iobs
-            IF ( z_seaice(jobs,jtim) == fbrmdi ) THEN
-               inpfile%ioqc(iobs)      = 4
-               inpfile%ivqc(iobs,1)    = 4 
-               inpfile%ivlqc(1,iobs,1) = 4
-            ELSE 
-               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
-               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
-               inpfile%ivlqc(1,iobs,1) = 1
-            ENDIF
-            inpfile%ipqc(iobs)         = 0 
-            inpfile%ipqcf(:,iobs)      = 0
-            inpfile%itqc(iobs)         = 0
-            inpfile%itqcf(:,iobs)      = 0
-            inpfile%ivqcf(:,iobs,1)    = 0
-            inpfile%ioqcf(:,iobs)      = 0
-            inpfile%idqc(1,iobs)       = 0
-            inpfile%idqcf(1,1,iobs)    = 0
-            inpfile%ivlqcf(:,1,iobs,1) = 0
-         END DO
-      END DO
-
-   END SUBROUTINE read_seaice
-
-
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_io.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_io.h90	(revision 6807)
+++ 	(revision )
@@ -1,378 +1,0 @@
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE read_avisofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
-      !!---------------------------------------------------------------------
-      !!
-      !!                     ** ROUTINE read_avisofile **
-      !!
-      !! ** Purpose : Read from file the AVISO SLA observations.
-      !!
-      !! ** Method  : The data file is a NetCDF file. 
-      !!
-      !! ** Action  :
-      !!
-      !! References : http://www.aviso.oceanobs.com
-      !!
-      !! History : 
-      !!          ! 09-01 (K. Mogensen) Original based on old versions
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(LEN=*) :: cdfilename ! Input filename
-      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
-      INTEGER          :: kunit      ! Unit for output
-      LOGICAL          :: ldwp       ! Print info
-      LOGICAL          :: ldgrid     ! Save grid info in data structure
-      !! * Local declarations
-      CHARACTER(LEN=14),PARAMETER :: cpname = 'read_avisofile'
-      INTEGER :: i_file_id     ! netcdf IDS
-      INTEGER :: i_tracks_id
-      INTEGER :: i_cycles_id
-      INTEGER :: i_data_id
-      INTEGER :: i_var_id
-      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
-      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
-      INTEGER :: iilen         ! Length of netCDF attributes
-      INTEGER :: itype         ! Typeof netCDF attributes
-      REAL(fbdp) :: zsca       ! Scale factor
-      REAL(fbdp) :: zfill      ! Fill value
-      CHARACTER(len=3) ::  cmission      ! Mission global attribute
-      INTEGER :: itracks       ! Maximum number of passes in file
-      INTEGER :: icycles       ! Maximum number of cycles for each pass
-      INTEGER :: idata         ! Number of data per parameter in current file
-      REAL(fbdp) :: zdeltat    ! Time gap getween two measurements in seconds
-      INTEGER, DIMENSION(:), POINTER :: & 
-         & iptracks,     &  ! List of passes contained in current file
-         & ipnbpoints,   &  ! Number of points per pass
-         & ipdataindexes    ! Index of data in theoretical profile
-      INTEGER, DIMENSION(:,:), POINTER :: & 
-         & ipcycles         ! List of cycles per pass
-      REAL(fbdp), DIMENSION(:), POINTER :: &
-         & zphi,   &        ! Latitudes
-         & zlam             ! Longitudes
-      REAL(fbdp), DIMENSION(:,:), POINTER :: &
-         & zbegindates      ! Date of point with index 0
-      REAL(fbdp) :: zbeginmiss    ! Missing data for dates
-      REAL(fbsp), DIMENSION(:,:), POINTER :: &
-         & zsla             ! SLA data
-      REAL(fbdp), DIMENSION(:), POINTER :: &
-         & zjuld            ! Julian date
-      LOGICAL, DIMENSION(:), POINTER :: &
-         & llskip           ! Skip observation
-      CHARACTER(len=14) :: cdjuldref    ! Julian data reference
-      INTEGER :: imission   ! Mission number converted from Mission global 
-                            ! netCDF atttribute.
-      CHARACTER(len=255) :: ctmp
-      INTEGER :: iobs
-      INTEGER :: jl
-      INTEGER :: jm
-      INTEGER :: jj
-      INTEGER :: ji
-      INTEGER :: jk
-      INTEGER :: jobs
-      INTEGER :: jcycle
-
-      ! Open the file
-
-      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, i_file_id ), &
-         &         cpname, __LINE__ )
-
-      ! Get the netCDF dimensions
-      
-      CALL chkerr( nf90_inq_dimid( i_file_id, 'Tracks', i_tracks_id ),  &
-         &         cpname, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_tracks_id, &
-         &                                 len = itracks ),  &
-         &         cpname, __LINE__ )
-      
-      CALL chkerr( nf90_inq_dimid( i_file_id, 'Cycles', i_cycles_id ),  &
-         &         cpname, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_cycles_id, &
-         &                                 len = icycles ),  &
-         &      cpname, __LINE__ )
-      
-      CALL chkerr( nf90_inq_dimid( i_file_id, 'Data', i_data_id ),  &
-         &         cpname, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_data_id, &
-         &                                 len = idata ),  &
-         &         cpname, __LINE__ )
-
-      ! Allocate memory for input data
-
-      ALLOCATE( &
-         & iptracks     ( itracks          ), &  
-         & ipnbpoints   ( itracks          ), &  
-         & ipcycles     ( icycles, itracks ), &
-         & zphi         ( idata            ), &   
-         & zlam         ( idata            ), &  
-         & zbegindates  ( icycles, itracks ), &
-         & ipdataindexes( idata            ), & 
-         & zsla         ( icycles, idata   ), &
-         & zjuld        ( idata*icycles    ), &
-         & llskip       ( idata*icycles    )  &
-         & )
-
-      ! Get time gap getween two measurements in seconds
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'DeltaT', i_var_id ), & 
-         &         cpname, __LINE__ )
-      CALL chkdim( i_file_id, i_var_id, 0, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zdeltat), &
-         &         cpname, __LINE__ )
-      zsca = 1.0
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
-         &                      == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                     'scale_factor',zsca), cpname,  __LINE__)
-      ENDIF
-      zdeltat = zsca * zdeltat
-         
-      ! Get List of passes contained in current file      
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'Tracks', i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = itracks
-      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, iptracks), &
-         &         cpname, __LINE__ )
-      
-      ! Get Number of points per pass
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'NbPoints', i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = itracks
-      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipnbpoints),&
-         &         cpname, __LINE__ )
-      
-      ! Get list of cycles per pass
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'Cycles', i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = icycles
-      idims(2) = itracks
-      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipcycles),   &
-         &         cpname, __LINE__ )
-
-      ! Get longitudes
-
-      CALL chkerr( nf90_inq_varid( i_file_id, 'Longitudes', i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = idata
-      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zlam),   &
-         &         cpname, __LINE__ )
-      zsca = 1.0
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
-         &                         == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                     'scale_factor',zsca), cpname,  __LINE__)
-      ENDIF
-      zlam(:) = zsca * zlam(:)
-      
-      ! Get latitudes
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'Latitudes', i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = idata
-      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zphi),   &
-         &         cpname, __LINE__ )
-      zsca = 1.0
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
-         &                       == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                     'scale_factor',zsca), cpname,  __LINE__)
-      ENDIF
-      zphi(:) = zsca * zphi(:)
-      
-      ! Get date of point with index 0
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'BeginDates', i_var_id ), & 
-         &        cpname, __LINE__ )
-      idims(1) = icycles
-      idims(2) = itracks
-      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zbegindates), &
-         &         cpname, __LINE__ )
-      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, &
-         &                                 'units', len = iilen,  &
-         &                                  xtype = itype), cpname, __LINE__ )
-      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 255 )) THEN
-         CALL fatal_error('Error decoding BeginDates unit', __LINE__ )
-      ENDIF
-      CALL chkerr( nf90_get_att( i_file_id, i_var_id, 'units', &
-         &                       ctmp ), cpname, __LINE__ )
-      jl=1
-      DO jm = 1, LEN(TRIM(ctmp))
-         IF ((ctmp(jm:jm)>='0').AND.(ctmp(jm:jm)<='9')) THEN
-            cdjuldref(jl:jl) = ctmp(jm:jm)
-            jl=jl+1
-         ENDIF
-         IF (jl>14) EXIT
-      END DO
-      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue', &
-         &                                  xtype = itype), cpname, __LINE__ )
-      IF ( itype /= NF90_DOUBLE ) THEN
-         CALL fatal_error('Error decoding BeginDates missing data', __LINE__ )
-      ENDIF
-      CALL chkerr( nf90_get_att( i_file_id, i_var_id, '_FillValue', &
-         &                       zbeginmiss ), cpname, __LINE__ )
-
-      ! Get indices of data in theoretical profile
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'DataIndexes', i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = idata
-      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipdataindexes),   &
-         &       cpname, __LINE__ )
-      
-      ! Get SLA data
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'SLA', i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = icycles
-      idims(2) = idata
-      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zsla),   &
-         &         cpname, __LINE__ )
-      zsca = 1.0
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
-         &                        == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                       'scale_factor',zsca), cpname, __LINE__ )
-      ENDIF
-      zfill = 0.0
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue') &
-         &                      == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                     '_FillValue',zfill), cpname,  __LINE__ )
-      ENDIF
-      WHERE(zsla(:,:) /=  zfill)
-         zsla(:,:) = zsca * zsla(:,:)
-      ELSEWHERE
-         zsla(:,:) = fbrmdi
-      END WHERE
-      
-      ! Get the global Mission netCDF attribute
-      
-      cmission='   '
-      CALL chkerr( nf90_inquire_attribute( i_file_id, nf90_global, &
-         &                                 'Mission', len = iilen,  &
-         &                                 xtype = itype), cpname, __LINE__ )
-      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 3 )) THEN
-         CALL fatal_error('Error decoding Mission global attribute', __LINE__ )
-      ENDIF
-      CALL chkerr( nf90_get_att( i_file_id, nf90_global, 'Mission', &
-         &                       cmission ), cpname, __LINE__ )
-      
-      ! Convert it to an integer
-      imission = 0
-      DO jm = 1, imaxmissions
-         IF (cmission==cmissions(jm)) THEN
-            imission = jm
-            EXIT
-         ENDIF
-      END DO
-      
-      ! Close the file
-      
-      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
-
-      ! Compute Julian dates for all observations
-      
-      jm = 0
-      jl = 0
-      DO jj = 1, itracks
-         DO ji = 1, ipnbpoints(jj)
-            jl = jl + 1
-            DO jk = 1, icycles
-               jm = jm + 1
-               IF (zbegindates(jk,jj)==zbeginmiss) THEN
-                  llskip(jm) = .TRUE.
-                  zjuld(jm)  = fbrmdi
-               ELSE
-                  llskip(jm) = .FALSE.
-                  zjuld(jm)  = zbegindates(jk,jj) + &
-                     &         (ipdataindexes(jl) * zdeltat / 86400._wp )
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      ! Get rid of missing data
-
-      jm = 0
-      DO jobs = 1, idata
-         DO jcycle = 1, icycles
-            jm = jm + 1
-            IF (zsla(jcycle,jobs) == fbrmdi) llskip(jm) = .TRUE.
-         END DO
-      END DO
-      
-      ! Allocate obfbdata
-
-      iobs = COUNT( .NOT.llskip(:) )
-      CALL init_obfbdata( inpfile )
-      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
-      inpfile%cname(1) = 'SLA'
-
-      ! Fill the obfbdata structure from input data
-
-      inpfile%cdjuldref = cdjuldref
-      iobs = 0
-      jm = 0
-      DO jobs = 1, idata
-         DO jcycle = 1, icycles
-            jm = jm + 1
-            IF (llskip(jm)) CYCLE
-            iobs = iobs + 1
-            ! Characters
-            WRITE(inpfile%cdwmo(iobs),'(A3,A5)') cmissions(imission), '     '
-            WRITE(inpfile%cdtyp(iobs),'(I4)') imission
-            ! Real values
-            inpfile%plam(iobs)         = zlam(jobs)
-            inpfile%pphi(iobs)         = zphi(jobs)
-            inpfile%pob(1,iobs,1)      = zsla(jcycle,jobs)
-            inpfile%ptim(iobs)         = zjuld(jm)
-            inpfile%pdep(1,iobs)       = 0.0
-            ! Integers
-            inpfile%kindex(iobs)       = iobs
-            inpfile%ioqc(iobs)      = 1
-            inpfile%ivqc(iobs,1)    = 1
-            inpfile%ivlqc(1,iobs,1) = 1
-            inpfile%ipqc(iobs)         = 0 
-            inpfile%ipqcf(:,iobs)      = 0
-            inpfile%itqc(iobs)         = 0
-            inpfile%itqcf(:,iobs)      = 0
-            inpfile%ivqcf(:,iobs,1)    = 0
-            inpfile%ioqcf(:,iobs)      = 0
-            inpfile%idqc(1,iobs)       = 0
-            inpfile%idqcf(1,1,iobs)    = 0
-            inpfile%ivlqcf(:,1,iobs,1) = 0
-         END DO
-      END DO
-
-
-      ! Deallocate memory for input data
-
-      DEALLOCATE( &
-         & iptracks,      &
-         & ipnbpoints,    &
-         & ipcycles,      &
-         & zphi,          &
-         & zlam,          &  
-         & zbegindates,   &
-         & ipdataindexes, &
-         & zsla,          &
-         & zjuld,         &
-         & llskip         &
-         & )
-
-   END SUBROUTINE read_avisofile
-
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_types.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_types.h90	(revision 6807)
+++ 	(revision )
@@ -1,9 +1,0 @@
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   INTEGER, PARAMETER :: imaxmissions=8
-   CHARACTER(len=3) :: cmissions(0:imaxmissions) = &
-      & (/ 'XXX', 'E1 ', 'E2 ', 'TP ', 'TPM', 'G2 ', 'J1 ', 'EN ', 'J2 ' /)
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obssst_io.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obssst_io.h90	(revision 6807)
+++ 	(revision )
@@ -1,286 +1,0 @@
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE read_ghrsst( cdfilename, inpfile, kunit, ldwp, ldgrid )
-      !!---------------------------------------------------------------------
-      !!
-      !!                     ** ROUTINE read_ghrsst **
-      !!
-      !! ** Purpose : Read from file the GHRSST observations.
-      !!
-      !! ** Method  : The data file is a NetCDF file. 
-      !!
-      !! ** Action  :
-      !!
-      !! References : 
-      !!
-      !! History : 
-      !!          ! 09-01 (K. Mogensen) Original based on old versions
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(LEN=*) :: cdfilename ! Input filename
-      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
-      INTEGER          :: kunit      ! Unit for output
-      LOGICAL          :: ldwp       ! Print info
-      LOGICAL          :: ldgrid     ! Save grid info in data structure
-      !! * Local declarations
-      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_ghrsst'
-      INTEGER :: i_file_id        ! netcdf IDS
-      INTEGER :: i_time_id
-      INTEGER :: i_ni_id
-      INTEGER :: i_data_id
-      INTEGER :: i_var_id
-      INTEGER :: i_data           ! Number of data per parameter in current file
-      INTEGER :: i_time           ! Number of reference times in file
-      INTEGER, DIMENSION(:), POINTER :: &
-         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
-      INTEGER, DIMENSION(:,:), POINTER :: &
-         & i_dtime, &       ! Offset in seconds since reference time
-         & i_qc,    &       ! Quality control flag.
-         & i_type           ! Type of SST measurement.            
-      REAL(wp), DIMENSION(:), POINTER :: &
-         & z_phi,   &       ! Latitudes
-         & z_lam            ! Longitudes
-      REAL(wp), DIMENSION(:,:), POINTER :: &
-         & z_sst            ! SST data     
-      INTEGER, PARAMETER :: imaxdim = 2      ! Assumed maximum for no. dims. in file
-      INTEGER, DIMENSION(2) :: idims         ! Dimensions in file
-      INTEGER :: iilen            ! Length of netCDF attributes
-      INTEGER :: itype            ! Typeof netCDF attributes
-      REAL(KIND=wp) :: zsca           ! Scale factor
-      REAL(KIND=wp) :: zoff           ! Offset for data in netcdf file
-      REAL(KIND=wp) :: z_offset       ! Offset for time conversion
-      REAL(KIND=wp) :: zfill          ! Fill value in netcdf file
-      CHARACTER (len=33) :: creftime  ! Reference time of file
-      INTEGER :: i_refyear            ! Integer version of reference time
-      INTEGER :: i_refmonth
-      INTEGER :: i_refday
-      INTEGER :: i_refhour
-      INTEGER :: i_refmin
-      INTEGER :: i_refsec
-      INTEGER :: ichunk
-      INTEGER :: jtim
-      INTEGER :: jobs
-      INTEGER :: iobs
-
-      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
-         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
-      
-      ! Get the netCDF dimensions
-      
-      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
-         &       cpname, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
-         &                              len = i_time ),  &
-         &      cpname, __LINE__ )
-      
-      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
-         &       cpname, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
-         &                              len = i_data ),  &
-         &      cpname, __LINE__ )
-      
-      
-      ! Allocate NetCDF variables
-      
-      ALLOCATE( &
-         & i_reftime    ( i_time                 ), &
-         & i_dtime      ( i_data,i_time  ), &      
-         & i_qc         ( i_data,i_time  ), & 
-         & i_type       ( i_data,i_time  ), &     
-         & z_phi        ( i_data                 ), &   
-         & z_lam        ( i_data                 ), &  
-         & z_sst        ( i_data,i_time  )  &
-         & )
-      
-      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
-         &       cpname, __LINE__ )
-      idims(1) = i_time
-      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
-         &       cpname, __LINE__ )
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
-         &                      == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                     "units",creftime), cpname,  __LINE__ )
-      ELSE
-         creftime = "seconds since 1981-01-01 00:00:00"
-      ENDIF
-      READ(creftime(15:18),*)i_refyear
-      READ(creftime(20:21),*)i_refmonth
-      READ(creftime(23:24),*)i_refday
-      READ(creftime(26:27),*)i_refhour
-      READ(creftime(29:30),*)i_refmin
-      READ(creftime(32:33),*)i_refsec
-      !Work out offset in days between reference time and 1/1/1950.
-      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
-         &           i_refmonth, i_refyear, z_offset)
-      
-      ! Get list of times for each ob in seconds relative to reference time
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'sst_dtime', i_var_id ), & 
-         &       cpname, __LINE__ )
-      idims(1) = i_data
-      idims(2) = i_time
-      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
-         &       cpname, __LINE__ )
-      zsca = 1.0      
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
-         &                      == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                     "scale_factor",zsca), cpname,  __LINE__ )
-      ENDIF
-      zoff = 0.0
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
-         &                      == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                     "add_offset",zoff), cpname,  __LINE__ )
-      ENDIF
-      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
-         &                 + zoff)
-      
-      ! Get longitudes
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = i_data
-      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
-         &         cpname, __LINE__ )
-      
-      ! Get latitudes
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = i_data
-      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
-         &         cpname, __LINE__ )
-      
-      ! Get SST data
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_surface_temperature', &
-         &                         i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = i_data
-      idims(2) = i_time
-      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_sst), &
-         &       cpname, __LINE__ )
-      zoff = 0.
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
-         &                      == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                     "scale_factor",zsca), cpname, __LINE__ )
-      ENDIF
-      zsca = 1.0
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
-         &                       == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                       "scale_factor",zsca), cpname, __LINE__ )
-      ENDIF
-      zfill = 0.0
-      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
-         &                       == nf90_noerr) THEN
-         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
-            &                       "_FillValue",zfill), cpname, __LINE__ )
-      ENDIF
-      WHERE(z_sst(:,:) /=  zfill)
-         z_sst(:,:) = (zsca * z_sst(:,:)) + zoff
-      ELSEWHERE
-         z_sst(:,:) = fbrmdi
-      END WHERE
-      
-      ! Get QC flag
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
-         &       cpname, __LINE__ )
-      idims(1) = i_data
-      idims(2) = i_time
-      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
-            &       cpname, __LINE__ )
-      
-      ! Get SST obs type
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, 'data_source', i_var_id ), & 
-         &         cpname, __LINE__ )
-      idims(1) = i_data
-      idims(2) = i_time
-      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_type),   &
-         &       cpname, __LINE__ )
-      
-      ! Close the file
-      
-      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
-
-      ! Fill the obfbdata structure
-
-      ! Allocate obfbdata
-      
-      iobs = i_data * i_time
-      CALL init_obfbdata( inpfile )
-      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
-      inpfile%cname(1) = 'SST'
-
-      ! Fill the obfbdata structure from input data
-
-      inpfile%cdjuldref = "19500101000000"
-      iobs = 0
-      DO jtim = 1, i_time
-         DO jobs = 1, i_data
-            iobs = iobs + 1
-            ! Characters
-            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'ghrsst','  '
-            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
-            ! Real values
-            inpfile%plam(iobs)         = z_lam(jobs)
-            inpfile%pphi(iobs)         = z_phi(jobs)
-            inpfile%pob(1,iobs,1)      = z_sst(jobs,jtim)
-            inpfile%ptim(iobs)         = &
-               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
-               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
-            inpfile%pdep(1,iobs)       = 0.0
-            ! Integers
-            inpfile%kindex(iobs)       = iobs
-            IF ( z_sst(jobs,jtim) == fbrmdi ) THEN
-               inpfile%ioqc(iobs)      = 4
-               inpfile%ivqc(iobs,1)    = 4 
-               inpfile%ivlqc(1,iobs,1) = 4
-            ELSE 
-               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
-               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
-               inpfile%ivlqc(1,iobs,1) = 1
-            ENDIF
-            inpfile%ipqc(iobs)         = 0 
-            inpfile%ipqcf(:,iobs)      = 0
-            inpfile%itqc(iobs)         = 0
-            inpfile%itqcf(:,iobs)      = 0
-            inpfile%ivqcf(:,iobs,1)    = 0
-            inpfile%ioqcf(:,iobs)      = 0
-            inpfile%idqc(1,iobs)       = 0
-            inpfile%idqcf(1,1,iobs)    = 0
-            inpfile%ivlqcf(:,1,iobs,1) = 0
-         END DO
-      END DO
-
-      DEALLOCATE( &
-         & i_reftime, &
-         & i_dtime,   &
-         & i_qc,      &
-         & i_type,    &
-         & z_phi,     &
-         & z_lam,     &
-         & z_sst      &
-         & )
-
-   END SUBROUTINE read_ghrsst
-
-
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obsvel_io.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/OBS/obsvel_io.h90	(revision 6807)
+++ 	(revision )
@@ -1,360 +1,0 @@
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE read_taondbc( cdfilename, inpfile, kunit, ldwp, ldgrid )
-      !!---------------------------------------------------------------------
-      !!
-      !!                     ** ROUTINE read_enactfile **
-      !!
-      !! ** Purpose : Read from file the TAO data fro NDBC.
-      !!
-      !! ** Method  : The data file is a NetCDF file. 
-      !!
-      !! ** Action  :
-      !!
-      !! ** Reference : http://tao.noaa.gov/tao/data_deliv/deliv_ndbc.shtml
-      !! History : 
-      !!          ! 09-01 (K. Mogensen) Original version.
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(LEN=*) :: cdfilename ! Input filename
-      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
-      INTEGER          :: kunit      ! Unit for output
-      LOGICAL          :: ldwp       ! Print info
-      LOGICAL          :: ldgrid     ! Save grid info in data structure
-      !! * Local declarations
-      INTEGER :: iobs                ! Number of observations
-      INTEGER :: ilev                ! Number of levels
-      INTEGER :: ilat                ! Number of latitudes
-      INTEGER :: ilon                ! Number of longtudes
-      INTEGER :: itim                ! Number of obs. times
-      INTEGER :: i_file_id
-      INTEGER :: i_dimid_id
-      INTEGER :: i_phi_id
-      INTEGER :: i_lam_id
-      INTEGER :: i_depth_id
-      INTEGER :: i_var_id
-      INTEGER :: i_time_id
-      INTEGER :: i_time2_id
-      INTEGER :: i_qc_var_id
-      CHARACTER(LEN=40) :: cl_fld_lam
-      CHARACTER(LEN=40) :: cl_fld_phi
-      CHARACTER(LEN=40) :: cl_fld_depth
-      CHARACTER(LEN=40) :: cl_fld_var_u
-      CHARACTER(LEN=40) :: cl_fld_var_v
-      CHARACTER(LEN=40) :: cl_fld_var_qc_uv1
-      CHARACTER(LEN=40) :: cl_fld_var_qc_uv2
-      CHARACTER(LEN=40) :: cl_fld_time
-      CHARACTER(LEN=40) :: cl_fld_time2
-      INTEGER :: ja
-      INTEGER :: jo
-      INTEGER :: jk
-      INTEGER :: jt
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: &
-         & zv,     &
-         & zu,     &
-         & zuv1qc, &
-         & zuv2qc
-      REAL(wp), ALLOCATABLE, DIMENSION(:) :: &
-         & zdep, &
-         & zlat, &
-         & zlon, &
-         & zjuld
-      REAL(wp) :: zl
-      INTEGER, ALLOCATABLE, DIMENSION(:) :: &
-         & itime, &
-         & itime2
-      CHARACTER(LEN=50) :: cdjulref
-      CHARACTER(LEN=12), PARAMETER :: cl_name = 'read_taondbc'
-      CHARACTER(len=1) :: cns, cew
-
-      !-----------------------------------------------------------------------
-      ! Initialization
-      !-----------------------------------------------------------------------
-      cl_fld_lam                 = 'lon'
-      cl_fld_phi                 = 'lat'
-      cl_fld_depth               = 'depth'
-      cl_fld_time                = 'time'
-      cl_fld_time2               = 'time2'
-
-      !-----------------------------------------------------------------------
-      ! Open file
-      !-----------------------------------------------------------------------
-
-      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
-            &      i_file_id ),           cl_name, __LINE__ )
-
-      !-----------------------------------------------------------------------
-      ! Read the heading of the file
-      !-----------------------------------------------------------------------
-      IF(ldwp) WRITE(kunit,*)
-      IF(ldwp) WRITE(kunit,*) ' read_taondbc :' 
-      IF(ldwp) WRITE(kunit,*) ' ~~~~~~~~~~~~'
-      
-      !---------------------------------------------------------------------
-      ! Read the number of observations and of levels to allocate array
-      !---------------------------------------------------------------------
-      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'time', i_dimid_id ),        &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = itim ),    &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'depth', i_dimid_id ),       &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilev ),    &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'lat', i_dimid_id ),           &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilat ),    &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'lon', i_dimid_id ),         &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilon ),    &
-         &         cl_name, __LINE__ ) 
-
-      iobs = itim * ilat * ilon
-      IF(ldwp)WRITE(kunit,*) '         No. of data records = ', iobs
-      IF(ldwp)WRITE(kunit,*) '         No. of levels       = ', ilev
-      IF(ldwp)WRITE(kunit,*) 
-
-      !---------------------------------------------------------------------
-      ! Allocate arrays
-      !---------------------------------------------------------------------
-
-      CALL init_obfbdata( inpfile )
-      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 0, ldgrid )
-      inpfile%cname(1) = 'UVEL'
-      inpfile%cname(2) = 'VVEL'
-      inpfile%coblong(1) = 'Zonal current'
-      inpfile%coblong(2) = 'Meridional current'
-      inpfile%cobunit(1) = 'Meters per second'
-      inpfile%cobunit(2) = 'Meters per second'
-
-      ALLOCATE( &
-         & zu(ilon,ilat,ilev,itim),     &
-         & zv(ilon,ilat,ilev,itim),     &
-         & zdep(ilev),                  &
-         & zuv1qc(ilon,ilat,ilev,itim), &
-         & zuv2qc(ilon,ilat,ilev,itim), &
-         & itime(itim),                 &
-         & itime2(itim),                &
-         & zlat(ilat),                  &
-         & zlon(ilon),                  &
-         & zjuld(itim)                  &
-         & )
-
-      !---------------------------------------------------------------------
-      ! Read the time/position variables 
-      !---------------------------------------------------------------------
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time, i_time_id ),                               &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_time_id, itime ),                                     &
-         &         cl_name, __LINE__ )
-
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time2, i_time2_id ),                             &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_time2_id, itime2 ),                                   &
-         &         cl_name, __LINE__ )
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ),                             &
-            &         cl_name, __LINE__ )         
-      CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, zdep ),                                     &
-         &         cl_name, __LINE__ )
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, zlat ),                                       &
-         &         cl_name, __LINE__ )
-      
-      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
-         &         cl_name, __LINE__ )
-      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, zlon ),                                       &
-         &         cl_name, __LINE__ )
-      
-      !---------------------------------------------------------------------
-      ! Read the variables
-      !---------------------------------------------------------------------
-
-      ! ADCP format assumed
-      cl_fld_var_u = 'u_1205'
-      IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
-         ! Try again with current meter format
-         cl_fld_var_u = 'U_320'
-         IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
-            CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
-         ENDIF
-      ENDIF
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zu ),                                         &
-         &         cl_name, __LINE__ )
-      
-      ! ADCP format assumed
-      cl_fld_var_v = 'v_1206'
-      IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
-         ! Try again with current meter format
-         cl_fld_var_v = 'V_321'
-         IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
-            CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
-         ENDIF
-      ENDIF
-      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zv ),                                         &
-         &         cl_name, __LINE__ )
-
-      !---------------------------------------------------------------------
-      ! Read the QC attributes
-      !---------------------------------------------------------------------
-      
-      ! ADCP format assumed
-      cl_fld_var_qc_uv1 = 'QU_5205'
-      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
-         ! Try again with current meter format
-         cl_fld_var_qc_uv1 = 'QCS_5300'
-         IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
-            ! Try again with high freq. current meter format
-            cl_fld_var_qc_uv1 = 'QCU_5320'
-            IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
-               CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
-            ENDIF
-         ENDIF
-      ENDIF
-      CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, zuv1qc),                                   &
-         &         cl_name, __LINE__ )
-
-      ! ADCP format assumed
-      cl_fld_var_qc_uv2 = 'QV_5206'
-      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
-         ! Try again with current meter format
-         cl_fld_var_qc_uv2 = 'QCD_5310'
-         IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
-            ! Try again with high freq. current meter format
-            cl_fld_var_qc_uv2 = 'QCV_5321'
-            IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
-               CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
-            ENDIF
-         ENDIF
-      ENDIF
-      CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, zuv2qc),                                   &
-         &         cl_name, __LINE__ )
-
-      !---------------------------------------------------------------------
-      ! Close file
-      !---------------------------------------------------------------------
-
-      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
-
-      !---------------------------------------------------------------------
-      ! Convert to to 19500101 based Julian date
-      !---------------------------------------------------------------------
-      DO jt = 1, itim
-         zjuld(jt) = REAL(itime(jt),wp) + REAL(itime2(jt),wp)/86400000.0_wp &
-            &           - 2433283.0_wp
-      END DO
-      inpfile%cdjuldref = '19500101000000'
-
-      !---------------------------------------------------------------------
-      ! Copy info to obfbdata structure
-      !---------------------------------------------------------------------
-
-      iobs = 0
-      DO jt = 1, itim
-         DO ja = 1, ilat
-            DO jo = 1, ilon
-               iobs = iobs + 1
-               zl = zlon(jo)
-               IF ( zl > 180.0_wp ) zl = zl - 360.0_wp
-               IF ( zl < 0 ) THEN
-                  cew = 'w'
-               ELSE
-                  cew = 'e'
-               ENDIF
-               IF ( zlat(jo) < 0 ) THEN
-                  cns = 's'
-               ELSE
-                  cns = 'n'
-               ENDIF
-               WRITE(inpfile%cdwmo(iobs),'(A1,I2.2,A1,I3.3)') &
-                  & cns, ABS(NINT(zlat(ja))), cew, ABS(NINT(zl))
-               DO jk = 1, ilev
-                  inpfile%pob(jk,iobs,1)     = zu(jo,ja,jk,jt)
-                  inpfile%pob(jk,iobs,2)     = zv(jo,ja,jk,jt)
-                  inpfile%pdep(jk,iobs)      = zdep(jk)
-                  inpfile%ivlqc(jk,iobs,1:2) = INT( MAX( zuv1qc(jo,ja,jk,jt), zuv2qc(jo,ja,jk,jt) ) )
-               END DO
-               inpfile%plam(iobs) = zlon(jo)
-               inpfile%pphi(iobs) = zlat(ja)
-               inpfile%ptim(iobs) = zjuld(jt)
-            END DO
-         END DO
-      END DO
-
-      ! No position, time, depth and variable QC in input files
-      DO jo = 1, iobs
-         inpfile%ipqc(jo) = 1
-         inpfile%itqc(jo) = 1
-         inpfile%ivqc(jo,1:2) = 1
-         DO jk = 1, ilev
-            inpfile%idqc(jk,jo) = 1
-         END DO
-      END DO
-
-      !---------------------------------------------------------------------
-      ! Set the platform information
-      !---------------------------------------------------------------------
-      inpfile%cdtyp(:)=' 820'
-
-      !---------------------------------------------------------------------
-      ! Set QC flags for missing data and rescale to m/s
-      !---------------------------------------------------------------------
-
-      DO jo = 1, iobs
-         DO jk = 1, ilev
-            IF ( ( ABS(inpfile%pob(jk,jo,1)) > 10000.0_wp ) .OR. &
-               & ( ABS(inpfile%pob(jk,jo,2)) > 10000.0_wp ) ) THEN
-               inpfile%ivlqc(jk,jo,:) = 4
-               inpfile%pob(jk,jo,1) = fbrmdi
-               inpfile%pob(jk,jo,2) = fbrmdi
-            ELSE
-               inpfile%pob(jk,jo,1) = 0.01 * inpfile%pob(jk,jo,1)
-               inpfile%pob(jk,jo,2) = 0.01 * inpfile%pob(jk,jo,2)
-            ENDIF
-         END DO
-      END DO
-
-      !---------------------------------------------------------------------
-      ! Set file indexes
-      !---------------------------------------------------------------------
-
-      DO jo = 1, inpfile%nobs
-         inpfile%kindex(jo) = jo
-      END DO
-
-      !---------------------------------------------------------------------
-      ! Initialize flags since they are not in the TAO input files
-      !---------------------------------------------------------------------
-
-      inpfile%ioqcf(:,:)      = 0
-      inpfile%ipqcf(:,:)      = 0
-      inpfile%itqcf(:,:)      = 0
-      inpfile%idqcf(:,:,:)    = 0
-      inpfile%ivqcf(:,:,:)    = 0
-      inpfile%ivlqcf(:,:,:,:) = 0
-
-      !---------------------------------------------------------------------
-      ! Deallocate data
-      !---------------------------------------------------------------------
-      DEALLOCATE( &
-         & zu,     &
-         & zv,     &
-         & zdep,   &
-         & zuv1qc, &
-         & zuv2qc, &
-         & itime,  &
-         & itime2, &
-         & zlat,   &
-         & zlon,   &
-         & zjuld   &
-         & )
-
-   END SUBROUTINE read_taondbc
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 6808)
@@ -4,14 +4,15 @@
    !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT
    !!=====================================================================
-   !! History :   
-   !!   9.0  !  04-06  (R. Redler, NEC Laboratories Europe, Germany) Original code
-   !!   " "  !  04-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision
-   !!   " "  !  04-11  (V. Gayler, MPI M&D) Grid writing
-   !!   " "  !  05-08  (R. Redler, W. Park) frld initialization, paral(2) revision
-   !!   " "  !  05-09  (R. Redler) extended to allow for communication over root only
-   !!   " "  !  06-01  (W. Park) modification of physical part
-   !!   " "  !  06-02  (R. Redler, W. Park) buffer array fix for root exchange
-   !!   3.4  !  11-11  (C. Harris) Changes to allow mutiple category fields
-   !!----------------------------------------------------------------------
+   !! History :  1.0  !  2004-06  (R. Redler, NEC Laboratories Europe, Germany) Original code
+   !!             -   !  2004-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision
+   !!             -   !  2004-11  (V. Gayler, MPI M&D) Grid writing
+   !!            2.0  !  2005-08  (R. Redler, W. Park) frld initialization, paral(2) revision
+   !!             -   !  2005-09  (R. Redler) extended to allow for communication over root only
+   !!             -   !  2006-01  (W. Park) modification of physical part
+   !!             -   !  2006-02  (R. Redler, W. Park) buffer array fix for root exchange
+   !!            3.4  !  2011-11  (C. Harris) Changes to allow mutiple category fields
+   !!            3.6  !  2014-11  (S. Masson) OASIS3-MCT
+   !!----------------------------------------------------------------------
+   
    !!----------------------------------------------------------------------
    !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3-MCT
@@ -20,6 +21,6 @@
    !!   cpl_init     : initialization of coupled mode communication
    !!   cpl_define   : definition of grid and fields
-   !!   cpl_snd     : snd out fields in coupled mode
-   !!   cpl_rcv     : receive fields in coupled mode
+   !!   cpl_snd      : snd out fields in coupled mode
+   !!   cpl_rcv      : receive fields in coupled mode
    !!   cpl_finalize : finalize the coupled mode communication
    !!----------------------------------------------------------------------
@@ -99,6 +100,6 @@
       !! ** Method  :   OASIS3 MPI communication 
       !!--------------------------------------------------------------------
-      CHARACTER(len = *), INTENT(in) ::   cd_modname   ! model name as set in namcouple file
-      INTEGER          , INTENT(out) ::   kl_comm      ! local communicator of the model
+      CHARACTER(len = *), INTENT(in   ) ::   cd_modname   ! model name as set in namcouple file
+      INTEGER           , INTENT(  out) ::   kl_comm      ! local communicator of the model
       !!--------------------------------------------------------------------
 
@@ -163,5 +164,4 @@
          CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld')   ;   RETURN
       ENDIF
-
       !
       ! ... Define the shape for the area that excludes the halo
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 6808)
@@ -4,9 +4,7 @@
    !! Ocean forcing:  read input field for surface boundary condition
    !!=====================================================================
-   !! History :  2.0  !  06-2006  (S. Masson, G. Madec) Original code
-   !!                 !  05-2008  (S. Alderson) Modified for Interpolation in memory
-   !!                 !                         from input grid to model grid
-   !!                 !  10-2013  (D. Delrosso, P. Oddo) implement suppression of 
-   !!                 !                         land point prior to interpolation
+   !! History :  2.0  !  06-2006  (S. Masson, G. Madec)  Original code
+   !!                 !  05-2008  (S. Alderson)  Modified for Interpolation in memory from input grid to model grid
+   !!                 !  10-2013  (D. Delrosso, P. Oddo)  suppression of land point prior to interpolation
    !!----------------------------------------------------------------------
 
@@ -15,15 +13,16 @@
    !!                   surface boundary condition
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! ???
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O manager library
-   USE geo2ocean       ! for vector rotation on to model grid
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! work arrays
-   USE lbclnk          ! ocean lateral boundary conditions (C1D case)
-   USE ioipsl, ONLY :   ymds2ju, ju2ymds   ! for calendar
-   USE sbc_oce
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constant
+   USE sbc_oce        ! surface boundary conditions : fields
+   USE geo2ocean      ! for vector rotation on to model grid
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE ioipsl  , ONLY : ymds2ju, ju2ymds   ! for calendar
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lbclnk         ! ocean lateral boundary conditions (C1D case)
    
    IMPLICIT NONE
@@ -32,4 +31,5 @@
    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
@@ -59,6 +59,6 @@
       INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year)
       INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year)
-      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow       ! input fields interpolated to now time step
-      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta       ! 2 consecutive record of input fields
+      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow   ! input fields interpolated to now time step
+      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta   ! 2 consecutive record of input fields
       CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key
       !                                                 ! into the WGTLIST structure
@@ -132,22 +132,21 @@
       INTEGER  , INTENT(in   ), OPTIONAL     ::   kit       ! subcycle timestep for timesplitting option
       INTEGER  , INTENT(in   ), OPTIONAL     ::   kt_offset ! provide fields at time other than "now"
-                                                            !   kt_offset = -1 => fields at "before" time level
-                                                            !   kt_offset = +1 => fields at "after"  time level
-                                                            !   etc.
-      !!
-      INTEGER  ::   itmp       ! temporary variable
-      INTEGER  ::   imf        ! size of the structure sd
-      INTEGER  ::   jf         ! dummy indices
-      INTEGER  ::   isecend    ! number of second since Jan. 1st 00h of nit000 year at nitend
-      INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step
-      INTEGER  ::   it_offset  ! local time offset variable
-      LOGICAL  ::   llnxtyr    ! open next year  file?
-      LOGICAL  ::   llnxtmth   ! open next month file?
-      LOGICAL  ::   llstop     ! stop is the file does not exist
+      !                                                     !   kt_offset = -1 => fields at "before" time level
+      !                                                     !   kt_offset = +1 => fields at "after"  time level
+      !                                                     !   etc.
+      INTEGER  ::   itmp         ! local variable
+      INTEGER  ::   imf          ! size of the structure sd
+      INTEGER  ::   jf           ! dummy indices
+      INTEGER  ::   isecend      ! number of second since Jan. 1st 00h of nit000 year at nitend
+      INTEGER  ::   isecsbc      ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step
+      INTEGER  ::   it_offset    ! local time offset variable
+      LOGICAL  ::   llnxtyr      ! open next year  file?
+      LOGICAL  ::   llnxtmth     ! open next month file?
+      LOGICAL  ::   llstop       ! stop is the file does not exist
       LOGICAL  ::   ll_firstcall ! true if this is the first call to fld_read for this set of fields
-      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation
-      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation
-      CHARACTER(LEN=1000) ::   clfmt   ! write format
-      TYPE(MAP_POINTER) ::   imap   ! global-to-local mapping indices
+      REAL(wp) ::   ztinta       ! ratio applied to after  records when doing time interpolation
+      REAL(wp) ::   ztintb       ! ratio applied to before records when doing time interpolation
+      CHARACTER(LEN=1000) ::   clfmt  ! write format
+      TYPE(MAP_POINTER)   ::   imap   ! global-to-local mapping indices
       !!---------------------------------------------------------------------
       ll_firstcall = kt == nit000
@@ -165,5 +164,5 @@
          isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rdt/REAL(nn_baro,wp) )
       ELSE                      ! middle of sbc time step
-         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + it_offset * NINT(rdttra(1))
+         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdt) + it_offset * NINT(rdt)
       ENDIF
       imf = SIZE( sd )
@@ -192,5 +191,5 @@
                CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit )    ! update after record informations
 
-               ! if kn_fsbc*rdttra is larger than nfreqh (which is kind of odd),
+               ! if kn_fsbc*rdt is larger than nfreqh (which is kind of odd),
                ! it is possible that the before value is no more the good one... we have to re-read it
                ! if before is not the last record of the file currently opened and after is the first record to be read
@@ -213,5 +212,5 @@
                IF( sd(jf)%ln_tint ) THEN
                   
-                  ! if kn_fsbc*rdttra is larger than nfreqh (which is kind of odd),
+                  ! if kn_fsbc*rdt is larger than nfreqh (which is kind of odd),
                   ! it is possible that the before value is no more the good one... we have to re-read it
                   ! if before record is not just just before the after record...
@@ -244,5 +243,5 @@
                         ! year/month/week/day file to be not present. If the run continue further than the current
                         ! year/month/week/day, next year/month/week/day file must exist
-                        isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1))   ! second at the end of the run 
+                        isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdt)   ! second at the end of the run
                         llstop = isecend > sd(jf)%nrec_a(2)                                   ! read more than 1 record of next year
                         ! we suppose that the date of next file is next day (should be ok even for weekly files...)
@@ -284,5 +283,4 @@
                ztinta =  REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp )
                ztintb =  1. - ztinta
-!CDIR COLLAPSE
                sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2)
             ELSE   ! nothing to do...
@@ -299,7 +297,5 @@
          END DO                                    ! --- end loop over field --- !
          !
-         !                                         ! ====================================== !
-      ENDIF                                        ! update field at each kn_fsbc time-step !
-      !                                            ! ====================================== !
+      ENDIF
       !
    END SUBROUTINE fld_read
@@ -333,12 +329,12 @@
       llprevday  = .FALSE.
       isec_week  = 0
-            
+      !
       ! define record informations
       CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. )  ! return before values in sdjf%nrec_a (as we will swap it later)
-
+      !
       ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
-
+      !
       IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure
-
+         !
          IF( sdjf%nrec_a(1) == 0  ) THEN   ! we redefine record sdjf%nrec_a(1) with the last record of previous year file
             IF    ( sdjf%nfreqh == -12 ) THEN   ! yearly mean
@@ -391,5 +387,5 @@
          !
          CALL fld_clopn( sdjf, iyear, imonth, iday, .NOT. llprev )
-
+         !
          ! if previous year/month/day file does not exist, we switch to the current year/month/day
          IF( llprev .AND. sdjf%num <= 0 ) THEN
@@ -401,5 +397,5 @@
             CALL fld_clopn( sdjf )
          ENDIF
-         
+         !
          IF( llprev ) THEN   ! check if the record sdjf%nrec_a(1) exists in the file
             idvar = iom_varid( sdjf%num, sdjf%clvar )                                        ! id of the variable sdjf%clvar
@@ -408,11 +404,10 @@
             sdjf%nrec_a(1) = MIN( sdjf%nrec_a(1), inrec )   ! make sure we select an existing record
          ENDIF
-
-         ! read before data in after arrays(as we will swap it later)
-         CALL fld_get( sdjf, map )
-
+         !
+         CALL fld_get( sdjf, map )         ! read before data in after arrays(as we will swap it later)
+         !
          clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i6, ' at time = ', f7.2, ' days')"
          IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday
-
+         !
       ENDIF
       !
@@ -435,8 +430,8 @@
       LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.)
       INTEGER  , INTENT(in   ), OPTIONAL ::   kit       ! index of barotropic subcycle
-                                                        ! used only if sdjf%ln_tint = .TRUE.
+      !                                                 ! used only if sdjf%ln_tint = .TRUE.
       INTEGER  , INTENT(in   ), OPTIONAL ::   kt_offset ! Offset of required time level compared to "now"
-                                                        !   time level in units of time steps.
-      !!
+      !                                                 !   time level in units of time steps.
+      !
       LOGICAL  ::   llbefore    ! local definition of ldbefore
       INTEGER  ::   iendrec     ! end of this record (in seconds)
@@ -459,5 +454,5 @@
       IF( PRESENT(kt_offset) )   it_offset = kt_offset
       IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) )
-      ELSE                      ;   it_offset =         it_offset   * NINT(       rdttra(1)      )
+      ELSE                      ;   it_offset =         it_offset   * NINT(       rdt            )
       ENDIF
       !
@@ -536,6 +531,6 @@
          ELSE                                           ;   ztmp = REAL(nsec_year ,wp)  ! since 00h on Jan 1 of the current year
          ENDIF
-         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1) + REAL( it_offset, wp )  ! centrered in the middle of sbc time step
-         ztmp = ztmp + 0.01 * rdttra(1)                                                 ! avoid truncation error 
+         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdt + REAL( it_offset, wp )        ! centrered in the middle of sbc time step
+         ztmp = ztmp + 0.01 * rdt                                                       ! avoid truncation error 
          IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record
             !
@@ -592,13 +587,13 @@
       !! ** Purpose :   read the data
       !!----------------------------------------------------------------------
-      TYPE(FLD), INTENT(inout) ::   sdjf   ! input field related variables
-      TYPE(MAP_POINTER),INTENT(in) ::   map   ! global-to-local mapping indices
-      !!
-      INTEGER                  ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
-      INTEGER                  ::   iw     ! index into wgts array
-      INTEGER                  ::   ipdom  ! index of the domain
-      INTEGER                  ::   idvar  ! variable ID
-      INTEGER                  ::   idmspc ! number of spatial dimensions
-      LOGICAL                  ::   lmoor  ! C1D case: point data
+      TYPE(FLD)        , INTENT(inout) ::   sdjf   ! input field related variables
+      TYPE(MAP_POINTER), INTENT(in   ) ::   map    ! global-to-local mapping indices
+      !
+      INTEGER ::   ipk      ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
+      INTEGER ::   iw       ! index into wgts array
+      INTEGER ::   ipdom    ! index of the domain
+      INTEGER ::   idvar    ! variable ID
+      INTEGER ::   idmspc   ! number of spatial dimensions
+      LOGICAL ::   lmoor    ! C1D case: point data
       !!---------------------------------------------------------------------
       !
@@ -611,19 +606,19 @@
       ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
          CALL wgt_list( sdjf, iw )
-         IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fdta(:,:,:,2), & 
-              & sdjf%nrec_a(1), sdjf%lsmname )
-         ELSE                      ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fnow(:,:,:  ), &
-              & sdjf%nrec_a(1), sdjf%lsmname )
+         IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fdta(:,:,:,2),          & 
+            &                                                                          sdjf%nrec_a(1), sdjf%lsmname )
+         ELSE                      ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fnow(:,:,:  ),          &
+            &                                                                          sdjf%nrec_a(1), sdjf%lsmname )
          ENDIF
       ELSE
-         IF( SIZE(sdjf%fnow, 1) == jpi ) THEN  ;  ipdom = jpdom_data
-         ELSE                                  ;  ipdom = jpdom_unknown
+         IF( SIZE(sdjf%fnow, 1) == jpi ) THEN   ;   ipdom = jpdom_data
+         ELSE                                   ;   ipdom = jpdom_unknown
          ENDIF
          ! C1D case: If product of spatial dimensions == ipk, then x,y are of
          ! size 1 (point/mooring data): this must be read onto the central grid point
          idvar  = iom_varid( sdjf%num, sdjf%clvar )
-         idmspc = iom_file( sdjf%num )%ndims( idvar )
+         idmspc = iom_file ( sdjf%num )%ndims( idvar )
          IF( iom_file( sdjf%num )%luld( idvar ) )   idmspc = idmspc - 1
-         lmoor  = (idmspc == 0 .OR. PRODUCT( iom_file( sdjf%num )%dimsz( 1:MAX(idmspc,1) ,idvar ) ) == ipk)
+         lmoor  = (  idmspc == 0 .OR. PRODUCT( iom_file( sdjf%num )%dimsz( 1:MAX(idmspc,1) ,idvar ) ) == ipk  )
          !
          SELECT CASE( ipk )
@@ -660,6 +655,7 @@
       !
       sdjf%rotn(2) = .false.   ! vector not yet rotated
-
+      !
    END SUBROUTINE fld_get
+
 
    SUBROUTINE fld_map( num, clvar, dta, nrec, map )
@@ -688,9 +684,9 @@
       REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read  ! work space for global data
       !!---------------------------------------------------------------------
-            
+      !
       ipi = SIZE( dta, 1 )
       ipj = 1
       ipk = SIZE( dta, 3 )
-
+      !
       idvar   = iom_varid( num, clvar )
       ilendta = iom_file(num)%dimsz(1,idvar)
@@ -698,14 +694,14 @@
 #if defined key_bdy
       ipj = iom_file(num)%dimsz(2,idvar)
-      IF ( map%ll_unstruc) THEN ! unstructured open boundary data file
+      IF( map%ll_unstruc) THEN   ! unstructured open boundary data file
          dta_read => dta_global
-      ELSE                      ! structured open boundary data file
+      ELSE                       ! structured open boundary data file
          dta_read => dta_global2
       ENDIF
 #endif
 
-      IF(lwp) WRITE(numout,*) 'Dim size for ',TRIM(clvar),' is ', ilendta
+      IF(lwp) WRITE(numout,*) 'Dim size for ',        TRIM(clvar),' is ', ilendta
       IF(lwp) WRITE(numout,*) 'Number of levels for ',TRIM(clvar),' is ', ipk
-
+      !
       SELECT CASE( ipk )
       CASE(1)        ;   CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1    ), nrec )
@@ -713,5 +709,5 @@
       END SELECT
       !
-      IF ( map%ll_unstruc ) THEN ! unstructured open boundary data file
+      IF( map%ll_unstruc ) THEN  ! unstructured open boundary data file
          DO ib = 1, ipi
             DO ik = 1, ipk
@@ -728,5 +724,5 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE fld_map
 
@@ -738,17 +734,17 @@
       !! ** Purpose :   Vector fields may need to be rotated onto the local grid direction
       !!----------------------------------------------------------------------
-      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step
-      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables
-      !!
-      INTEGER                           ::   ju,jv,jk,jn  ! loop indices
-      INTEGER                           ::   imf          ! size of the structure sd
-      INTEGER                           ::   ill          ! character length
-      INTEGER                           ::   iv           ! indice of V component
+      INTEGER                , INTENT(in   ) ::   kt   ! ocean time step
+      TYPE(FLD), DIMENSION(:), INTENT(inout) ::   sd   ! input field related variables
+      !
+      INTEGER ::   ju, jv, jk, jn  ! loop indices
+      INTEGER ::   imf             ! size of the structure sd
+      INTEGER ::   ill             ! character length
+      INTEGER ::   iv              ! indice of V component
+      CHARACTER (LEN=100)               ::   clcomp       ! dummy weight name
       REAL(wp), POINTER, DIMENSION(:,:) ::   utmp, vtmp   ! temporary arrays for vector rotation
-      CHARACTER (LEN=100)               ::   clcomp       ! dummy weight name
-      !!---------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi,jpj, utmp, vtmp )
-
+      !!---------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,   utmp, vtmp )
+      !
       !! (sga: following code should be modified so that pairs arent searched for each time
       !
@@ -786,5 +782,5 @@
        END DO
       !
-      CALL wrk_dealloc( jpi,jpj, utmp, vtmp )
+      CALL wrk_dealloc( jpi,jpj,   utmp, vtmp )
       !
    END SUBROUTINE fld_rot
@@ -802,5 +798,5 @@
       INTEGER, OPTIONAL, INTENT(in   ) ::   kday     ! day value
       LOGICAL, OPTIONAL, INTENT(in   ) ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
-      !!
+      !
       LOGICAL :: llprevyr              ! are we reading previous year  file?
       LOGICAL :: llprevmth             ! are we reading previous month file?
@@ -815,4 +811,12 @@
          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
@@ -845,9 +849,9 @@
       !
       IF( TRIM(clname) /= TRIM(sdjf%clname) .OR. sdjf%num == 0 ) THEN   ! new file to be open 
-
+         !
          sdjf%clname = TRIM(clname)
          IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open
          CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 )
-
+         !
          ! find the last record to be read -> update sdjf%nreclast
          indexyr = iyear - nyear + 1
@@ -858,5 +862,5 @@
          CASE ( 2 )   ;   imonth_len = 31   ! next     year -> imonth = 1
          END SELECT
-         
+         !
          ! last record to be read in the current file
          IF    ( sdjf%nfreqh == -12 ) THEN                 ;   sdjf%nreclast = 1    !  yearly mean
@@ -872,5 +876,5 @@
             ENDIF
          ENDIF
-         
+         !
       ENDIF
       !
@@ -893,5 +897,5 @@
       INTEGER  ::   jf       ! dummy indices
       !!---------------------------------------------------------------------
-
+      !
       DO jf = 1, SIZE(sdf)
          sdf(jf)%clrootname = TRIM( cdir )//TRIM( sdf_n(jf)%clname )
@@ -915,5 +919,5 @@
          sdf(jf)%nreclast = -1 ! Set to non zero default value to avoid errors, is updated to meaningful value during fld_clopn
       END DO
-
+      !
       IF(lwp) THEN      ! control print
          WRITE(numout,*)
@@ -935,5 +939,5 @@
          END DO
       ENDIF
-      
+      !
    END SUBROUTINE fld_fill
 
@@ -950,5 +954,5 @@
       TYPE( FLD ), INTENT(in   ) ::   sd        ! field with name of weights file
       INTEGER    , INTENT(inout) ::   kwgt      ! index of weights
-      !!
+      !
       INTEGER ::   kw, nestid   ! local integer
       LOGICAL ::   found        ! local logical
@@ -958,5 +962,5 @@
       !! weights filename is either present or we hit the end of the list
       found = .FALSE.
-
+      !
       !! because agrif nest part of filenames are now added in iom_open
       !! to distinguish between weights files on the different grids, need to track
@@ -1020,18 +1024,18 @@
       TYPE( FLD ), INTENT(in) ::   sd   ! field with name of weights file
       !!
-      INTEGER                           ::   jn            ! dummy loop indices
-      INTEGER                           ::   inum          ! temporary logical unit
-      INTEGER                           ::   id            ! temporary variable id
-      INTEGER                           ::   ipk           ! temporary vertical dimension
-      CHARACTER (len=5)                 ::   aname
+      INTEGER ::   jn         ! dummy loop indices
+      INTEGER ::   inum       ! local logical unit
+      INTEGER ::   id         ! local variable id
+      INTEGER ::   ipk        ! local vertical dimension
+      INTEGER ::   zwrap      ! local integer
+      LOGICAL ::   cyclical   ! 
+      CHARACTER (len=5) ::   aname   !
       INTEGER , DIMENSION(:), ALLOCATABLE ::   ddims
       INTEGER , POINTER, DIMENSION(:,:) ::   data_src
       REAL(wp), POINTER, DIMENSION(:,:) ::   data_tmp
-      LOGICAL                           ::   cyclical
-      INTEGER                           ::   zwrap      ! local integer
-      !!----------------------------------------------------------------------
-      !
-      CALL wrk_alloc( jpi,jpj, data_src )   ! integer
-      CALL wrk_alloc( jpi,jpj, data_tmp )
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,   data_src )   ! integer
+      CALL wrk_alloc( jpi,jpj,   data_tmp )
       !
       IF( nxt_wgt > tot_wgts ) THEN
@@ -1143,7 +1147,7 @@
          ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) )
          IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col(1,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) )
-
+         !
          nxt_wgt = nxt_wgt + 1
-
+         !
       ELSE 
          CALL ctl_stop( '    fld_weight : unable to read the file ' )
@@ -1158,6 +1162,6 @@
 
 
-   SUBROUTINE apply_seaoverland(clmaskfile,zfieldo,jpi1_lsm,jpi2_lsm,jpj1_lsm, &
-                          &      jpj2_lsm,itmpi,itmpj,itmpz,rec1_lsm,recn_lsm)
+   SUBROUTINE apply_seaoverland( clmaskfile, zfieldo, jpi1_lsm, jpi2_lsm, jpj1_lsm,   &
+                          &      jpj2_lsm, itmpi, itmpj, itmpz, rec1_lsm, recn_lsm )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE apply_seaoverland  ***
@@ -1168,67 +1172,61 @@
       !!      D. Delrosso INGV          
       !!---------------------------------------------------------------------- 
-      INTEGER                                   :: inum,jni,jnj,jnz,jc                  ! temporary indices
-      INTEGER,                   INTENT(in)     :: itmpi,itmpj,itmpz                    ! lengths
-      INTEGER,                   INTENT(in)     :: jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm  ! temporary indices
-      INTEGER, DIMENSION(3),     INTENT(in)     :: rec1_lsm,recn_lsm                    ! temporary arrays for start and length
-      REAL(wp),DIMENSION (:,:,:),INTENT(inout)  :: zfieldo                              ! input/output array for seaoverland application
-      REAL(wp),DIMENSION (:,:,:),ALLOCATABLE    :: zslmec1                              ! temporary array for land point detection
-      REAL(wp),DIMENSION (:,:),  ALLOCATABLE    :: zfieldn                              ! array of forcing field with undeff for land points
-      REAL(wp),DIMENSION (:,:),  ALLOCATABLE    :: zfield                               ! array of forcing field
-      CHARACTER (len=100),       INTENT(in)     :: clmaskfile                           ! land/sea mask file name
-      !!---------------------------------------------------------------------
-      ALLOCATE ( zslmec1(itmpi,itmpj,itmpz) )
-      ALLOCATE ( zfieldn(itmpi,itmpj) )
-      ALLOCATE ( zfield(itmpi,itmpj) )
-
+      INTEGER,                   INTENT(in   ) :: itmpi,itmpj,itmpz                    ! lengths
+      INTEGER,                   INTENT(in   ) :: jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm  ! temporary indices
+      INTEGER, DIMENSION(3),     INTENT(in   ) :: rec1_lsm,recn_lsm                    ! temporary arrays for start and length
+      REAL(wp),DIMENSION (:,:,:),INTENT(inout) :: zfieldo                              ! input/output array for seaoverland application
+      CHARACTER (len=100),       INTENT(in   ) :: clmaskfile                           ! land/sea mask file name
+      !
+      INTEGER :: inum,jni,jnj,jnz,jc   ! local indices
+      REAL(wp),DIMENSION (:,:,:),ALLOCATABLE :: zslmec1             ! local array for land point detection
+      REAL(wp),DIMENSION (:,:),  ALLOCATABLE :: zfieldn   ! array of forcing field with undeff for land points
+      REAL(wp),DIMENSION (:,:),  ALLOCATABLE :: zfield    ! array of forcing field
+      !!---------------------------------------------------------------------
+      !
+      ALLOCATE ( zslmec1(itmpi,itmpj,itmpz), zfieldn(itmpi,itmpj), zfield(itmpi,itmpj) )
+      !
       ! Retrieve the land sea mask data
       CALL iom_open( clmaskfile, inum )
       SELECT CASE( SIZE(zfieldo(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),3) )
       CASE(1)
-           CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,1), 1, rec1_lsm, recn_lsm)
+         CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,1), 1, rec1_lsm, recn_lsm)
       CASE DEFAULT
-           CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:), 1, rec1_lsm, recn_lsm)
+         CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:), 1, rec1_lsm, recn_lsm)
       END SELECT
       CALL iom_close( inum )
-
-      DO jnz=1,rec1_lsm(3)                            !! Loop over k dimension
-
-         DO jni=1,itmpi                               !! copy the original field into a tmp array
-            DO jnj=1,itmpj                            !! substituting undeff over land points
-            zfieldn(jni,jnj) = zfieldo(jni,jnj,jnz)
-               IF ( zslmec1(jni,jnj,jnz) == 1. ) THEN
-                  zfieldn(jni,jnj) = undeff_lsm
-               ENDIF
+      !
+      DO jnz=1,rec1_lsm(3)             !! Loop over k dimension
+         !
+         DO jni = 1, itmpi                               !! copy the original field into a tmp array
+            DO jnj = 1, itmpj                            !! substituting undeff over land points
+               zfieldn(jni,jnj) = zfieldo(jni,jnj,jnz)
+               IF( zslmec1(jni,jnj,jnz) == 1. )   zfieldn(jni,jnj) = undeff_lsm
             END DO
          END DO
-  
-      CALL seaoverland(zfieldn,itmpi,itmpj,zfield)
-      DO jc=1,nn_lsm
-         CALL seaoverland(zfield,itmpi,itmpj,zfield)
-      END DO
-
-      !   Check for Undeff and substitute original values
-      IF(ANY(zfield==undeff_lsm)) THEN
-         DO jni=1,itmpi
-            DO jnj=1,itmpj
-               IF (zfield(jni,jnj)==undeff_lsm) THEN
-                  zfield(jni,jnj) = zfieldo(jni,jnj,jnz)
-               ENDIF
-            ENDDO
-         ENDDO
-      ENDIF
-
-      zfieldo(:,:,jnz)=zfield(:,:)
-
-      END DO                          !! End Loop over k dimension
-
-      DEALLOCATE ( zslmec1 )
-      DEALLOCATE ( zfieldn )
-      DEALLOCATE ( zfield )
-
+         !
+         CALL seaoverland( zfieldn, itmpi, itmpj, zfield )
+         DO jc = 1, nn_lsm
+            CALL seaoverland( zfield, itmpi, itmpj, zfield )
+         END DO
+         !
+         !   Check for Undeff and substitute original values
+         IF( ANY(zfield==undeff_lsm) ) THEN
+            DO jni = 1, itmpi
+               DO jnj = 1, itmpj
+                  IF( zfield(jni,jnj)==undeff_lsm )   zfield(jni,jnj) = zfieldo(jni,jnj,jnz)
+               END DO
+            END DO
+         ENDIF
+         !
+         zfieldo(:,:,jnz) = zfield(:,:)
+         !
+      END DO                           !! End Loop over k dimension
+      !
+      DEALLOCATE ( zslmec1, zfieldn, zfield )
+      !
    END SUBROUTINE apply_seaoverland 
 
 
-   SUBROUTINE seaoverland(zfieldn,ileni,ilenj,zfield)
+   SUBROUTINE seaoverland( zfieldn, ileni, ilenj, zfield )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE seaoverland  ***
@@ -1237,29 +1235,31 @@
       !!      D. Delrosso INGV
       !!---------------------------------------------------------------------- 
-      INTEGER,INTENT(in)                       :: ileni,ilenj              ! lengths 
-      REAL,DIMENSION (ileni,ilenj),INTENT(in)  :: zfieldn                  ! array of forcing field with undeff for land points
-      REAL,DIMENSION (ileni,ilenj),INTENT(out) :: zfield                   ! array of forcing field
-      REAL,DIMENSION (ileni,ilenj)             :: zmat1,zmat2,zmat3,zmat4  ! temporary arrays for seaoverland application
-      REAL,DIMENSION (ileni,ilenj)             :: zmat5,zmat6,zmat7,zmat8  ! temporary arrays for seaoverland application
-      REAL,DIMENSION (ileni,ilenj)             :: zlsm2d                   ! temporary arrays for seaoverland application
-      REAL,DIMENSION (ileni,ilenj,8)           :: zlsm3d                   ! temporary arrays for seaoverland application
-      LOGICAL,DIMENSION (ileni,ilenj,8)        :: ll_msknan3d              ! logical mask for undeff detection
-      LOGICAL,DIMENSION (ileni,ilenj)          :: ll_msknan2d              ! logical mask for undeff detection
+      INTEGER                      , INTENT(in   ) :: ileni,ilenj   ! lengths 
+      REAL, DIMENSION (ileni,ilenj), INTENT(in   ) :: zfieldn       ! array of forcing field with undeff for land points
+      REAL, DIMENSION (ileni,ilenj), INTENT(  out) :: zfield        ! array of forcing field
+      !
+      REAL   , DIMENSION (ileni,ilenj)   :: zmat1, zmat2, zmat3, zmat4  ! local arrays 
+      REAL   , DIMENSION (ileni,ilenj)   :: zmat5, zmat6, zmat7, zmat8  !   -     - 
+      REAL   , DIMENSION (ileni,ilenj)   :: zlsm2d                      !   -     - 
+      REAL   , DIMENSION (ileni,ilenj,8) :: zlsm3d                      !   -     -
+      LOGICAL, DIMENSION (ileni,ilenj,8) :: ll_msknan3d                 ! logical mask for undeff detection
+      LOGICAL, DIMENSION (ileni,ilenj)   :: ll_msknan2d                 ! logical mask for undeff detection
       !!---------------------------------------------------------------------- 
-      zmat8 = eoshift(zfieldn   ,  SHIFT=-1, BOUNDARY = (/zfieldn(:,1)/)    ,DIM=2)
-      zmat1 = eoshift(zmat8     ,  SHIFT=-1, BOUNDARY = (/zmat8(1,:)/)      ,DIM=1)
-      zmat2 = eoshift(zfieldn   ,  SHIFT=-1, BOUNDARY = (/zfieldn(1,:)/)    ,DIM=1)
-      zmat4 = eoshift(zfieldn   ,  SHIFT= 1, BOUNDARY = (/zfieldn(:,ilenj)/),DIM=2)
-      zmat3 = eoshift(zmat4     ,  SHIFT=-1, BOUNDARY = (/zmat4(1,:)/)      ,DIM=1)
-      zmat5 = eoshift(zmat4     ,  SHIFT= 1, BOUNDARY = (/zmat4(ileni,:)/)  ,DIM=1)
-      zmat6 = eoshift(zfieldn   ,  SHIFT= 1, BOUNDARY = (/zfieldn(ileni,:)/),DIM=1)
-      zmat7 = eoshift(zmat8     ,  SHIFT= 1, BOUNDARY = (/zmat8(ileni,:)/)  ,DIM=1)
-
+      zmat8 = eoshift( zfieldn , SHIFT=-1 , BOUNDARY = (/zfieldn(:,1)/)     , DIM=2 )
+      zmat1 = eoshift( zmat8   , SHIFT=-1 , BOUNDARY = (/zmat8(1,:)/)       , DIM=1 )
+      zmat2 = eoshift( zfieldn , SHIFT=-1 , BOUNDARY = (/zfieldn(1,:)/)     , DIM=1 )
+      zmat4 = eoshift( zfieldn , SHIFT= 1 , BOUNDARY = (/zfieldn(:,ilenj)/) , DIM=2 )
+      zmat3 = eoshift( zmat4   , SHIFT=-1 , BOUNDARY = (/zmat4(1,:)/)       , DIM=1 )
+      zmat5 = eoshift( zmat4   , SHIFT= 1 , BOUNDARY = (/zmat4(ileni,:)/)   , DIM=1 )
+      zmat6 = eoshift( zfieldn , SHIFT= 1 , BOUNDARY = (/zfieldn(ileni,:)/) , DIM=1 )
+      zmat7 = eoshift( zmat8   , SHIFT= 1 , BOUNDARY = (/zmat8(ileni,:)/)   , DIM=1 )
+      !
       zlsm3d  = RESHAPE( (/ zmat1, zmat2, zmat3, zmat4, zmat5, zmat6, zmat7, zmat8 /), (/ ileni, ilenj, 8 /))
-      ll_msknan3d = .not.(zlsm3d==undeff_lsm)
-      ll_msknan2d = .not.(zfieldn==undeff_lsm)  ! FALSE where is Undeff (land)
-      zlsm2d = (SUM ( zlsm3d, 3 , ll_msknan3d ) )/(MAX(1,(COUNT( ll_msknan3d , 3 ))   ))
-      WHERE ((COUNT( ll_msknan3d , 3 )) == 0.0_wp)  zlsm2d = undeff_lsm
-      zfield = MERGE (zfieldn,zlsm2d,ll_msknan2d)
+      ll_msknan3d = .NOT.( zlsm3d  == undeff_lsm )
+      ll_msknan2d = .NOT.( zfieldn == undeff_lsm )  ! FALSE where is Undeff (land)
+      zlsm2d = SUM( zlsm3d, 3 , ll_msknan3d ) / MAX( 1 , COUNT( ll_msknan3d , 3 ) )
+      WHERE( COUNT( ll_msknan3d , 3 ) == 0._wp )   zlsm2d = undeff_lsm
+      zfield = MERGE( zfieldn, zlsm2d, ll_msknan2d )
+      !
    END SUBROUTINE seaoverland
 
@@ -1280,19 +1280,18 @@
       INTEGER                   , INTENT(in   ) ::   nrec    ! record number to read (ie time slice)
       CHARACTER(LEN=*)          , INTENT(in   ) ::   lsmfile ! land sea mask file name
-      !! 
-      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
-      INTEGER                                   ::   ii_lsm1,ii_lsm2,ij_lsm1,ij_lsm2       ! temporary indices
-      INTEGER                                   ::   jk, jn, jm, jir, jjr                  ! loop counters
-      INTEGER                                   ::   ni, nj                                ! lengths
-      INTEGER                                   ::   jpimin,jpiwid                         ! temporary indices
-      INTEGER                                   ::   jpimin_lsm,jpiwid_lsm                 ! temporary indices
-      INTEGER                                   ::   jpjmin,jpjwid                         ! temporary indices
-      INTEGER                                   ::   jpjmin_lsm,jpjwid_lsm                 ! temporary indices
-      INTEGER                                   ::   jpi1,jpi2,jpj1,jpj2                   ! temporary indices
-      INTEGER                                   ::   jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm   ! temporary indices
-      INTEGER                                   ::   itmpi,itmpj,itmpz                     ! lengths
-      
+      !
+      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
+      INTEGER ::   ii_lsm1,ii_lsm2,ij_lsm1,ij_lsm2    ! temporary indices
+      INTEGER ::   jk, jn, jm, jir, jjr               ! loop counters
+      INTEGER ::   ni, nj                             ! lengths
+      INTEGER ::   jpimin,jpiwid                      ! temporary indices
+      INTEGER ::   jpimin_lsm,jpiwid_lsm              ! temporary indices
+      INTEGER ::   jpjmin,jpjwid                      ! temporary indices
+      INTEGER ::   jpjmin_lsm,jpjwid_lsm              ! temporary indices
+      INTEGER ::   jpi1,jpi2,jpj1,jpj2                ! temporary indices
+      INTEGER ::   jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm   ! temporary indices
+      INTEGER ::   itmpi,itmpj,itmpz                     ! lengths
+      REAL(wp),DIMENSION(:,:,:), ALLOCATABLE ::   ztmp_fly_dta                 ! local array of values on input grid     
       !!----------------------------------------------------------------------
       !
@@ -1347,6 +1346,6 @@
 
 
-         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)
+         itmpi=jpi2_lsm-jpi1_lsm+1
+         itmpj=jpj2_lsm-jpj1_lsm+1
          itmpz=kk
          ALLOCATE(ztmp_fly_dta(itmpi,itmpj,itmpz))
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 6808)
@@ -5,39 +5,41 @@
    !!======================================================================
    !! History :  OPA  !  07-1996  (O. Marti)  Original code
-   !!   NEMO     1.0  !  02-2008  (G. Madec)  F90: Free form
-   !!            3.0  !  
+   !!   NEMO     1.0  !  06-2006  (G. Madec )  Free form, F90 + opt.
+   !!                 !  04-2007  (S. Masson)  angle: Add T, F points and bugfix in cos lateral boundary
+   !!            3.0  !  07-2008  (G. Madec)  geo2oce suppress lon/lat agruments
+   !!            3.7  !  11-2015  (G. Madec)  remove the unused repere and repcmo routines
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   repcmo      : 
-   !!   angle       :
-   !!   geo2oce     :
-   !!   repere      :   old routine suppress it ???
+   !!   rot_rep       : Rotate the Repere: geographic grid <==> stretched coordinates grid
+   !!   angle         :
+   !!   geo2oce       :
+   !!   oce2geo       :
    !!----------------------------------------------------------------------
-   USE dom_oce         ! mesh and scale factors
-   USE phycst          ! physical constants
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! MPP library
+   USE dom_oce        ! mesh and scale factors
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   rot_rep, repcmo, repere, geo2oce, oce2geo   ! only rot_rep should be used
-                                             ! repcmo and repere are keep only for compatibility.
-                                             ! they are only a useless overlay of rot_rep
-
-   PUBLIC   obs_rot
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &
-      gsint, gcost,   &  ! cos/sin between model grid lines and NP direction at T point
-      gsinu, gcosu,   &  ! cos/sin between model grid lines and NP direction at U point
-      gsinv, gcosv,   &  ! cos/sin between model grid lines and NP direction at V point
-      gsinf, gcosf       ! cos/sin between model grid lines and NP direction at F point
+   PUBLIC   rot_rep   ! called in sbccpl, fldread, and cyclone
+   PUBLIC   geo2oce   ! called in sbccpl
+   PUBLIC   oce2geo   ! called in sbccpl
+   PUBLIC   obs_rot   ! called in obs_rot_vel and obs_write
+
+   !                                         ! cos/sin between model grid lines and NP direction
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gsint, gcost   ! at T point
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gsinu, gcosu   ! at U point
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gsinv, gcosv   ! at V point
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gsinf, gcosf   ! at F point
 
    LOGICAL ,              SAVE, DIMENSION(4)     ::   linit = .FALSE.
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gsinlon, gcoslon, gsinlat, gcoslat
 
-   LOGICAL ::   lmust_init = .TRUE.        !: used to initialize the cos/sin variables (se above)
+   LOGICAL ::   lmust_init = .TRUE.        !: used to initialize the cos/sin variables (see above)
 
    !! * Substitutions
@@ -50,31 +52,4 @@
 CONTAINS
 
-   SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1,   &
-                       px2 , py2 )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE repcmo  ***
-      !!
-      !! ** Purpose :   Change vector componantes from a geographic grid to a
-      !!      stretched coordinates grid.
-      !!
-      !! ** Method  :   Initialization of arrays at the first call.
-      !!
-      !! ** Action  : - px2 : first  componante (defined at u point)
-      !!              - py2 : second componante (defined at v point)
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pxu1, pyu1   ! geographic vector componantes at u-point
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pxv1, pyv1   ! geographic vector componantes at v-point
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   px2          ! i-componante (defined at u-point)
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   py2          ! j-componante (defined at v-point)
-      !!----------------------------------------------------------------------
-      
-      ! Change from geographic to stretched coordinate
-      ! ----------------------------------------------
-      CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 )
-      CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 )
-      
-   END SUBROUTINE repcmo
-
-
    SUBROUTINE rot_rep ( pxin, pyin, cd_type, cdtodo, prot )
       !!----------------------------------------------------------------------
@@ -83,33 +58,27 @@
       !! ** Purpose :   Rotate the Repere: Change vector componantes between
       !!                geographic grid <--> stretched coordinates grid.
-      !!
-      !! History :
-      !!   9.2  !  07-04  (S. Masson)  
-      !!                  (O. Marti ) Original code (repere and repcmo)
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN ) ::   pxin, pyin   ! vector componantes
-      CHARACTER(len=1),             INTENT( IN ) ::   cd_type      ! define the nature of pt2d array grid-points
-      CHARACTER(len=5),             INTENT( IN ) ::   cdtodo       ! specify the work to do:
-      !!                                                           ! 'en->i' east-north componantes to model i componante
-      !!                                                           ! 'en->j' east-north componantes to model j componante
-      !!                                                           ! 'ij->e' model i-j componantes to east componante
-      !!                                                           ! 'ij->n' model i-j componantes to east componante
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::   prot      
-      !!----------------------------------------------------------------------
-
-      ! Initialization of gsin* and gcos* at first call
-      ! -----------------------------------------------
-
-      IF( lmust_init ) THEN
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pxin, pyin   ! vector componantes
+      CHARACTER(len=1),             INTENT(in   ) ::   cd_type      ! define the nature of pt2d array grid-points
+      CHARACTER(len=5),             INTENT(in   ) ::   cdtodo       ! type of transpormation:
+      !                                                             ! 'en->i' = east-north to i-component
+      !                                                             ! 'en->j' = east-north to j-component
+      !                                                             ! 'ij->e' = (i,j) components to east
+      !                                                             ! 'ij->n' = (i,j) components to north
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   prot      
+      !!----------------------------------------------------------------------
+      !
+      IF( lmust_init ) THEN      ! at 1st call only: set  gsin. & gcos.
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' rot_rep : geographic <--> stretched'
-         IF(lwp) WRITE(numout,*) ' ~~~~~    coordinate transformation'
+         IF(lwp) WRITE(numout,*) ' rot_rep: coordinate transformation : geographic <==> model (i,j)-components'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~~    '
          !
          CALL angle       ! initialization of the transformation
          lmust_init = .FALSE.
       ENDIF
-      
-      SELECT CASE (cdtodo)
-      CASE ('en->i')      ! 'en->i' est-north componantes to model i componante
+      !
+      SELECT CASE( cdtodo )      ! type of rotation
+      !
+      CASE( 'en->i' )                  ! east-north to i-component
          SELECT CASE (cd_type)
          CASE ('T')   ;   prot(:,:) = pxin(:,:) * gcost(:,:) + pyin(:,:) * gsint(:,:)
@@ -119,5 +88,5 @@
          CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' )
          END SELECT
-      CASE ('en->j')      ! 'en->j' est-north componantes to model j componante
+      CASE ('en->j')                   ! east-north to j-component
          SELECT CASE (cd_type)
          CASE ('T')   ;   prot(:,:) = pyin(:,:) * gcost(:,:) - pxin(:,:) * gsint(:,:)
@@ -127,5 +96,5 @@
          CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' )
          END SELECT
-      CASE ('ij->e')      ! 'ij->e' model i-j componantes to est componante
+      CASE ('ij->e')                   ! (i,j)-components to east
          SELECT CASE (cd_type)
          CASE ('T')   ;   prot(:,:) = pxin(:,:) * gcost(:,:) - pyin(:,:) * gsint(:,:)
@@ -135,5 +104,5 @@
          CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' )
          END SELECT
-      CASE ('ij->n')      ! 'ij->n' model i-j componantes to est componante
+      CASE ('ij->n')                   ! (i,j)-components to north 
          SELECT CASE (cd_type)
          CASE ('T')   ;   prot(:,:) = pyin(:,:) * gcost(:,:) + pxin(:,:) * gsint(:,:)
@@ -144,6 +113,7 @@
          END SELECT
       CASE DEFAULT   ;   CALL ctl_stop( 'rot_rep: Syntax Error in the definition of cdtodo' )
+      !
       END SELECT
-      
+      !
    END SUBROUTINE rot_rep
 
@@ -155,31 +125,24 @@
       !! ** Purpose :   Compute angles between model grid lines and the North direction
       !!
-      !! ** Method  :
-      !!
-      !! ** Action  :   Compute (gsint, gcost, gsinu, gcosu, gsinv, gcosv, gsinf, gcosf) arrays:
-      !!      sinus and cosinus of the angle between the north-south axe and the 
-      !!      j-direction at t, u, v and f-points
-      !!
-      !! History :
-      !!   7.0  !  96-07  (O. Marti )  Original code
-      !!   8.0  !  98-06  (G. Madec )
-      !!   8.5  !  98-06  (G. Madec )  Free form, F90 + opt.
-      !!   9.2  !  07-04  (S. Masson)  Add T, F points and bugfix in cos lateral boundary
-      !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj   ! dummy loop indices
-      INTEGER ::   ierr     ! local integer
-      REAL(wp) ::   &
-         zlam, zphi,            &  ! temporary scalars
-         zlan, zphh,            &  !    "         "
-         zxnpt, zynpt, znnpt,   &  ! x,y components and norm of the vector: T point to North Pole
-         zxnpu, zynpu, znnpu,   &  ! x,y components and norm of the vector: U point to North Pole
-         zxnpv, zynpv, znnpv,   &  ! x,y components and norm of the vector: V point to North Pole
-         zxnpf, zynpf, znnpf,   &  ! x,y components and norm of the vector: F point to North Pole
-         zxvvt, zyvvt, znvvt,   &  ! x,y components and norm of the vector: between V points below and above a T point
-         zxffu, zyffu, znffu,   &  ! x,y components and norm of the vector: between F points below and above a U point
-         zxffv, zyffv, znffv,   &  ! x,y components and norm of the vector: between F points left  and right a V point
-         zxuuf, zyuuf, znuuf       ! x,y components and norm of the vector: between U points below and above a F point
-      !!----------------------------------------------------------------------
-
+      !! ** Method  :   sinus and cosinus of the angle between the north-south axe 
+      !!              and the j-direction at t, u, v and f-points
+      !!                dot and cross products are used to obtain cos and sin, resp.
+      !!
+      !! ** Action  : - gsint, gcost, gsinu, gcosu, gsinv, gcosv, gsinf, gcosf
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      INTEGER  ::   ierr     ! local integer
+      REAL(wp) ::   zlam, zphi            ! local scalars
+      REAL(wp) ::   zlan, zphh            !   -      -
+      REAL(wp) ::   zxnpt, zynpt, znnpt   ! x,y components and norm of the vector: T point to North Pole
+      REAL(wp) ::   zxnpu, zynpu, znnpu   ! x,y components and norm of the vector: U point to North Pole
+      REAL(wp) ::   zxnpv, zynpv, znnpv   ! x,y components and norm of the vector: V point to North Pole
+      REAL(wp) ::   zxnpf, zynpf, znnpf   ! x,y components and norm of the vector: F point to North Pole
+      REAL(wp) ::   zxvvt, zyvvt, znvvt   ! x,y components and norm of the vector: between V points below and above a T point
+      REAL(wp) ::   zxffu, zyffu, znffu   ! x,y components and norm of the vector: between F points below and above a U point
+      REAL(wp) ::   zxffv, zyffv, znffv   ! x,y components and norm of the vector: between F points left  and right a V point
+      REAL(wp) ::   zxuuf, zyuuf, znuuf   ! x,y components and norm of the vector: between U points below and above a F point
+      !!----------------------------------------------------------------------
+      !
       ALLOCATE( gsint(jpi,jpj), gcost(jpi,jpj),   & 
          &      gsinu(jpi,jpj), gcosu(jpi,jpj),   & 
@@ -187,45 +150,39 @@
          &      gsinf(jpi,jpj), gcosf(jpi,jpj), STAT=ierr )
       IF(lk_mpp)   CALL mpp_sum( ierr )
-      IF( ierr /= 0 )   CALL ctl_stop('angle: unable to allocate arrays' )
-
+      IF( ierr /= 0 )   CALL ctl_stop( 'angle: unable to allocate arrays' )
+      !
       ! ============================= !
       ! Compute the cosinus and sinus !
       ! ============================= !
       ! (computation done on the north stereographic polar plane)
-
+      !
       DO jj = 2, jpjm1
-!CDIR NOVERRCHK
          DO ji = fs_2, jpi   ! vector opt.
-
-            ! north pole direction & modulous (at t-point)
-            zlam = glamt(ji,jj)
+            !                  
+            zlam = glamt(ji,jj)     ! north pole direction & modulous (at t-point)
             zphi = gphit(ji,jj)
             zxnpt = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
             zynpt = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
             znnpt = zxnpt*zxnpt + zynpt*zynpt
-
-            ! north pole direction & modulous (at u-point)
-            zlam = glamu(ji,jj)
+            !
+            zlam = glamu(ji,jj)     ! north pole direction & modulous (at u-point)
             zphi = gphiu(ji,jj)
             zxnpu = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
             zynpu = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
             znnpu = zxnpu*zxnpu + zynpu*zynpu
-
-            ! north pole direction & modulous (at v-point)
-            zlam = glamv(ji,jj)
+            !
+            zlam = glamv(ji,jj)     ! north pole direction & modulous (at v-point)
             zphi = gphiv(ji,jj)
             zxnpv = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
             zynpv = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
             znnpv = zxnpv*zxnpv + zynpv*zynpv
-
-            ! north pole direction & modulous (at f-point)
-            zlam = glamf(ji,jj)
+            !
+            zlam = glamf(ji,jj)     ! north pole direction & modulous (at f-point)
             zphi = gphif(ji,jj)
             zxnpf = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
             zynpf = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
             znnpf = zxnpf*zxnpf + zynpf*zynpf
-
-            ! j-direction: v-point segment direction (around t-point)
-            zlam = glamv(ji,jj  )
+            !
+            zlam = glamv(ji,jj  )   ! j-direction: v-point segment direction (around t-point)
             zphi = gphiv(ji,jj  )
             zlan = glamv(ji,jj-1)
@@ -237,7 +194,6 @@
             znvvt = SQRT( znnpt * ( zxvvt*zxvvt + zyvvt*zyvvt )  )
             znvvt = MAX( znvvt, 1.e-14 )
-
-            ! j-direction: f-point segment direction (around u-point)
-            zlam = glamf(ji,jj  )
+            !
+            zlam = glamf(ji,jj  )   ! j-direction: f-point segment direction (around u-point)
             zphi = gphif(ji,jj  )
             zlan = glamf(ji,jj-1)
@@ -249,7 +205,6 @@
             znffu = SQRT( znnpu * ( zxffu*zxffu + zyffu*zyffu )  )
             znffu = MAX( znffu, 1.e-14 )
-
-            ! i-direction: f-point segment direction (around v-point)
-            zlam = glamf(ji  ,jj)
+            !
+            zlam = glamf(ji  ,jj)   ! i-direction: f-point segment direction (around v-point)
             zphi = gphif(ji  ,jj)
             zlan = glamf(ji-1,jj)
@@ -261,7 +216,6 @@
             znffv = SQRT( znnpv * ( zxffv*zxffv + zyffv*zyffv )  )
             znffv = MAX( znffv, 1.e-14 )
-
-            ! j-direction: u-point segment direction (around f-point)
-            zlam = glamu(ji,jj+1)
+            !
+            zlam = glamu(ji,jj+1)   ! j-direction: u-point segment direction (around f-point)
             zphi = gphiu(ji,jj+1)
             zlan = glamu(ji,jj  )
@@ -273,19 +227,18 @@
             znuuf = SQRT( znnpf * ( zxuuf*zxuuf + zyuuf*zyuuf )  )
             znuuf = MAX( znuuf, 1.e-14 )
-
-            ! cosinus and sinus using scalar and vectorial products
+            !
+            !                       ! cosinus and sinus using dot and cross products
             gsint(ji,jj) = ( zxnpt*zyvvt - zynpt*zxvvt ) / znvvt
             gcost(ji,jj) = ( zxnpt*zxvvt + zynpt*zyvvt ) / znvvt
-
+            !
             gsinu(ji,jj) = ( zxnpu*zyffu - zynpu*zxffu ) / znffu
             gcosu(ji,jj) = ( zxnpu*zxffu + zynpu*zyffu ) / znffu
-
+            !
             gsinf(ji,jj) = ( zxnpf*zyuuf - zynpf*zxuuf ) / znuuf
             gcosf(ji,jj) = ( zxnpf*zxuuf + zynpf*zyuuf ) / znuuf
-
-            ! (caution, rotation of 90 degres)
+            !
             gsinv(ji,jj) = ( zxnpv*zxffv + zynpv*zyffv ) / znffv
-            gcosv(ji,jj) =-( zxnpv*zyffv - zynpv*zxffv ) / znffv
-
+            gcosv(ji,jj) =-( zxnpv*zyffv - zynpv*zxffv ) / znffv     ! (caution, rotation of 90 degres)
+            !
          END DO
       END DO
@@ -319,16 +272,14 @@
       ! Lateral boundary conditions !
       ! =========================== !
-
-      ! lateral boundary cond.: T-, U-, V-, F-pts, sgn
+      !           ! lateral boundary cond.: T-, U-, V-, F-pts, sgn
       CALL lbc_lnk( gcost, 'T', -1. )   ;   CALL lbc_lnk( gsint, 'T', -1. )
       CALL lbc_lnk( gcosu, 'U', -1. )   ;   CALL lbc_lnk( gsinu, 'U', -1. )
       CALL lbc_lnk( gcosv, 'V', -1. )   ;   CALL lbc_lnk( gsinv, 'V', -1. )
       CALL lbc_lnk( gcosf, 'F', -1. )   ;   CALL lbc_lnk( gsinf, 'F', -1. )
-
+      !
    END SUBROUTINE angle
 
 
-   SUBROUTINE geo2oce ( pxx, pyy, pzz, cgrid,     &
-                        pte, ptn )
+   SUBROUTINE geo2oce ( pxx, pyy, pzz, cgrid, pte, ptn )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE geo2oce  ***
@@ -336,19 +287,11 @@
       !! ** Purpose :
       !!
-      !! ** Method  :   Change wind stress from geocentric to east/north
-      !!
-      !! History :
-      !!        !         (O. Marti)  Original code
-      !!        !  91-03  (G. Madec)
-      !!        !  92-07  (M. Imbard)
-      !!        !  99-11  (M. Imbard) NetCDF format with IOIPSL
-      !!        !  00-08  (D. Ludicone) Reduced section at Bab el Mandeb
-      !!   8.5  !  02-06  (G. Madec)  F90: Free form
-      !!   3.0  !  07-08  (G. Madec)  geo2oce suppress lon/lat agruments
+      !! ** Method  :   Change a vector from geocentric to east/north 
+      !!
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::  pxx, pyy, pzz
       CHARACTER(len=1)            , INTENT(in   ) ::  cgrid
       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::  pte, ptn
-      !!
+      !
       REAL(wp), PARAMETER :: rpi = 3.141592653e0
       REAL(wp), PARAMETER :: rad = rpi / 180.e0
@@ -356,5 +299,5 @@
       INTEGER ::   ierr   ! local integer
       !!----------------------------------------------------------------------
-
+      !
       IF( .NOT. ALLOCATED( gsinlon ) ) THEN
          ALLOCATE( gsinlon(jpi,jpj,4) , gcoslon(jpi,jpj,4) ,   &
@@ -362,4 +305,81 @@
          IF( lk_mpp    )   CALL mpp_sum( ierr )
          IF( ierr /= 0 )   CALL ctl_stop('geo2oce: unable to allocate arrays' )
+      ENDIF
+      !
+      SELECT CASE( cgrid)
+      CASE ( 'T' )   
+         ig = 1
+         IF( .NOT. linit(ig) ) THEN 
+            gsinlon(:,:,ig) = SIN( rad * glamt(:,:) )
+            gcoslon(:,:,ig) = COS( rad * glamt(:,:) )
+            gsinlat(:,:,ig) = SIN( rad * gphit(:,:) )
+            gcoslat(:,:,ig) = COS( rad * gphit(:,:) )
+            linit(ig) = .TRUE.
+         ENDIF
+      CASE ( 'U' )   
+         ig = 2
+         IF( .NOT. linit(ig) ) THEN 
+            gsinlon(:,:,ig) = SIN( rad * glamu(:,:) )
+            gcoslon(:,:,ig) = COS( rad * glamu(:,:) )
+            gsinlat(:,:,ig) = SIN( rad * gphiu(:,:) )
+            gcoslat(:,:,ig) = COS( rad * gphiu(:,:) )
+            linit(ig) = .TRUE.
+         ENDIF
+      CASE ( 'V' )   
+         ig = 3
+         IF( .NOT. linit(ig) ) THEN 
+            gsinlon(:,:,ig) = SIN( rad * glamv(:,:) )
+            gcoslon(:,:,ig) = COS( rad * glamv(:,:) )
+            gsinlat(:,:,ig) = SIN( rad * gphiv(:,:) )
+            gcoslat(:,:,ig) = COS( rad * gphiv(:,:) )
+            linit(ig) = .TRUE.
+         ENDIF
+      CASE ( 'F' )   
+         ig = 4
+         IF( .NOT. linit(ig) ) THEN 
+            gsinlon(:,:,ig) = SIN( rad * glamf(:,:) )
+            gcoslon(:,:,ig) = COS( rad * glamf(:,:) )
+            gsinlat(:,:,ig) = SIN( rad * gphif(:,:) )
+            gcoslat(:,:,ig) = COS( rad * gphif(:,:) )
+            linit(ig) = .TRUE.
+         ENDIF
+      CASE default   
+         WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid
+         CALL ctl_stop( ctmp1 )
+      END SELECT
+      !
+      pte = - gsinlon(:,:,ig) * pxx + gcoslon(:,:,ig) * pyy
+      ptn = - gcoslon(:,:,ig) * gsinlat(:,:,ig) * pxx    &
+         &  - gsinlon(:,:,ig) * gsinlat(:,:,ig) * pyy    &
+         &  + gcoslat(:,:,ig) * pzz
+      !
+   END SUBROUTINE geo2oce
+
+
+   SUBROUTINE oce2geo ( pte, ptn, cgrid, pxx , pyy , pzz )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE oce2geo  ***
+      !!      
+      !! ** Purpose :
+      !!
+      !! ** Method  :   Change vector from east/north to geocentric
+      !!
+      !! History :     ! (A. Caubel)  oce2geo - Original code
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    ) ::  pte, ptn
+      CHARACTER(len=1)            , INTENT( IN    ) ::  cgrid
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(   OUT ) ::  pxx , pyy , pzz
+      !!
+      REAL(wp), PARAMETER :: rpi = 3.141592653E0
+      REAL(wp), PARAMETER :: rad = rpi / 180.e0
+      INTEGER ::   ig     !
+      INTEGER ::   ierr   ! local integer
+      !!----------------------------------------------------------------------
+
+      IF( .NOT. ALLOCATED( gsinlon ) ) THEN
+         ALLOCATE( gsinlon(jpi,jpj,4) , gcoslon(jpi,jpj,4) ,   &
+            &      gsinlat(jpi,jpj,4) , gcoslat(jpi,jpj,4) , STAT=ierr )
+         IF( lk_mpp    )   CALL mpp_sum( ierr )
+         IF( ierr /= 0 )   CALL ctl_stop('oce2geo: unable to allocate arrays' )
       ENDIF
 
@@ -405,139 +425,13 @@
             CALL ctl_stop( ctmp1 )
       END SELECT
-      
-      pte = - gsinlon(:,:,ig) * pxx + gcoslon(:,:,ig) * pyy
-      ptn = - gcoslon(:,:,ig) * gsinlat(:,:,ig) * pxx    &
-            - gsinlon(:,:,ig) * gsinlat(:,:,ig) * pyy    &
-            + gcoslat(:,:,ig) * pzz
-!!$   ptv =   gcoslon(:,:,ig) * gcoslat(:,:,ig) * pxx    &
-!!$         + gsinlon(:,:,ig) * gcoslat(:,:,ig) * pyy    &
-!!$         + gsinlat(:,:,ig) * pzz
-      !
-   END SUBROUTINE geo2oce
-
-   SUBROUTINE oce2geo ( pte, ptn, cgrid,     &
-                        pxx , pyy , pzz )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE oce2geo  ***
-      !!      
-      !! ** Purpose :
-      !!
-      !! ** Method  :   Change vector from east/north to geocentric
-      !!
-      !! History :
-      !!        !         (A. Caubel)  oce2geo - Original code
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    ) ::  pte, ptn
-      CHARACTER(len=1)            , INTENT( IN    ) ::  cgrid
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(   OUT ) ::  pxx , pyy , pzz
-      !!
-      REAL(wp), PARAMETER :: rpi = 3.141592653E0
-      REAL(wp), PARAMETER :: rad = rpi / 180.e0
-      INTEGER ::   ig     !
-      INTEGER ::   ierr   ! local integer
-      !!----------------------------------------------------------------------
-
-      IF( .NOT. ALLOCATED( gsinlon ) ) THEN
-         ALLOCATE( gsinlon(jpi,jpj,4) , gcoslon(jpi,jpj,4) ,   &
-            &      gsinlat(jpi,jpj,4) , gcoslat(jpi,jpj,4) , STAT=ierr )
-         IF( lk_mpp    )   CALL mpp_sum( ierr )
-         IF( ierr /= 0 )   CALL ctl_stop('oce2geo: unable to allocate arrays' )
-      ENDIF
-
-      SELECT CASE( cgrid)
-         CASE ( 'T' )   
-            ig = 1
-            IF( .NOT. linit(ig) ) THEN 
-               gsinlon(:,:,ig) = SIN( rad * glamt(:,:) )
-               gcoslon(:,:,ig) = COS( rad * glamt(:,:) )
-               gsinlat(:,:,ig) = SIN( rad * gphit(:,:) )
-               gcoslat(:,:,ig) = COS( rad * gphit(:,:) )
-               linit(ig) = .TRUE.
-            ENDIF
-         CASE ( 'U' )   
-            ig = 2
-            IF( .NOT. linit(ig) ) THEN 
-               gsinlon(:,:,ig) = SIN( rad * glamu(:,:) )
-               gcoslon(:,:,ig) = COS( rad * glamu(:,:) )
-               gsinlat(:,:,ig) = SIN( rad * gphiu(:,:) )
-               gcoslat(:,:,ig) = COS( rad * gphiu(:,:) )
-               linit(ig) = .TRUE.
-            ENDIF
-         CASE ( 'V' )   
-            ig = 3
-            IF( .NOT. linit(ig) ) THEN 
-               gsinlon(:,:,ig) = SIN( rad * glamv(:,:) )
-               gcoslon(:,:,ig) = COS( rad * glamv(:,:) )
-               gsinlat(:,:,ig) = SIN( rad * gphiv(:,:) )
-               gcoslat(:,:,ig) = COS( rad * gphiv(:,:) )
-               linit(ig) = .TRUE.
-            ENDIF
-         CASE ( 'F' )   
-            ig = 4
-            IF( .NOT. linit(ig) ) THEN 
-               gsinlon(:,:,ig) = SIN( rad * glamf(:,:) )
-               gcoslon(:,:,ig) = COS( rad * glamf(:,:) )
-               gsinlat(:,:,ig) = SIN( rad * gphif(:,:) )
-               gcoslat(:,:,ig) = COS( rad * gphif(:,:) )
-               linit(ig) = .TRUE.
-            ENDIF
-         CASE default   
-            WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid
-            CALL ctl_stop( ctmp1 )
-      END SELECT
-
-       pxx = - gsinlon(:,:,ig) * pte - gcoslon(:,:,ig) * gsinlat(:,:,ig) * ptn 
-       pyy =   gcoslon(:,:,ig) * pte - gsinlon(:,:,ig) * gsinlat(:,:,ig) * ptn
-       pzz =   gcoslat(:,:,ig) * ptn
-
-      
+      !
+      pxx = - gsinlon(:,:,ig) * pte - gcoslon(:,:,ig) * gsinlat(:,:,ig) * ptn 
+      pyy =   gcoslon(:,:,ig) * pte - gsinlon(:,:,ig) * gsinlat(:,:,ig) * ptn
+      pzz =   gcoslat(:,:,ig) * ptn
+      !
    END SUBROUTINE oce2geo
 
 
-   SUBROUTINE repere ( px1, py1, px2, py2, kchoix, cd_type )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE repere  ***
-      !!        
-      !! ** Purpose :   Change vector componantes between a geopgraphic grid 
-      !!      and a stretched coordinates grid.
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :
-      !!
-      !! History :
-      !!        !  89-03  (O. Marti)  original code
-      !!        !  92-02  (M. Imbard)
-      !!        !  93-03  (M. Guyon)  symetrical conditions
-      !!        !  98-05  (B. Blanke)
-      !!   8.5  !  02-08  (G. Madec)  F90: Free form
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   px1, py1   ! two horizontal components to be rotated
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   px2, py2   ! the two horizontal components in the model repere
-      INTEGER , INTENT(in   )                     ::   kchoix     ! type of transformation
-      !                                                           ! = 1 change from geographic to model grid.
-      !                                                           ! =-1 change from model to geographic grid
-      CHARACTER(len=1), INTENT(in   ), OPTIONAL   ::   cd_type    ! define the nature of pt2d array grid-points
-      !
-      CHARACTER(len=1) ::   cl_type      ! define the nature of pt2d array grid-points (T point by default)
-      !!----------------------------------------------------------------------
-
-      cl_type = 'T'
-      IF( PRESENT(cd_type) )   cl_type = cd_type
-         !
-      SELECT CASE (kchoix)
-      CASE ( 1)      ! change from geographic to model grid.
-         CALL rot_rep( px1, py1, cl_type, 'en->i', px2 )
-         CALL rot_rep( px1, py1, cl_type, 'en->j', py2 )
-      CASE (-1)      ! change from model to geographic grid
-         CALL rot_rep( px1, py1, cl_type, 'ij->e', px2 )
-         CALL rot_rep( px1, py1, cl_type, 'ij->n', py2 )
-      CASE DEFAULT   ;   CALL ctl_stop( 'repere: Syntax Error in the definition of kchoix (1 OR -1' )
-      END SELECT
-      
-   END SUBROUTINE repere
-
-
-   SUBROUTINE obs_rot ( psinu, pcosu, psinv, pcosv )
+   SUBROUTINE obs_rot( psinu, pcosu, psinv, pcosv )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE obs_rot  ***
@@ -547,28 +441,24 @@
       !!                current at observation points
       !!
-      !! History :
-      !!   9.2  !  09-02  (K. Mogensen)
+      !! History :  9.2  !  09-02  (K. Mogensen)
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT )::   psinu, pcosu, psinv, pcosv   ! copy of data
       !!----------------------------------------------------------------------
-
+      !
       ! Initialization of gsin* and gcos* at first call
       ! -----------------------------------------------
-
       IF( lmust_init ) THEN
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) ' obs_rot : geographic <--> stretched'
          IF(lwp) WRITE(numout,*) ' ~~~~~~~   coordinate transformation'
-
          CALL angle       ! initialization of the transformation
          lmust_init = .FALSE.
-
       ENDIF
-
+      !
       psinu(:,:) = gsinu(:,:)
       pcosu(:,:) = gcosu(:,:)
       psinv(:,:) = gsinv(:,:)
       pcosv(:,:) = gcosv(:,:)
-
+      !
    END SUBROUTINE obs_rot
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 6808)
@@ -44,8 +44,8 @@
    LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr)
    LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths
+   LOGICAL , PUBLIC ::   ln_isf         !: ice shelf melting
    LOGICAL , PUBLIC ::   ln_ssr         !: Sea Surface restoring on SST and/or SSS      
    LOGICAL , PUBLIC ::   ln_apr_dyn     !: Atmospheric pressure forcing used on dynamics (ocean & ice)
    INTEGER , PUBLIC ::   nn_ice         !: flag for ice in the surface boundary condition (=0/1/2/3)
-   INTEGER , PUBLIC ::   nn_isf         !: flag for isf in the surface boundary condition (=0/1/2/3/4) 
    INTEGER , PUBLIC ::   nn_ice_embd    !: flag for levitating/embedding sea-ice in the ocean
    !                                             !: =0 levitating ice (no mass exchange, concentration/dilution effect)
@@ -80,5 +80,4 @@
    INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk                     formulation
    INTEGER , PUBLIC, PARAMETER ::   jp_none    = 7        !: for OPA when doing coupling via SAS module
-   INTEGER , PUBLIC, PARAMETER ::   jp_esopa   = -1       !: esopa test, ALL formulations
    
    !!----------------------------------------------------------------------
@@ -173,7 +172,5 @@
          &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) )
          !
-#if defined key_vvl
       ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) )
-#endif
          !
       sbc_oce_alloc = MAXVAL( ierr )
@@ -200,7 +197,5 @@
       !!---------------------------------------------------------------------
       zcoef = 0.5 / ( zrhoa * zcdrag ) 
-!CDIR NOVERRCHK
       DO jj = 2, jpjm1
-!CDIR NOVERRCHK
          DO ji = fs_2, fs_jpim1   ! vect. opt.
             ztx = utau(ji-1,jj  ) + utau(ji,jj) 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90	(revision 6808)
@@ -37,5 +37,4 @@
    
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -279,7 +278,5 @@
       ! module of wind stress and wind speed at T-point
       zcoef = 1. / ( zrhoa * zcdrag ) 
-!CDIR NOVERRCHK
       DO jj = 2, jpjm1
-!CDIR NOVERRCHK
          DO ji = fs_2, fs_jpim1   ! vect. opt.
             ztx = utau(ji-1,jj  ) + utau(ji,jj) 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 6808)
@@ -12,6 +12,6 @@
    USE dom_oce         ! ocean space and time domain
    USE sbc_oce         ! surface boundary condition
-   USE dynspg_oce      ! surface pressure gradient variables
    USE phycst          ! physical constants
+   !
    USE fldread         ! read input fields
    USE in_out_manager  ! I/O manager
@@ -39,6 +39,4 @@
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read)
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
@@ -62,5 +60,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in)::   kt   ! ocean time step
-      !!
+      !
       INTEGER            ::   ierror  ! local integer 
       INTEGER            ::   ios     ! Local integer output status for namelist read
@@ -71,5 +69,4 @@
       NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc
       !!----------------------------------------------------------------------
-      !
       !
       !                                         ! -------------------- !
@@ -113,7 +110,6 @@
             IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data'
          ENDIF
-         IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts )   &
-            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' )
-         IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn   )   &
+!jc: stop below should rather be a warning 
+         IF( ln_apr_obc .AND. .NOT.ln_apr_dyn   )   &
             CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' )
       ENDIF
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 6808)
@@ -243,7 +243,5 @@
       !   momentum fluxes  (utau, vtau )   !
       !------------------------------------!
-!CDIR COLLAPSE
       utau(:,:) = sf(jp_utau)%fnow(:,:,1)
-!CDIR COLLAPSE
       vtau(:,:) = sf(jp_vtau)%fnow(:,:,1)
 
@@ -251,7 +249,5 @@
       !   wind stress module (taum )       !
       !------------------------------------!
-!CDIR NOVERRCHK
       DO jj = 2, jpjm1
-!CDIR NOVERRCHK
          DO ji = fs_2, fs_jpim1   ! vector opt.
             ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
@@ -268,5 +264,4 @@
       !   store the wind speed  (wndm )    !
       !------------------------------------!
-!CDIR COLLAPSE
       wndm(:,:) = sf(jp_wndm)%fnow(:,:,1)
       wndm(:,:) = wndm(:,:) * tmask(:,:,1)
@@ -281,8 +276,5 @@
       !   Other ocean fluxes   !
       !------------------------!
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             !
@@ -375,9 +367,7 @@
       zcprec = rcp /  rday     ! convert prec ( mm/day ==> m/s)  ==> W/m2
 
-!CDIR COLLAPSE
       emp(:,:) = zqla(:,:) / cevap                                        &   ! freshwater flux
          &     - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1)
       !
-!CDIR COLLAPSE
       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                        &   ! Downward Non Solar flux
          &     - zqla(:,:)             * pst(:,:) * zcevap                &   ! remove evap.   heat content at SST in Celcius
@@ -415,4 +405,5 @@
 
 # if defined key_lim2 || defined key_lim3
+
    SUBROUTINE blk_ice_clio_tau
       !!---------------------------------------------------------------------------
@@ -429,15 +420,15 @@
       !
       IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_tau')
-
+      !
       SELECT CASE( cp_ice_msh )
-
+      !
       CASE( 'C' )                          ! C-grid ice dynamics
-
+         !
          zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress
          utau_ice(:,:) = zcoef * utau(:,:)
          vtau_ice(:,:) = zcoef * vtau(:,:)
-
+         !
       CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner)
-
+         !
          zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress
          DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point
@@ -447,19 +438,21 @@
             END DO
          END DO
-
+         !
          CALL lbc_lnk( utau_ice(:,:), 'I', -1. )   ;   CALL lbc_lnk( vtau_ice(:,:), 'I', -1. )   ! I-point
-
+         !
       END SELECT
-
+      !
       IF(ln_ctl) THEN
          CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ')
       ENDIF
-
+      !
       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio_tau')
-
+      !
    END SUBROUTINE blk_ice_clio_tau
+   
 #endif
 
 # if defined key_lim2 || defined key_lim3
+
    SUBROUTINE blk_ice_clio_flx(  ptsu , palb_cs, palb_os, palb )
       !!---------------------------------------------------------------------------
@@ -520,8 +513,5 @@
       !--------------------------------------------------------------------------------
 
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1)                ! air temperature in Kelvins 
@@ -573,10 +563,7 @@
 
       !                                     ! ========================== !
-      DO jl = 1, jpl                       !  Loop over ice categories  !
+      DO jl = 1, jpl                        !  Loop over ice categories  !
          !                                  ! ========================== !
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
          DO jj = 1 , jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                !-------------------------------------------!
@@ -636,7 +623,5 @@
       ! ----------------------------------------------------------------------------- !
       !
-!CDIR COLLAPSE
       qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:)      ! Downward Non Solar flux
-!CDIR COLLAPSE
       tprecip(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s]
       !
@@ -644,5 +629,4 @@
       !    Correct the OCEAN non solar flux with the existence of solid precipitation !
       ! ---------------=====--------------------------------------------------------- !
-!CDIR COLLAPSE
       qns(:,:) = qns(:,:)                                                           &   ! update the non-solar heat flux with:
          &     - sprecip(:,:) * lfus                                                  &   ! remove melting solid precip
@@ -782,8 +766,5 @@
       ! Saturated water vapour and vapour pressure
       ! ------------------------------------------
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt
@@ -814,7 +795,5 @@
       zdaycor  = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist )
 
-!CDIR NOVERRCHK
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             !  product of sine (cosine) of latitude and sine (cosine) of solar declination
@@ -837,11 +816,7 @@
 
       ! compute and sum ocean qsr over the daylight (i.e. between sunrise and sunset)
-!CDIR NOVERRCHK   
       DO jt = 1, jp24
          zcoef = FLOAT( jt ) - 0.5
-!CDIR NOVERRCHK     
-!CDIR COLLAPSE
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                zlha = COS(  zlsrise(ji,jj) - zcoef * zdlha(ji,jj)  )                  ! local hour angle
@@ -862,5 +837,4 @@
       ! Taking into account the ellipsity of the earth orbit, the clouds AND masked if sea-ice cover > 0%
       zcoef1 = srgamma * zdaycor / ( 2. * rpi )
-!CDIR COLLAPSE
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -920,8 +894,5 @@
       ! Saturated water vapour and vapour pressure
       ! ------------------------------------------
-!CDIR NOVERRCHK
-!CDIR COLLAPSE
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi           
             ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt           
@@ -952,7 +923,5 @@
       zdaycor  = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist )
 
-!CDIR NOVERRCHK
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             !  product of sine (cosine) of latitude and sine (cosine) of solar declination
@@ -979,11 +948,7 @@
       DO jl = 1, ijpl      !  loop over ice categories  !
          !                 !----------------------------! 
-!CDIR NOVERRCHK   
          DO jt = 1, jp24   
             zcoef = FLOAT( jt ) - 0.5
-!CDIR NOVERRCHK     
-!CDIR COLLAPSE
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   zlha = COS(  zlsrise(ji,jj) - zcoef * zdlha(ji,jj)  )                  ! local hour angle
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 6808)
@@ -19,36 +19,37 @@
 
    !!----------------------------------------------------------------------
-   !!   sbc_blk_core    : bulk formulation as ocean surface boundary condition (forced mode, CORE bulk formulea)
-   !!   blk_oce_core    : computes momentum, heat and freshwater fluxes over ocean
-   !!   blk_ice_core    : computes momentum, heat and freshwater fluxes over ice
-   !!   turb_core_2z    : Computes turbulent transfert coefficients
-   !!   cd_neutral_10m  : Estimate of the neutral drag coefficient at 10m
-   !!   psi_m           : universal profile stability function for momentum
-   !!   psi_h           : universal profile stability function for temperature and humidity
+   !!   sbc_blk_core  : bulk formulation as ocean surface boundary condition (forced mode, CORE bulk formulea)
+   !!   blk_oce_core  : computes momentum, heat and freshwater fluxes over ocean
+   !!   blk_ice_core  : computes momentum, heat and freshwater fluxes over ice
+   !!   turb_core_2z  : Computes turbulent transfert coefficients
+   !!   cd_neutral_10m: Estimate of the neutral drag coefficient at 10m
+   !!   psi_m         : universal profile stability function for momentum
+   !!   psi_h         : universal profile stability function for temperature and humidity
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE fldread         ! read input fields
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE cyclone         ! Cyclone 10m wind form trac of cyclone centres
-   USE sbcdcy          ! surface boundary condition: diurnal cycle
-   USE iom             ! I/O manager library
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distribued memory computing library
-   USE wrk_nemo        ! work arrays
-   USE timing          ! Timing
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE sbcwave, ONLY   :  cdn_wave ! wave module
-   USE sbc_ice         ! Surface boundary condition: ice fields
-   USE lib_fortran     ! to use key_nosignedzero
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE fldread        ! read input fields
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE cyclone        ! Cyclone 10m wind form trac of cyclone centres
+   USE sbcdcy         ! surface boundary condition: diurnal cycle
+   USE sbcwave , ONLY :   cdn_wave ! wave module
+   USE sbc_ice        ! Surface boundary condition: ice fields
+   USE lib_fortran    ! to use key_nosignedzero
 #if defined key_lim3
-   USE ice, ONLY       : u_ice, v_ice, jpl, pfrld, a_i_b
-   USE limthd_dh       ! for CALL lim_thd_snwblow
+   USE ice     , ONLY :   u_ice, v_ice, jpl, pfrld, a_i_b
+   USE limthd_dh      ! for CALL lim_thd_snwblow
 #elif defined key_lim2
-   USE ice_2, ONLY     : u_ice, v_ice
-   USE par_ice_2
+   USE ice_2   , ONLY :   u_ice, v_ice
+   USE par_ice_2      ! LIM-2 parameters
 #endif
+   !
+   USE iom            ! I/O manager library
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl         ! Print control
 
    IMPLICIT NONE
@@ -84,5 +85,5 @@
    REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be constant
 
-   !                                  !!* Namelist namsbc_core : CORE bulk parameters
+   !                        !!* Namelist namsbc_core : CORE bulk parameters
    LOGICAL  ::   ln_taudif   ! logical flag to use the "mean of stress module - module of mean stress" data
    REAL(wp) ::   rn_pfac     ! multiplication factor for precipitation
@@ -93,5 +94,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -149,7 +149,7 @@
       TYPE(FLD_N) ::   sn_tdif                                 !   "                                 "
       NAMELIST/namsbc_core/ cn_dir , ln_taudif, rn_pfac, rn_efac, rn_vfac,  &
-         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           &
-         &                  sn_qlw , sn_tair, sn_prec  , sn_snow,           &
-         &                  sn_tdif, rn_zqt,  rn_zu
+         &                  sn_wndi, sn_wndj  , sn_humi, sn_qsr ,           &
+         &                  sn_qlw , sn_tair  , sn_prec, sn_snow,           &
+         &                  sn_tdif, rn_zqt   ,  rn_zu
       !!---------------------------------------------------------------------
       !
@@ -403,4 +403,8 @@
          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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90	(revision 6808)
@@ -8,21 +8,22 @@
 
    !!----------------------------------------------------------------------
-   !!   sbc_blk_mfs  : bulk formulation as ocean surface boundary condition
+   !!   sbc_blk_mfs   : bulk formulation as ocean surface boundary condition
    !!                   (forced mode, mfs bulk formulae)
-   !!   blk_oce_mfs  : ocean: computes momentum, heat and freshwater fluxes
+   !!   blk_oce_mfs   : ocean: computes momentum, heat and freshwater fluxes
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE fldread         ! read input fields
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE iom             ! I/O manager library
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distribued memory computing library
-   USE wrk_nemo        ! work arrays
-   USE timing          ! Timing
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE sbcwave,ONLY : cdn_wave !wave module
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE fldread        ! read input fields
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbcwave  ,ONLY :   cdn_wave !wave module
+   !
+   USE iom            ! I/O manager library
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl         ! Print control
 
    IMPLICIT NONE
@@ -42,5 +43,4 @@
          
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -49,7 +49,5 @@
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
-
 
    SUBROUTINE sbc_blk_mfs( kt )
@@ -251,7 +249,5 @@
          ! for basin budget and cooerence
          !--------------------------------------------------
-!CDIR COLLAPSE
-           emp (:,:) = evap(:,:) - sf(jp_prec)%fnow(:,:,1) * tmask(:,:,1)
-!CDIR COLLAPSE
+         emp(:,:) = evap(:,:) - sf(jp_prec)%fnow(:,:,1) * tmask(:,:,1)
 
          CALL iom_put( "qlw_oce",   qbw  )                 ! output downward longwave heat over the ocean
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 6808)
@@ -18,29 +18,23 @@
    !!   sbc_cpl_snd     : send     fields to the atmosphere
    !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: ice fields
-   USE sbcapr
-   USE sbcdcy          ! surface boundary condition: diurnal cycle
-   USE phycst          ! physical constants
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbc_ice        ! Surface boundary condition: ice fields
+   USE sbcapr         ! Stochastic param. : ???
+   USE sbcdcy         ! surface boundary condition: diurnal cycle
+   USE phycst         ! physical constants
 #if defined key_lim3
-   USE ice             ! ice variables
+   USE ice            ! ice variables
 #endif
 #if defined key_lim2
-   USE par_ice_2       ! ice parameters
-   USE ice_2           ! ice variables
+   USE par_ice_2      ! ice parameters
+   USE ice_2          ! ice variables
 #endif
-   USE cpl_oasis3      ! OASIS3 coupling
-   USE geo2ocean       ! 
+   USE cpl_oasis3     ! OASIS3 coupling
+   USE geo2ocean      ! 
    USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
-   USE albedo          !
-   USE in_out_manager  ! I/O manager
-   USE iom             ! NetCDF library
-   USE lib_mpp         ! distribued memory computing library
-   USE wrk_nemo        ! work arrays
-   USE timing          ! Timing
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE eosbn2
-   USE sbcrnf   , ONLY : l_rnfcpl
+   USE albedo         ! 
+   USE eosbn2         ! 
+   USE sbcrnf  , ONLY : l_rnfcpl
 #if defined key_cpl_carbon_cycle
    USE p4zflx, ONLY : oce_co2
@@ -50,127 +44,132 @@
 #endif
 #if defined key_lim3
-   USE limthd_dh       ! for CALL lim_thd_snwblow
+   USE limthd_dh      ! for CALL lim_thd_snwblow
 #endif
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! NetCDF library
+   USE lib_mpp        ! distribued memory computing library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   sbc_cpl_init       ! routine called by sbcmod.F90
-   PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90
-   PUBLIC   sbc_cpl_snd        ! routine called by step.F90
-   PUBLIC   sbc_cpl_ice_tau    ! routine called by sbc_ice_lim(_2).F90
-   PUBLIC   sbc_cpl_ice_flx    ! routine called by sbc_ice_lim(_2).F90
-   PUBLIC   sbc_cpl_alloc      ! routine called in sbcice_cice.F90
-
-   INTEGER, PARAMETER ::   jpr_otx1   =  1            ! 3 atmosphere-ocean stress components on grid 1
-   INTEGER, PARAMETER ::   jpr_oty1   =  2            ! 
-   INTEGER, PARAMETER ::   jpr_otz1   =  3            ! 
-   INTEGER, PARAMETER ::   jpr_otx2   =  4            ! 3 atmosphere-ocean stress components on grid 2
-   INTEGER, PARAMETER ::   jpr_oty2   =  5            ! 
-   INTEGER, PARAMETER ::   jpr_otz2   =  6            ! 
-   INTEGER, PARAMETER ::   jpr_itx1   =  7            ! 3 atmosphere-ice   stress components on grid 1
-   INTEGER, PARAMETER ::   jpr_ity1   =  8            ! 
-   INTEGER, PARAMETER ::   jpr_itz1   =  9            ! 
-   INTEGER, PARAMETER ::   jpr_itx2   = 10            ! 3 atmosphere-ice   stress components on grid 2
-   INTEGER, PARAMETER ::   jpr_ity2   = 11            ! 
-   INTEGER, PARAMETER ::   jpr_itz2   = 12            ! 
-   INTEGER, PARAMETER ::   jpr_qsroce = 13            ! Qsr above the ocean
-   INTEGER, PARAMETER ::   jpr_qsrice = 14            ! Qsr above the ice
+   PUBLIC   sbc_cpl_init      ! routine called by sbcmod.F90
+   PUBLIC   sbc_cpl_rcv       ! routine called by sbc_ice_lim(_2).F90
+   PUBLIC   sbc_cpl_snd       ! routine called by step.F90
+   PUBLIC   sbc_cpl_ice_tau   ! routine called by sbc_ice_lim(_2).F90
+   PUBLIC   sbc_cpl_ice_flx   ! routine called by sbc_ice_lim(_2).F90
+   PUBLIC   sbc_cpl_alloc     ! routine called in sbcice_cice.F90
+
+   INTEGER, PARAMETER ::   jpr_otx1   =  1   ! 3 atmosphere-ocean stress components on grid 1
+   INTEGER, PARAMETER ::   jpr_oty1   =  2   ! 
+   INTEGER, PARAMETER ::   jpr_otz1   =  3   ! 
+   INTEGER, PARAMETER ::   jpr_otx2   =  4   ! 3 atmosphere-ocean stress components on grid 2
+   INTEGER, PARAMETER ::   jpr_oty2   =  5   ! 
+   INTEGER, PARAMETER ::   jpr_otz2   =  6   ! 
+   INTEGER, PARAMETER ::   jpr_itx1   =  7   ! 3 atmosphere-ice   stress components on grid 1
+   INTEGER, PARAMETER ::   jpr_ity1   =  8   ! 
+   INTEGER, PARAMETER ::   jpr_itz1   =  9   ! 
+   INTEGER, PARAMETER ::   jpr_itx2   = 10   ! 3 atmosphere-ice   stress components on grid 2
+   INTEGER, PARAMETER ::   jpr_ity2   = 11   ! 
+   INTEGER, PARAMETER ::   jpr_itz2   = 12   ! 
+   INTEGER, PARAMETER ::   jpr_qsroce = 13   ! Qsr above the ocean
+   INTEGER, PARAMETER ::   jpr_qsrice = 14   ! Qsr above the ice
    INTEGER, PARAMETER ::   jpr_qsrmix = 15 
-   INTEGER, PARAMETER ::   jpr_qnsoce = 16            ! Qns above the ocean
-   INTEGER, PARAMETER ::   jpr_qnsice = 17            ! Qns above the ice
+   INTEGER, PARAMETER ::   jpr_qnsoce = 16   ! Qns above the ocean
+   INTEGER, PARAMETER ::   jpr_qnsice = 17   ! Qns above the ice
    INTEGER, PARAMETER ::   jpr_qnsmix = 18
-   INTEGER, PARAMETER ::   jpr_rain   = 19            ! total liquid precipitation (rain)
-   INTEGER, PARAMETER ::   jpr_snow   = 20            ! solid precipitation over the ocean (snow)
-   INTEGER, PARAMETER ::   jpr_tevp   = 21            ! total evaporation
-   INTEGER, PARAMETER ::   jpr_ievp   = 22            ! solid evaporation (sublimation)
-   INTEGER, PARAMETER ::   jpr_sbpr   = 23            ! sublimation - liquid precipitation - solid precipitation
-   INTEGER, PARAMETER ::   jpr_semp   = 24            ! solid freshwater budget (sublimation - snow)
-   INTEGER, PARAMETER ::   jpr_oemp   = 25            ! ocean freshwater budget (evap - precip)
-   INTEGER, PARAMETER ::   jpr_w10m   = 26            ! 10m wind
-   INTEGER, PARAMETER ::   jpr_dqnsdt = 27            ! d(Q non solar)/d(temperature)
-   INTEGER, PARAMETER ::   jpr_rnf    = 28            ! runoffs
-   INTEGER, PARAMETER ::   jpr_cal    = 29            ! calving
-   INTEGER, PARAMETER ::   jpr_taum   = 30            ! wind stress module
+   INTEGER, PARAMETER ::   jpr_rain   = 19   ! total liquid precipitation (rain)
+   INTEGER, PARAMETER ::   jpr_snow   = 20   ! solid precipitation over the ocean (snow)
+   INTEGER, PARAMETER ::   jpr_tevp   = 21   ! total evaporation
+   INTEGER, PARAMETER ::   jpr_ievp   = 22   ! solid evaporation (sublimation)
+   INTEGER, PARAMETER ::   jpr_sbpr   = 23   ! sublimation - liquid precipitation - solid precipitation
+   INTEGER, PARAMETER ::   jpr_semp   = 24   ! solid freshwater budget (sublimation - snow)
+   INTEGER, PARAMETER ::   jpr_oemp   = 25   ! ocean freshwater budget (evap - precip)
+   INTEGER, PARAMETER ::   jpr_w10m   = 26   ! 10m wind
+   INTEGER, PARAMETER ::   jpr_dqnsdt = 27   ! d(Q non solar)/d(temperature)
+   INTEGER, PARAMETER ::   jpr_rnf    = 28   ! runoffs
+   INTEGER, PARAMETER ::   jpr_cal    = 29   ! calving
+   INTEGER, PARAMETER ::   jpr_taum   = 30   ! wind stress module
    INTEGER, PARAMETER ::   jpr_co2    = 31
-   INTEGER, PARAMETER ::   jpr_topm   = 32            ! topmeltn
-   INTEGER, PARAMETER ::   jpr_botm   = 33            ! botmeltn
-   INTEGER, PARAMETER ::   jpr_sflx   = 34            ! salt flux
-   INTEGER, PARAMETER ::   jpr_toce   = 35            ! ocean temperature
-   INTEGER, PARAMETER ::   jpr_soce   = 36            ! ocean salinity
-   INTEGER, PARAMETER ::   jpr_ocx1   = 37            ! ocean current on grid 1
-   INTEGER, PARAMETER ::   jpr_ocy1   = 38            !
-   INTEGER, PARAMETER ::   jpr_ssh    = 39            ! sea surface height
-   INTEGER, PARAMETER ::   jpr_fice   = 40            ! ice fraction          
-   INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness 
-   INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level
-   INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received
-
-   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere
-   INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature
-   INTEGER, PARAMETER ::   jps_tice   =  3            ! ice   temperature
-   INTEGER, PARAMETER ::   jps_tmix   =  4            ! mixed temperature (ocean+ice)
-   INTEGER, PARAMETER ::   jps_albice =  5            ! ice   albedo
-   INTEGER, PARAMETER ::   jps_albmix =  6            ! mixed albedo
-   INTEGER, PARAMETER ::   jps_hice   =  7            ! ice  thickness
-   INTEGER, PARAMETER ::   jps_hsnw   =  8            ! snow thickness
-   INTEGER, PARAMETER ::   jps_ocx1   =  9            ! ocean current on grid 1
-   INTEGER, PARAMETER ::   jps_ocy1   = 10            !
-   INTEGER, PARAMETER ::   jps_ocz1   = 11            !
-   INTEGER, PARAMETER ::   jps_ivx1   = 12            ! ice   current on grid 1
-   INTEGER, PARAMETER ::   jps_ivy1   = 13            !
-   INTEGER, PARAMETER ::   jps_ivz1   = 14            !
+   INTEGER, PARAMETER ::   jpr_topm   = 32   ! topmeltn
+   INTEGER, PARAMETER ::   jpr_botm   = 33   ! botmeltn
+   INTEGER, PARAMETER ::   jpr_sflx   = 34   ! salt flux
+   INTEGER, PARAMETER ::   jpr_toce   = 35   ! ocean temperature
+   INTEGER, PARAMETER ::   jpr_soce   = 36   ! ocean salinity
+   INTEGER, PARAMETER ::   jpr_ocx1   = 37   ! ocean current on grid 1
+   INTEGER, PARAMETER ::   jpr_ocy1   = 38   !
+   INTEGER, PARAMETER ::   jpr_ssh    = 39   ! sea surface height
+   INTEGER, PARAMETER ::   jpr_fice   = 40   ! ice fraction          
+   INTEGER, PARAMETER ::   jpr_e3t1st = 41   ! first T level thickness 
+   INTEGER, PARAMETER ::   jpr_fraqsr = 42   ! fraction of solar net radiation absorbed in the first ocean level
+   INTEGER, PARAMETER ::   jprcv      = 42   ! total number of fields received
+
+   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere
+   INTEGER, PARAMETER ::   jps_toce   =  2   ! ocean temperature
+   INTEGER, PARAMETER ::   jps_tice   =  3   ! ice   temperature
+   INTEGER, PARAMETER ::   jps_tmix   =  4   ! mixed temperature (ocean+ice)
+   INTEGER, PARAMETER ::   jps_albice =  5   ! ice   albedo
+   INTEGER, PARAMETER ::   jps_albmix =  6   ! mixed albedo
+   INTEGER, PARAMETER ::   jps_hice   =  7   ! ice  thickness
+   INTEGER, PARAMETER ::   jps_hsnw   =  8   ! snow thickness
+   INTEGER, PARAMETER ::   jps_ocx1   =  9   ! ocean current on grid 1
+   INTEGER, PARAMETER ::   jps_ocy1   = 10   !
+   INTEGER, PARAMETER ::   jps_ocz1   = 11   !
+   INTEGER, PARAMETER ::   jps_ivx1   = 12   ! ice   current on grid 1
+   INTEGER, PARAMETER ::   jps_ivy1   = 13   !
+   INTEGER, PARAMETER ::   jps_ivz1   = 14   !
    INTEGER, PARAMETER ::   jps_co2    = 15
-   INTEGER, PARAMETER ::   jps_soce   = 16            ! ocean salinity
-   INTEGER, PARAMETER ::   jps_ssh    = 17            ! sea surface height
-   INTEGER, PARAMETER ::   jps_qsroce = 18            ! Qsr above the ocean
-   INTEGER, PARAMETER ::   jps_qnsoce = 19            ! Qns above the ocean
-   INTEGER, PARAMETER ::   jps_oemp   = 20            ! ocean freshwater budget (evap - precip)
-   INTEGER, PARAMETER ::   jps_sflx   = 21            ! salt flux
-   INTEGER, PARAMETER ::   jps_otx1   = 22            ! 2 atmosphere-ocean stress components on grid 1
-   INTEGER, PARAMETER ::   jps_oty1   = 23            ! 
-   INTEGER, PARAMETER ::   jps_rnf    = 24            ! runoffs
-   INTEGER, PARAMETER ::   jps_taum   = 25            ! wind stress module
-   INTEGER, PARAMETER ::   jps_fice2  = 26            ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling)
-   INTEGER, PARAMETER ::   jps_e3t1st = 27            ! first level depth (vvl)
-   INTEGER, PARAMETER ::   jps_fraqsr = 28            ! fraction of solar net radiation absorbed in the first ocean level
-   INTEGER, PARAMETER ::   jpsnd      = 28            ! total number of fields sended
-
-   !                                                         !!** namelist namsbc_cpl **
-   TYPE ::   FLD_C
-      CHARACTER(len = 32) ::   cldes                  ! desciption of the coupling strategy
-      CHARACTER(len = 32) ::   clcat                  ! multiple ice categories strategy
-      CHARACTER(len = 32) ::   clvref                 ! reference of vector ('spherical' or 'cartesian')
-      CHARACTER(len = 32) ::   clvor                  ! orientation of vector fields ('eastward-northward' or 'local grid')
-      CHARACTER(len = 32) ::   clvgrd                 ! grids on which is located the vector fields
+   INTEGER, PARAMETER ::   jps_soce   = 16   ! ocean salinity
+   INTEGER, PARAMETER ::   jps_ssh    = 17   ! sea surface height
+   INTEGER, PARAMETER ::   jps_qsroce = 18   ! Qsr above the ocean
+   INTEGER, PARAMETER ::   jps_qnsoce = 19   ! Qns above the ocean
+   INTEGER, PARAMETER ::   jps_oemp   = 20   ! ocean freshwater budget (evap - precip)
+   INTEGER, PARAMETER ::   jps_sflx   = 21   ! salt flux
+   INTEGER, PARAMETER ::   jps_otx1   = 22   ! 2 atmosphere-ocean stress components on grid 1
+   INTEGER, PARAMETER ::   jps_oty1   = 23   ! 
+   INTEGER, PARAMETER ::   jps_rnf    = 24   ! runoffs
+   INTEGER, PARAMETER ::   jps_taum   = 25   ! wind stress module
+   INTEGER, PARAMETER ::   jps_fice2  = 26   ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling)
+   INTEGER, PARAMETER ::   jps_e3t1st = 27   ! first level depth (vvl)
+   INTEGER, PARAMETER ::   jps_fraqsr = 28   ! fraction of solar net radiation absorbed in the first ocean level
+   INTEGER, PARAMETER ::   jpsnd      = 28   ! total number of fields sended
+
+   !                                  !!** namelist namsbc_cpl **
+   TYPE ::   FLD_C                     !   
+      CHARACTER(len = 32) ::   cldes      ! desciption of the coupling strategy
+      CHARACTER(len = 32) ::   clcat      ! multiple ice categories strategy
+      CHARACTER(len = 32) ::   clvref     ! reference of vector ('spherical' or 'cartesian')
+      CHARACTER(len = 32) ::   clvor      ! orientation of vector fields ('eastward-northward' or 'local grid')
+      CHARACTER(len = 32) ::   clvgrd     ! grids on which is located the vector fields
    END TYPE FLD_C
-   ! Send to the atmosphere                           !
+   !                                   ! Send to the atmosphere  
    TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2                        
-   ! Received from the atmosphere                     !
+   !                                   ! Received from the atmosphere
    TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf
    TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                        
-   ! Other namelist parameters                        !
-   INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
-   LOGICAL     ::   ln_usecplmask          !  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)
+   !                                   ! Other namelist parameters
+   INTEGER     ::   nn_cplmodel           ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
+   LOGICAL     ::   ln_usecplmask         !  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)
    TYPE ::   DYNARR     
       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3   
    END TYPE DYNARR
 
-   TYPE( DYNARR ), SAVE, DIMENSION(jprcv) ::   frcv                      ! all fields recieved from the atmosphere
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky)
-
-   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument
+   TYPE( DYNARR ), SAVE, DIMENSION(jprcv) ::   frcv                     ! all fields recieved from the atmosphere
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix    ! ocean albedo sent to atmosphere (mix clear/overcast sky)
+
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo          ! OASIS info argument
 
    !! Substitution
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
   
@@ -209,9 +208,8 @@
       !!              * initialise the OASIS coupler
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3)
-      !!
-      INTEGER ::   jn   ! dummy loop index
-      INTEGER ::   ios  ! Local integer output status for namelist read
-      INTEGER ::   inum 
+      INTEGER, INTENT(in) ::   k_ice   ! ice management in the sbc (=0/1/2/3)
+      !
+      INTEGER ::   jn          ! dummy loop index
+      INTEGER ::   ios, inum   ! Local integer
       REAL(wp), POINTER, DIMENSION(:,:) ::   zacs, zaos
       !!
@@ -222,21 +220,21 @@
       !!---------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_init')
-      !
-      CALL wrk_alloc( jpi,jpj, zacs, zaos )
+      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_init')
+      !
+      CALL wrk_alloc( jpi,jpj,   zacs, zaos )
 
       ! ================================ !
       !      Namelist informations       !
       ! ================================ !
-
+      !
       REWIND( numnam_ref )              ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling
       READ  ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp )
-
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp )
+      !
       REWIND( numnam_cfg )              ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling
       READ  ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namsbc_cpl )
-
+      !
       IF(lwp) THEN                        ! control print
          WRITE(numout,*)
@@ -374,5 +372,5 @@
          srcv(jpr_ity1)%clgrid = 'V'                  ! i.e. it is always at U- & V-points for i- & j-comp. resp.
       ENDIF
-       
+      !
       !                                                      ! ------------------------- !
       !                                                      !    freshwater budget      !   E-P
@@ -396,5 +394,5 @@
       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' )
       END SELECT
-
+      !
       !                                                      ! ------------------------- !
       !                                                      !     Runoffs & Calving     !   
@@ -410,5 +408,5 @@
       !
       srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE.
-
+      !
       !                                                      ! ------------------------- !
       !                                                      !    non solar radiation    !   Qns
@@ -535,5 +533,5 @@
          IF( .NOT. ln_cpl ) srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling
          srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE.
-         srcv( jpr_e3t1st )%laction = lk_vvl
+         srcv( jpr_e3t1st )%laction = .NOT.ln_linssh
          srcv(jpr_ocx1)%clgrid = 'U'        ! oce components given at U-point
          srcv(jpr_ocy1)%clgrid = 'V'        !           and           V-point
@@ -701,5 +699,5 @@
          ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
          ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE.
-         ssnd( jps_e3t1st )%laction = lk_vvl
+         ssnd( jps_e3t1st )%laction = .NOT.ln_linssh
          ! vector definition: not used but cleaner...
          ssnd(jps_ocx1)%clgrid  = 'U'        ! oce components given at U-point
@@ -785,7 +783,7 @@
       ncpl_qsr_freq = 86400 / ncpl_qsr_freq
 
-      CALL wrk_dealloc( jpi,jpj, zacs, zaos )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_init')
+      CALL wrk_dealloc( jpi,jpj,   zacs, zaos )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_init')
       !
    END SUBROUTINE sbc_cpl_init
@@ -837,12 +835,12 @@
       !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in)           ::   kt          ! ocean model time step index
-      INTEGER, INTENT(in)           ::   k_fsbc      ! frequency of sbc (-> ice model) computation 
-      INTEGER, INTENT(in)           ::   k_ice       ! ice management in the sbc (=0/1/2/3)
+      INTEGER, INTENT(in) ::   kt       ! ocean model time step index
+      INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation 
+      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3)
 
       !!
       LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module??
       INTEGER  ::   ji, jj, jn             ! dummy loop indices
-      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000)
+      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdt did not change since nit000)
       REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars     
       REAL(wp) ::   zcoef                  ! temporary scalar
@@ -853,7 +851,7 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv')
-      !
-      CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
+      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_rcv')
+      !
+      CALL wrk_alloc( jpi,jpj,   ztx, zty, zmsk, zemp, zqns, zqsr )
       !
       IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
@@ -862,5 +860,5 @@
       !                                                      ! Receive all the atmos. fields (including ice information)
       !                                                      ! ======================================================= !
-      isec = ( kt - nit000 ) * NINT( rdttra(1) )                ! date of exchanges
+      isec = ( kt - nit000 ) * NINT( rdt )                      ! date of exchanges
       DO jn = 1, jprcv                                          ! received fields sent by the atmosphere
          IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
@@ -931,7 +929,5 @@
          ! => need to be done only when otx1 was changed
          IF( llnewtx ) THEN
-!CDIR NOVERRCHK
             DO jj = 2, jpjm1
-!CDIR NOVERRCHK
                DO ji = fs_2, fs_jpim1   ! vect. opt.
                   zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
@@ -961,7 +957,5 @@
          IF( llnewtau ) THEN 
             zcoef = 1. / ( zrhoa * zcdrag ) 
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi 
                   frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
@@ -1029,4 +1023,5 @@
          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
@@ -1034,4 +1029,5 @@
          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
@@ -1108,10 +1104,9 @@
          IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
          !
-
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv')
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,   ztx, zty, zmsk, zemp, zqns, zqsr )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_rcv')
       !
    END SUBROUTINE sbc_cpl_rcv
@@ -1154,12 +1149,12 @@
       REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid)
       !!
-      INTEGER ::   ji, jj                          ! dummy loop indices
-      INTEGER ::   itx                             ! index of taux over ice
+      INTEGER ::   ji, jj   ! dummy loop indices
+      INTEGER ::   itx      ! index of taux over ice
       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty 
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_tau')
-      !
-      CALL wrk_alloc( jpi,jpj, ztx, zty )
+      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_ice_tau')
+      !
+      CALL wrk_alloc( jpi,jpj,   ztx, zty )
 
       IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1   
@@ -1169,5 +1164,4 @@
       ! do something only if we just received the stress from atmosphere
       IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN
-
          !                                                      ! ======================= !
          IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   !
@@ -1322,7 +1316,7 @@
       ENDIF
       !   
-      CALL wrk_dealloc( jpi,jpj, ztx, zty )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_tau')
+      CALL wrk_dealloc( jpi,jpj,   ztx, zty )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_ice_tau')
       !
    END SUBROUTINE sbc_cpl_ice_tau
@@ -1369,11 +1363,11 @@
       !!                   sprecip             solid precipitation over the ocean  
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:)             ::   p_frld  ! lead fraction            [0 to 1]
       ! optional arguments, used only in 'mixed oce-ice' case
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo 
-      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius]
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin]
-      !
-      INTEGER ::   jl         ! dummy loop index
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! all skies ice albedo 
+      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature  [Celsius]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature  [Kelvin]
+      !
+      INTEGER ::   jl   ! dummy loop index
       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk
       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot
@@ -1382,8 +1376,8 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx')
-      !
-      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
-      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )
+      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_ice_flx')
+      !
+      CALL wrk_alloc( jpi,jpj,       zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
+      CALL wrk_alloc( jpi,jpj,jpl,   zqns_ice, zqsr_ice, zdqns_ice )
 
       IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
@@ -1558,6 +1552,6 @@
       CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 
 #else
-
-      ! clem: this formulation is certainly wrong... but better than it was...
+      !
+      ! clem: this formulation is certainly wrong... but better than it was before...
       zqns_tot(:,:) = zqns_tot(:,:)                       &            ! zqns_tot update over free ocean with:
          &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting
@@ -1575,7 +1569,6 @@
          qns_ice(:,:,:) = zqns_ice(:,:,:)
       ENDIF
-
+      !
 #endif
-
       !                                                      ! ========================= !
       SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )                !      solar heat fluxes    !   (qsr)
@@ -1686,8 +1679,8 @@
       fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
 
-      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
-      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx')
+      CALL wrk_dealloc( jpi,jpj,       zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
+      CALL wrk_dealloc( jpi,jpj,jpl,   zqns_ice, zqsr_ice, zdqns_ice )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_ice_flx')
       !
    END SUBROUTINE sbc_cpl_ice_flx
@@ -1712,10 +1705,10 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_snd')
-      !
-      CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
-      CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 )
-
-      isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exchanges
+      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_snd')
+      !
+      CALL wrk_alloc( jpi,jpj,       zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
+      CALL wrk_alloc( jpi,jpj,jpl,   ztmp3, ztmp4 )
+
+      isec = ( kt - nit000 ) * NINT( rdt )        ! date of exchanges
 
       zfr_l(:,:) = 1.- fr_i(:,:)
@@ -1743,5 +1736,5 @@
                      ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
                   ELSEWHERE
-                     ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?)
+                     ztmp3(:,:,1) = rt0
                   END WHERE
                CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
@@ -1774,11 +1767,40 @@
       !                                                      ! ------------------------- !
       IF( ssnd(jps_albice)%laction ) THEN                         ! ice 
-         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' )
+          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' )
          END SELECT
-         CALL cpl_snd( jps_albice, isec, ztmp3, info )
-      ENDIF
+
+         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
+
       IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean
          ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:)
@@ -2006,5 +2028,5 @@
       !                                                        ! first T level thickness 
       IF( ssnd(jps_e3t1st )%laction )  THEN
-         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1)   , (/jpi,jpj,1/) ), info )
+         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t_n(:,:,1)   , (/jpi,jpj,1/) ), info )
       ENDIF
       !                                                        ! Qsr fraction
@@ -2024,8 +2046,8 @@
       IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
 
-      CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
-      CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_snd')
+      CALL wrk_dealloc( jpi,jpj,       zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
+      CALL wrk_dealloc( jpi,jpj,jpl,   ztmp3, ztmp4 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_snd')
       !
    END SUBROUTINE sbc_cpl_snd
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90	(revision 6808)
@@ -90,6 +90,6 @@
 
       ! When are we during the day (from 0 to 1)
-      zlo = ( REAL(nsec_day, wp) - 0.5_wp * rdttra(1) ) / rday
-      zup = zlo + ( REAL(nn_fsbc, wp)     * rdttra(1) ) / rday
+      zlo = ( REAL(nsec_day, wp) - 0.5_wp * rdt ) / rday
+      zup = zlo + ( REAL(nn_fsbc, wp)     * rdt ) / rday
       !                                          
       IF( nday_qsr == -1 ) THEN       ! first time step only  
@@ -189,5 +189,5 @@
          END DO  
          !
-         ztmp = rday / ( rdttra(1) * REAL(nn_fsbc, wp) )
+         ztmp = rday / ( rdt * REAL(nn_fsbc, wp) )
          rscal(:,:) = rscal(:,:) * ztmp
          !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 6808)
@@ -17,4 +17,5 @@
    USE sbcdcy          ! surface boundary condition: diurnal cycle on qsr
    USE phycst          ! physical constants
+   !
    USE fldread         ! read input fields
    USE iom             ! IOM library
@@ -37,5 +38,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -131,5 +131,4 @@
          ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1)
          ENDIF
-!CDIR COLLAPSE
          DO jj = 1, jpj                                           ! set the ocean fluxes from read fields
             DO ji = 1, jpi
@@ -145,7 +144,5 @@
          !                                                        ! module of wind stress and wind speed at T-point
          zcoef = 1. / ( zrhoa * zcdrag )
-!CDIR NOVERRCHK
          DO jj = 2, jpjm1
-!CDIR NOVERRCHK
             DO ji = fs_2, fs_jpim1   ! vect. opt.
                ztx = utau(ji-1,jj  ) + utau(ji,jj) 
@@ -168,7 +165,5 @@
                WRITE(numout,*) 
                WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact
-               CALL prihre( sf(jf)%fnow, jpi, jpj, 1, jpi, 20, 1, jpj, 10, zfact, numout )
             END DO
-            CALL FLUSH(numout)
          ENDIF
          !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 6808)
@@ -12,20 +12,20 @@
 
    !!----------------------------------------------------------------------
-   !!   sbc_fwb      : freshwater budget for global ocean configurations
-   !!                  in free surface and forced mode
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface ocean boundary condition
-   USE phycst          ! physical constants
-   USE sbcrnf          ! ocean runoffs
-   USE sbcisf          ! ice shelf melting contribution
-   USE sbcssr          ! SS damping terms
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distribued memory computing library
-   USE wrk_nemo        ! work arrays
-   USE timing          ! Timing
-   USE lbclnk          ! ocean lateral boundary conditions
-   USE lib_fortran
+   !!   sbc_fwb       : freshwater budget for global ocean configurations (free surface & forced mode)
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! surface ocean boundary condition
+   USE phycst         ! physical constants
+   USE sbcrnf         ! ocean runoffs
+   USE sbcisf         ! ice shelf melting contribution
+   USE sbcssr         ! Sea-Surface damping terms
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+   USE lbclnk         ! ocean lateral boundary conditions
+   USE lib_fortran    ! 
 
    IMPLICIT NONE
@@ -40,5 +40,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -108,5 +107,5 @@
          !
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) -  snwice_fmass(:,:) ) ) / area   ! sum over the global domain
+            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area   ! sum over the global domain
             zcoef = z_fwf * rcp
             emp(:,:) = emp(:,:) - z_fwf              * tmask(:,:,1)
@@ -129,5 +128,5 @@
          ENDIF   
          !                                         ! Update fwfold if new year start
-         ikty = 365 * 86400 / rdttra(1)    !!bug  use of 365 days leap year or 360d year !!!!!!!
+         ikty = 365 * 86400 / rdt                  !!bug  use of 365 days leap year or 360d year !!!!!!!
          IF( MOD( kt, ikty ) == 0 ) THEN
             a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow
@@ -162,5 +161,5 @@
             zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) )
             !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges) 
-            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) - snwice_fmass(:,:) ) ) / area
+            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area
             !            
             IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 6808)
@@ -9,6 +9,4 @@
    !!----------------------------------------------------------------------
    !!   sbc_ice_cice  : sea-ice model time-stepping and update ocean sbc over ice-covered area
-   !!   
-   !!   
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
@@ -67,5 +65,4 @@
    PRIVATE
 
-   !! * Routine accessibility
    PUBLIC cice_sbc_init   ! routine called by sbc_init
    PUBLIC cice_sbc_final  ! routine called by sbc_final
@@ -93,8 +90,9 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PRIVATE ::   png     ! local array used in sbc_cice_ice
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO-consortium (2015) 
    !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -154,9 +152,11 @@
    END SUBROUTINE sbc_ice_cice
 
-   SUBROUTINE cice_sbc_init (ksbc)
+
+   SUBROUTINE cice_sbc_init( ksbc )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cice_sbc_init  ***
       !! ** Purpose: Initialise ice related fields for NEMO and coupling
       !!
+      !!---------------------------------------------------------------------
       INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type
       REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2
@@ -240,46 +240,48 @@
          snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges
       ENDIF
-      IF( .NOT. ln_rstart ) THEN
+      IF( .NOT.ln_rstart ) THEN
          IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area
             sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
             sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
-#if defined key_vvl            
-           ! key_vvl necessary? clem: yes for compilation purpose
-            DO jk = 1,jpkm1                     ! adjust initial vertical scale factors
-               fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
-               fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
-            ENDDO
-            fse3t_a(:,:,:) = fse3t_b(:,:,:)
-            ! Reconstruction of all vertical scale factors at now and before time
-            ! steps
-            ! =============================================================================
-            ! Horizontal scale factor interpolations
-            ! --------------------------------------
-            CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' )
-            CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' )
-            CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' )
-            CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' )
-            CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' )
-            ! Vertical scale factor interpolations
-            ! ------------------------------------
-            CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W'  )
-            CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' )
-            CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' )
-            CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' )
-            CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' )
-            ! t- and w- points depth
-            ! ----------------------
-            fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)
-            fsdepw_n(:,:,1) = 0.0_wp
-            fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:)
-            DO jk = 2, jpk
-               fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk)
-               fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1)
-               fsde3w_n(:,:,jk) = fsdept_n(:,:,jk  ) - sshn   (:,:)
-            END DO
-#endif
+
+!!gm This should be put elsewhere....   (same remark for limsbc)
+!!gm especially here it is assumed zstar coordinate, but it can be ztilde....
+            IF( .NOT.ln_linssh ) THEN
+               !
+               DO jk = 1,jpkm1                     ! adjust initial vertical scale factors
+                  e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+                  e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+               ENDDO
+               e3t_a(:,:,:) = e3t_b(:,:,:)
+               ! Reconstruction of all vertical scale factors at now and before time-steps
+               ! =============================================================================
+               ! Horizontal scale factor interpolations
+               ! --------------------------------------
+               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
+               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
+               CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+               CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+               CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
+               ! Vertical scale factor interpolations
+               ! ------------------------------------
+               CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
+               CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
+               CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
+               CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
+               CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+               ! t- and w- points depth
+               ! ----------------------
+               gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+               gdepw_n(:,:,1) = 0.0_wp
+               gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+               DO jk = 2, jpk
+                  gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk)
+                  gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1)
+                  gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:)
+               END DO
+            ENDIF
          ENDIF
       ENDIF
- 
+      !
       CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 )
       !
@@ -289,5 +291,5 @@
 
    
-   SUBROUTINE cice_sbc_in (kt, ksbc)
+   SUBROUTINE cice_sbc_in( kt, ksbc )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cice_sbc_in  ***
@@ -296,5 +298,5 @@
       INTEGER, INTENT(in   ) ::   kt   ! ocean time step
       INTEGER, INTENT(in   ) ::   ksbc ! surface forcing type
-
+      !
       INTEGER  ::   ji, jj, jl                   ! dummy loop indices      
       REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice
@@ -444,5 +446,5 @@
 ! Freezing/melting potential
 ! Calculated over NEMO leapfrog timestep (hence 2*dt)
-      nfrzmlt(:,:)=rau0*rcp*fse3t_m(:,:)*(Tocnfrz-sst_m(:,:))/(2.0*dt)
+      nfrzmlt(:,:) = rau0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt )
 
       ztmp(:,:) = nfrzmlt(:,:)
@@ -490,21 +492,19 @@
 ! x comp and y comp of sea surface slope (on F points)
 ! T point to F point
-      DO jj=1,jpjm1
-         DO ji=1,jpim1
-            ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  ))/e1u(ji,jj  )   &
-                               + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) & 
-                            *  fmask(ji,jj,1)
-         ENDDO
-      ENDDO
-      CALL nemo2cice(ztmp,ss_tltx,'F', -1. )
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  )) * r1_e1u(ji,jj  )    &
+               &               + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1)  ) * fmask(ji,jj,1)
+         END DO
+      END DO
+      CALL nemo2cice( ztmp,ss_tltx,'F', -1. )
 
 ! T point to F point
-      DO jj=1,jpjm1
-         DO ji=1,jpim1
-            ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj))/e2v(ji  ,jj)   &
-                               + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) &
-                            *  fmask(ji,jj,1)
-         ENDDO
-      ENDDO
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj)) * r1_e2v(ji  ,jj)    &
+               &               + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj)  ) *  fmask(ji,jj,1)
+         END DO
+      END DO
       CALL nemo2cice(ztmp,ss_tlty,'F', -1. )
 
@@ -517,5 +517,5 @@
 
 
-   SUBROUTINE cice_sbc_out (kt,ksbc)
+   SUBROUTINE cice_sbc_out( kt, ksbc )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cice_sbc_out  ***
@@ -575,5 +575,5 @@
 ! Update taum with modulus of ice-ocean stress 
 ! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here 
-taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1**2. + ztmp2**2.) 
+taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1*ztmp1 + ztmp2*ztmp2) 
 
 ! Freshwater fluxes 
@@ -888,5 +888,4 @@
 #endif
       !!---------------------------------------------------------------------
-
       CHARACTER(len=1), INTENT( in ) ::   &
           cd_type       ! nature of pn grid-point
@@ -908,4 +907,5 @@
 
       INTEGER  ::   ji, jj, jn                      ! dummy loop indices
+      !!---------------------------------------------------------------------
 
 !     A. Ensure all haloes are filled in NEMO field (pn)
@@ -1096,5 +1096,4 @@
    !!   Default option           Dummy module         NO CICE sea-ice model
    !!----------------------------------------------------------------------
-   !! $Id$
 CONTAINS
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 6808)
@@ -34,6 +34,4 @@
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ice   ! structure of input ice-cover (file informations, fields read)
    
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 6808)
@@ -25,5 +25,5 @@
    USE thd_ice         ! LIM-3: thermodynamical variables
    USE dom_ice         ! LIM-3: ice domain
-
+   !
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice   fields
@@ -32,5 +32,5 @@
    USE sbccpl          ! Surface boundary condition: coupled interface
    USE albedo          ! ocean & ice albedo
-
+   !
    USE phycst          ! Define parameters for the routines
    USE eosbn2          ! equation of state
@@ -47,19 +47,18 @@
    USE limupdate2      ! update of global variables
    USE limvar          ! Ice variables switch
-
+   USE limctl          ! 
    USE limmsh          ! LIM mesh
    USE limistate       ! LIM initial state
    USE limthd_sal      ! LIM ice thermodynamics: salinity
-
+   !
    USE c1d             ! 1D vertical configuration
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O manager library
+   USE prtctl          ! Print control
+   USE lib_fortran     ! 
    USE lbclnk          ! lateral boundary condition - MPP link
    USE lib_mpp         ! MPP library
    USE wrk_nemo        ! work arrays
    USE timing          ! Timing
-   USE iom             ! I/O manager library
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
-   USE lib_fortran     ! 
-   USE limctl
 
 #if defined key_bdy 
@@ -74,5 +73,4 @@
    
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -82,6 +80,4 @@
    !!----------------------------------------------------------------------
 CONTAINS
-
-   !!======================================================================
 
    SUBROUTINE sbc_ice_lim( kt, kblk )
@@ -270,9 +266,9 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping'
       !
-                                       ! Open the reference and configuration namelist files and namelist output file 
+      !                                ! Open the reference and configuration namelist files and namelist output file 
       CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
       CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
       IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 )
-
+      !
       CALL ice_run                     ! set some ice run parameters
       !
@@ -348,11 +344,10 @@
       REWIND( numnam_ice_ref )              ! Namelist namicerun in reference namelist : Parameters for ice
       READ  ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )
-
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )
+      !
       REWIND( numnam_ice_cfg )              ! Namelist namicerun in configuration namelist : Parameters for ice
       READ  ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp )
-      IF(lwm) WRITE ( numoni, namicerun )
-      !
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp )
+      IF(lwm) WRITE( numoni, namicerun )
       !
       IF(lwp) THEN                        ! control print
@@ -373,5 +368,5 @@
       !
       ! sea-ice timestep and inverse
-      rdt_ice   = nn_fsbc * rdttra(1)  
+      rdt_ice   = nn_fsbc * rdt  
       r1_rdtice = 1._wp / rdt_ice 
 
@@ -405,11 +400,10 @@
       REWIND( numnam_ice_ref )              ! Namelist namiceitd in reference namelist : Parameters for ice
       READ  ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 903)
-903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp )
-
+903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp )
+      !
       REWIND( numnam_ice_cfg )              ! Namelist namiceitd in configuration namelist : Parameters for ice
       READ  ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 904 )
-904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp )
-      IF(lwm) WRITE ( numoni, namiceitd )
-      !
+904   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp )
+      IF(lwm) WRITE( numoni, namiceitd )
       !
       IF(lwp) THEN                        ! control print
@@ -417,8 +411,8 @@
          WRITE(numout,*) 'ice_itd : ice cat distribution'
          WRITE(numout,*) ' ~~~~~~'
-         WRITE(numout,*) '   shape of ice categories distribution                          nn_catbnd = ', nn_catbnd
-         WRITE(numout,*) '   mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean
+         WRITE(numout,*) '   shape of ice categories distribution                     nn_catbnd = ', nn_catbnd
+         WRITE(numout,*) '   mean ice thickness in the domain (used if nn_catbnd=2)   rn_himean = ', rn_himean
       ENDIF
-
+      !
       !----------------------------------
       !- Thickness categories boundaries 
@@ -427,42 +421,35 @@
       IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution '
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-
+      !
       hi_max(:) = 0._wp
-
-      SELECT CASE ( nn_catbnd  )       
-                                   !----------------------
-         CASE (1)                  ! tanh function (CICE)
-                                   !----------------------
+      !
+      SELECT CASE ( nn_catbnd  )    ! type of ice categories distribution
+      !
+      CASE (1)                            !==  tanh function (CICE)  ==!
          zc1 =  3._wp / REAL( jpl, wp )
          zc2 = 10._wp * zc1
          zc3 =  3._wp
-
          DO jl = 1, jpl
             zx1 = REAL( jl-1, wp ) / REAL( jpl, wp )
             hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) )
          END DO
-
-                                   !----------------------
-         CASE (2)                  ! h^(-alpha) function
-                                   !----------------------
-         zalpha = 0.05             ! exponent of the transform function
-
-         zhmax  = 3.*rn_himean
-
+         !
+      CASE (2)                            !==  h^(-alpha) function  ==!
+         zalpha = 0.05_wp
+         zhmax  = 3._wp * rn_himean
          DO jl = 1, jpl 
             znum = jpl * ( zhmax+1 )**zalpha
-            zden = ( jpl - jl ) * ( zhmax+1 )**zalpha + jl
+            zden = REAL( jpl-jl , wp ) * ( zhmax + 1._wp )**zalpha + REAL( jl , wp )
             hi_max(jl) = ( znum / zden )**(1./zalpha) - 1
          END DO
-
+         !
       END SELECT
-
-      DO jl = 1, jpl
+      !
+      DO jl = 1, jpl                ! mean thickness by category
          hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp
       END DO
-
-      ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl)
-      hi_max(jpl) = 99._wp
-
+      !
+      hi_max(jpl) = 99._wp          ! set to a big value to ensure that all ice is thinner than hi_max(jpl)
+      !
       IF(lwp) WRITE(numout,*) ' Thickness category boundaries '
       IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl)
@@ -471,5 +458,6 @@
 
    
-   SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx )
+   SUBROUTINE ice_lim_flx( ptn_ice , palb_ice, pqns_ice ,    &
+      &                    pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE ice_lim_flx  ***
@@ -483,5 +471,5 @@
       !!---------------------------------------------------------------------
       INTEGER                   , INTENT(in   ) ::   k_limflx   ! =-1 do nothing; =0 average ; 
-                                                                ! =1 average and redistribute ; =2 redistribute
+      !                                                         ! =1 average and redistribute ; =2 redistribute
       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptn_ice    ! ice surface temperature 
       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb_ice   ! ice albedo
@@ -503,7 +491,6 @@
       REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories
       !!----------------------------------------------------------------------
-
+      !
       IF( nn_timing == 1 )  CALL timing_start('ice_lim_flx')
-      !
       !
       SELECT CASE( k_limflx )                              !==  averaged on all ice categories  ==!
@@ -529,5 +516,5 @@
          CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m)
       END SELECT
-
+      !
       SELECT CASE( k_limflx )                              !==  redistribution on all ice categories  ==!
       CASE( 1 , 2 )
@@ -548,4 +535,5 @@
       !
    END SUBROUTINE ice_lim_flx
+
 
    SUBROUTINE sbc_lim_bef
@@ -564,6 +552,7 @@
       u_ice_b(:,:)     = u_ice(:,:)
       v_ice_b(:,:)     = v_ice(:,:)
-      
+      !      
    END SUBROUTINE sbc_lim_bef
+
 
    SUBROUTINE sbc_lim_diag0
@@ -580,5 +569,5 @@
       sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp
       sfx_res(:,:) = 0._wp
-      
+      !
       wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp
       wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp
@@ -587,5 +576,5 @@
       wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp
       wfx_spr(:,:) = 0._wp   ;   
-      
+      !
       hfx_thd(:,:) = 0._wp   ;   
       hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp
@@ -596,11 +585,11 @@
       hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp
       hfx_err_dif(:,:) = 0._wp   ;
-
+      !
       afx_tot(:,:) = 0._wp   ;
       afx_dyn(:,:) = 0._wp   ;   afx_thd(:,:) = 0._wp
-
+      !
       diag_heat(:,:) = 0._wp ;   diag_smvi(:,:) = 0._wp ;
       diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp ;
-      
+      !
    END SUBROUTINE sbc_lim_diag0
 
@@ -634,5 +623,4 @@
    END FUNCTION fice_ice_ave
 
-
 #else
    !!----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 6808)
@@ -64,5 +64,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 6808)
@@ -18,269 +18,151 @@
    USE eosbn2          ! equation of state
    USE sbc_oce         ! surface boundary condition: ocean fields
+   USE zdfbfr          !
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O manager library
+   USE fldread         ! read input field at current time step
    USE lbclnk          !
-   USE iom             ! I/O manager library
-   USE in_out_manager  ! I/O manager
    USE wrk_nemo        ! Memory allocation
    USE timing          ! Timing
    USE lib_fortran     ! glob_sum
-   USE zdfbfr
-   USE fldread         ! read input field at current time step
-
-
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   sbc_isf, sbc_isf_div, sbc_isf_alloc  ! routine called in sbcmod and divcur
+   PUBLIC   sbc_isf, sbc_isf_div, sbc_isf_alloc  ! routine called in sbcmod and divhor
 
    ! public in order to be able to output then 
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   risf_tsc_b, risf_tsc   
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qisf              !: net heat flux from ice shelf
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   risf_tsc_b, risf_tsc  !: before and now T & S isf contents [K.m/s & PSU.m/s]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qisf                  !: net heat flux from ice shelf      [W/m2]
    REAL(wp), PUBLIC ::   rn_hisf_tbl                 !: thickness of top boundary layer [m]
-   LOGICAL , PUBLIC ::   ln_divisf                   !: flag to correct divergence 
-   INTEGER , PUBLIC ::   nn_isfblk                   !: 
-   INTEGER , PUBLIC ::   nn_gammablk                 !:
-   LOGICAL , PUBLIC ::   ln_conserve                 !:
-   REAL(wp), PUBLIC ::   rn_gammat0                  !: temperature exchange coeficient
-   REAL(wp), PUBLIC ::   rn_gammas0                  !: salinity    exchange coeficient 
-   REAL(wp), PUBLIC ::   rdivisf                     !: flag to test if fwf apply on divergence
+   INTEGER , PUBLIC ::   nn_isf                      !: flag to choose between explicit/param/specified  
+   INTEGER , PUBLIC ::   nn_isfblk                   !: flag to choose the bulk formulation to compute the ice shelf melting
+   INTEGER , PUBLIC ::   nn_gammablk                 !: flag to choose how the exchange coefficient is computed
+   REAL(wp), PUBLIC ::   rn_gammat0                  !: temperature exchange coeficient []
+   REAL(wp), PUBLIC ::   rn_gammas0                  !: salinity    exchange coeficient []
 
    REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  rzisf_tbl              !:depth of calving front (shallowest point) nn_isf ==2/3
-   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  rhisf_tbl, rhisf_tbl_0 !:thickness of tbl
+   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  rhisf_tbl, rhisf_tbl_0 !:thickness of tbl  [m]
    REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  r1_hisf_tbl            !:1/thickness of tbl
    REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  ralpha                 !:proportion of bottom cell influenced by tbl 
    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
-
-
-   REAL(wp), PUBLIC, SAVE ::   rcpi   = 2000.0_wp     ! phycst ?
-   REAL(wp), PUBLIC, SAVE ::   kappa  = 1.54e-6_wp    ! phycst ?
-   REAL(wp), PUBLIC, SAVE ::   rhoisf = 920.0_wp      ! phycst ?
-   REAL(wp), PUBLIC, SAVE ::   tsurf  = -20.0_wp      ! phycst ?
-   REAL(wp), PUBLIC, SAVE ::   lfusisf= 0.334e6_wp    ! phycst ?
+   INTEGER,    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)      ::  misfkt, misfkb         !:Level of ice shelf base
+
+   REAL(wp), PUBLIC, SAVE ::   rcpi     = 2000.0_wp     ! specific heat of ice shelf             [J/kg/K]
+   REAL(wp), PUBLIC, SAVE ::   rkappa   = 1.54e-6_wp    ! heat diffusivity through the ice-shelf [m2/s]
+   REAL(wp), PUBLIC, SAVE ::   rhoisf   = 920.0_wp      ! volumic mass of ice shelf              [kg/m3]
+   REAL(wp), PUBLIC, SAVE ::   tsurf    = -20.0_wp      ! air temperature on top of ice shelf    [C]
+   REAL(wp), PUBLIC, SAVE ::   rlfusisf = 0.334e6_wp    ! latent heat of fusion of ice shelf     [J/kg]
 
 !: Variable used in fldread to read the forcing file (nn_isf == 4 .OR. nn_isf == 3)
-   CHARACTER(len=100), PUBLIC ::   cn_dirisf  = './'    !: Root directory for location of ssr files
-   TYPE(FLD_N)       , PUBLIC ::   sn_qisf, sn_fwfisf     !: information about the runoff file to be read
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qisf, sf_fwfisf
-   TYPE(FLD_N)       , PUBLIC ::   sn_rnfisf              !: information about the runoff file to be read
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_rnfisf           
-   TYPE(FLD_N)       , PUBLIC ::   sn_depmax_isf, sn_depmin_isf, sn_Leff_isf     !: information about the runoff file to be read
+   CHARACTER(len=100), PUBLIC           :: cn_dirisf  = './' !: Root directory for location of ssr files
+   TYPE(FLD_N)       , PUBLIC           :: sn_fwfisf         !: information about the isf melting file to be read
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_fwfisf
+   TYPE(FLD_N)       , PUBLIC           :: sn_rnfisf         !: information about the isf melting param.   file to be read
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnfisf           
+   TYPE(FLD_N)       , PUBLIC           :: sn_depmax_isf     !: information about the grounding line depth file to be read
+   TYPE(FLD_N)       , PUBLIC           :: sn_depmin_isf     !: information about the calving   line depth file to be read
+   TYPE(FLD_N)       , PUBLIC           :: sn_Leff_isf       !: information about the effective length     file to be read
    
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008)
+   !! NEMO/OPA 3.7 , LOCEAN-IPSL (2015)
    !! $Id$
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
  
   SUBROUTINE sbc_isf(kt)
-    INTEGER, INTENT(in)          ::   kt         ! ocean time step
-    INTEGER                      ::   ji, jj, jk, ijkmin, inum, ierror
-    INTEGER                      ::   ikt, ikb   ! top and bottom level of the isf boundary layer
-    REAL(wp)                     ::   rmin
-    REAL(wp)                     ::   zhk
-    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
-    INTEGER           ::   ios           ! Local integer output status for namelist read
-      !
       !!---------------------------------------------------------------------
-      NAMELIST/namsbc_isf/ nn_isfblk, rn_hisf_tbl, ln_divisf, ln_conserve, rn_gammat0, rn_gammas0, nn_gammablk, &
-                         & sn_fwfisf, sn_qisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf
-      !
+      !!                  ***  ROUTINE sbc_isf  ***
+      !!
+      !! ** Purpose : Compute Salt and Heat fluxes related to ice_shelf 
+      !!              melting and freezing 
+      !!
+      !! ** Method  :  4 parameterizations are available according to nn_isf 
+      !!               nn_isf = 1 : Realistic ice_shelf formulation
+      !!                        2 : Beckmann & Goose parameterization
+      !!                        3 : Specified runoff in deptht (Mathiot & al. )
+      !!                        4 : specified fwf and heat flux forcing beneath the ice shelf
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) :: kt                   ! ocean time step
+      !
+      INTEGER               :: ji, jj               ! loop index
+      REAL(wp), DIMENSION (:,:), POINTER :: zt_frz, zdep ! freezing temperature (zt_frz) at depth (zdep) 
+      !!---------------------------------------------------------------------
       !
       !                                         ! ====================== !
       IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
          !                                      ! ====================== !
-         REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs 
-         READ  ( numnam_ref, namsbc_isf, IOSTAT = ios, ERR = 901)
-901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in reference namelist', lwp )
-
-         REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs
-         READ  ( numnam_cfg, namsbc_isf, IOSTAT = ios, ERR = 902 )
-902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist', lwp )
-         IF(lwm) WRITE ( numond, namsbc_isf )
-
-
-         IF ( lwp ) WRITE(numout,*)
-         IF ( lwp ) WRITE(numout,*) 'sbc_isf: heat flux of the ice shelf'
-         IF ( lwp ) WRITE(numout,*) '~~~~~~~~~'
-         IF ( lwp ) WRITE(numout,*) 'sbcisf :' 
-         IF ( lwp ) WRITE(numout,*) '~~~~~~~~'
-         IF ( lwp ) WRITE(numout,*) '        nn_isf      = ', nn_isf
-         IF ( lwp ) WRITE(numout,*) '        nn_isfblk   = ', nn_isfblk
-         IF ( lwp ) WRITE(numout,*) '        rn_hisf_tbl = ', rn_hisf_tbl
-         IF ( lwp ) WRITE(numout,*) '        ln_divisf   = ', ln_divisf 
-         IF ( lwp ) WRITE(numout,*) '        nn_gammablk = ', nn_gammablk 
-         IF ( lwp ) WRITE(numout,*) '        rn_tfri2    = ', rn_tfri2 
-         IF (ln_divisf) THEN       ! keep it in the namelist ??? used true anyway as for runoff ? (PM)
-            rdivisf = 1._wp
-         ELSE
-            rdivisf = 0._wp
-         END IF
+         CALL sbc_isf_init
+      !                                         ! ---------------------------------------- !
+      ELSE                                      !          Swap of forcing fields          !
+         !                                      ! ---------------------------------------- !
+         fwfisf_b  (:,:  ) = fwfisf  (:,:  )    ! Swap the ocean forcing fields except at nit000
+         risf_tsc_b(:,:,:) = risf_tsc(:,:,:)    ! where before fields are set at the end of the routine
          !
-         ! Allocate public variable
-         IF ( sbc_isf_alloc()  /= 0 )         CALL ctl_stop( 'STOP', 'sbc_isf : unable to allocate arrays' )
-         !
-         ! initialisation
-         qisf(:,:)        = 0._wp  ; fwfisf(:,:) = 0._wp
-         risf_tsc(:,:,:)  = 0._wp
-         !
-         ! define isf tbl tickness, top and bottom indice
-         IF      (nn_isf == 1) THEN
-            rhisf_tbl(:,:) = rn_hisf_tbl
-            misfkt(:,:)    = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
-         ELSE IF ((nn_isf == 3) .OR. (nn_isf == 2)) THEN
-            ALLOCATE( sf_rnfisf(1), STAT=ierror )
-            ALLOCATE( sf_rnfisf(1)%fnow(jpi,jpj,1), sf_rnfisf(1)%fdta(jpi,jpj,1,2) )
-            CALL fld_fill( sf_rnfisf, (/ sn_rnfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' )
-
-            !: read effective lenght (BG03)
-            IF (nn_isf == 2) THEN
-               ! Read Data and save some integral values
-               CALL iom_open( sn_Leff_isf%clname, inum )
-               cvarLeff  = 'soLeff'               !: variable name for Efficient Length scale
-               CALL iom_get( inum, jpdom_data, cvarLeff, risfLeff , 1)
-               CALL iom_close(inum)
-               !
-               risfLeff = risfLeff*1000           !: convertion in m
-            END IF
-
-           ! read depth of the top and bottom of the isf top boundary layer (in this case, isf front depth and grounding line depth)
-            CALL iom_open( sn_depmax_isf%clname, inum )
-            cvarhisf = TRIM(sn_depmax_isf%clvar)
-            CALL iom_get( inum, jpdom_data, cvarhisf, rhisf_tbl, 1) !: depth of deepest point of the ice shelf base
-            CALL iom_close(inum)
-            !
-            CALL iom_open( sn_depmin_isf%clname, inum )
-            cvarzisf = TRIM(sn_depmin_isf%clvar)
-            CALL iom_get( inum, jpdom_data, cvarzisf, rzisf_tbl, 1) !: depth of shallowest point of the ice shelves base
-            CALL iom_close(inum)
-            !
-            rhisf_tbl(:,:) = rhisf_tbl(:,:) - rzisf_tbl(:,:)        !: tickness isf boundary layer
-
-           !! compute first level of the top boundary layer
-           DO ji = 1, jpi
-              DO jj = 1, jpj
-                  jk = 2
-                  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
-            END DO
-
-         ELSE IF ( nn_isf == 4 ) THEN
-            ! as in nn_isf == 1
-            rhisf_tbl(:,:) = rn_hisf_tbl
-            misfkt(:,:)    = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
-            
-            ! load variable used in fldread (use for temporal interpolation of isf fwf forcing)
-            ALLOCATE( sf_fwfisf(1), sf_qisf(1), STAT=ierror )
-            ALLOCATE( sf_fwfisf(1)%fnow(jpi,jpj,1), sf_fwfisf(1)%fdta(jpi,jpj,1,2) )
-            ALLOCATE( sf_qisf(1)%fnow(jpi,jpj,1), sf_qisf(1)%fdta(jpi,jpj,1,2) )
-            CALL fld_fill( sf_fwfisf, (/ sn_fwfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' )
-            !CALL fld_fill( sf_qisf  , (/ sn_qisf   /), cn_dirisf, 'sbc_isf_init', 'read heat flux isf data'       , 'namsbc_isf' )
-         END IF
-         
-         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
 
-      !                                            ! ---------------------------------------- !
-      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          !
-         !                                         ! ---------------------------------------- !
-         fwfisf_b  (:,:  ) = fwfisf  (:,:  )               ! Swap the ocean forcing fields except at nit000
-         risf_tsc_b(:,:,:) = risf_tsc(:,:,:)               ! where before fields are set at the end of the routine
-         !
-      ENDIF
-
       IF( MOD( kt-1, nn_fsbc) == 0 ) THEN
-
-
-         ! compute salf and heat flux
-         IF (nn_isf == 1) THEN
-            ! realistic ice shelf formulation
+         ! allocation
+         CALL wrk_alloc( jpi,jpj, zt_frz, zdep  )
+
+         ! compute salt and heat flux
+         SELECT CASE ( nn_isf )
+         CASE ( 1 )    ! realistic ice shelf formulation
             ! compute T/S/U/V for the top boundary layer
             CALL sbc_isf_tbl(tsn(:,:,:,jp_tem),ttbl(:,:),'T')
             CALL sbc_isf_tbl(tsn(:,:,:,jp_sal),stbl(:,:),'T')
-            CALL sbc_isf_tbl(un(:,:,:),utbl(:,:),'U')
-            CALL sbc_isf_tbl(vn(:,:,:),vtbl(:,:),'V')
+            CALL sbc_isf_tbl(un(:,:,:)        ,utbl(:,:),'U')
+            CALL sbc_isf_tbl(vn(:,:,:)        ,vtbl(:,:),'V')
             ! iom print
             CALL iom_put('ttbl',ttbl(:,:))
             CALL iom_put('stbl',stbl(:,:))
-            CALL iom_put('utbl',utbl(:,:))
-            CALL iom_put('vtbl',vtbl(:,:))
+            CALL iom_put('utbl',utbl(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:))
+            CALL iom_put('vtbl',vtbl(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:))
             ! compute fwf and heat flux
             CALL sbc_isf_cav (kt)
 
-         ELSE IF (nn_isf == 2) THEN
-            ! Beckmann and Goosse parametrisation 
+         CASE ( 2 )    ! Beckmann and Goosse parametrisation 
             stbl(:,:)   = soce
             CALL sbc_isf_bg03(kt)
 
-         ELSE IF (nn_isf == 3) THEN
-            ! specified runoff in depth (Mathiot et al., XXXX in preparation)
+         CASE ( 3 )    ! specified runoff in depth (Mathiot et al., XXXX in preparation)
             CALL fld_read ( kt, nn_fsbc, sf_rnfisf   )
-            fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fresh water flux from the isf (fwfisf <0 mean melting) 
-            qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux
+            fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fwf  flux from the isf (fwfisf <0 mean melting) 
+            qisf(:,:)   = fwfisf(:,:) * rlfusisf             ! heat flux
             stbl(:,:)   = soce
 
-         ELSE IF (nn_isf == 4) THEN
-            ! specified fwf and heat flux forcing beneath the ice shelf
+         CASE ( 4 )    ! specified fwf and heat flux forcing beneath the ice shelf
             CALL fld_read ( kt, nn_fsbc, sf_fwfisf   )
-            !CALL fld_read ( kt, nn_fsbc, sf_qisf   )
-            fwfisf(:,:) = sf_fwfisf(1)%fnow(:,:,1)            ! fwf
-            qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux
-            !qisf(:,:)   = sf_qisf(1)%fnow(:,:,1)              ! heat flux
+            fwfisf(:,:) = - sf_fwfisf(1)%fnow(:,:,1)           ! fwf  flux from the isf (fwfisf <0 mean melting)
+            qisf(:,:)   = fwfisf(:,:) * rlfusisf               ! heat flux
             stbl(:,:)   = soce
 
-         END IF
+         END SELECT
+
          ! compute tsc due to isf
-         ! 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 !
+         ! isf melting implemented as a volume flux and we assume that melt water is at 0 PSU.
+         ! WARNING water add at temp = 0C, need to add a correction term (fwfisf * tfreez / rau0).
+         ! compute freezing point beneath ice shelf (or top cell if nn_isf = 3)
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               zdep(ji,jj)=gdepw_n(ji,jj,misfkt(ji,jj))
+            END DO
+         END DO
+         CALL eos_fzp( stbl(:,:), zt_frz(:,:), zdep(:,:) )
          
-         ! salt effect already take into account in vertical advection
-         risf_tsc(:,:,jp_sal) = (1.0_wp-rdivisf) * fwfisf(:,:) * stbl(:,:) * r1_rau0
-          
+         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - fwfisf(:,:) * zt_frz(:,:) * r1_rau0 !
+         risf_tsc(:,:,jp_sal) = 0.0_wp
+
          ! lbclnk
          CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.)
          CALL lbc_lnk(risf_tsc(:,:,jp_sal),'T',1.)
-         CALL lbc_lnk(fwfisf(:,:)   ,'T',1.)
-         CALL lbc_lnk(qisf(:,:)     ,'T',1.)
-
-         IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
+         CALL lbc_lnk(fwfisf(:,:)         ,'T',1.)
+         CALL lbc_lnk(qisf(:,:)           ,'T',1.)
+
+         IF( kt == nit000 ) THEN                         !   set the forcing field at nit000 - 1    !
             IF( ln_rstart .AND.    &                     ! Restart: read in restart file
                  & iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN
@@ -293,12 +175,16 @@
                risf_tsc_b(:,:,:)= risf_tsc(:,:,:)
             END IF
-         ENDIF
+         END IF
          ! 
          ! output
          CALL iom_put('qisf'  , qisf)
-         IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )
+         CALL iom_put('fwfisf', fwfisf)
+
+         ! deallocation
+         CALL wrk_dealloc( jpi,jpj, zt_frz, zdep  )
       END IF
-  
+      !  
   END SUBROUTINE sbc_isf
+
 
   INTEGER FUNCTION sbc_isf_alloc()
@@ -315,82 +201,205 @@
                &    STAT= sbc_isf_alloc )
          !
-         IF( lk_mpp                  )   CALL mpp_sum ( sbc_isf_alloc )
+         IF( lk_mpp             )   CALL mpp_sum ( sbc_isf_alloc )
          IF( sbc_isf_alloc /= 0 )   CALL ctl_warn('sbc_isf_alloc: failed to allocate arrays.')
          !
-      ENDIF
+      END IF
   END FUNCTION
 
+  SUBROUTINE sbc_isf_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_isf_init  ***
+      !!
+      !! ** Purpose : Initialisation of variables for iceshelf fluxes formulation
+      !!
+      !! ** Method  :  4 parameterizations are available according to nn_isf 
+      !!               nn_isf = 1 : Realistic ice_shelf formulation
+      !!                        2 : Beckmann & Goose parameterization
+      !!                        3 : Specified runoff in deptht (Mathiot & al. )
+      !!                        4 : specified fwf and heat flux forcing beneath the ice shelf
+      !!----------------------------------------------------------------------
+      INTEGER               :: ji, jj, jk           ! loop index
+      INTEGER               :: ik                   ! current level index
+      INTEGER               :: ikt, ikb             ! top and bottom level of the isf boundary layer
+      INTEGER               :: inum, ierror
+      INTEGER               :: ios                  ! Local integer output status for namelist read
+      REAL(wp)              :: zhk
+      CHARACTER(len=256)    :: cvarzisf, cvarhisf   ! name for isf file
+      CHARACTER(LEN=32 )    :: cvarLeff             ! variable name for efficient Length scale
+      !!----------------------------------------------------------------------
+      NAMELIST/namsbc_isf/ nn_isfblk, rn_hisf_tbl, rn_gammat0, rn_gammas0, nn_gammablk, nn_isf, &
+                         & sn_fwfisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs 
+      READ  ( numnam_ref, namsbc_isf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs
+      READ  ( numnam_cfg, namsbc_isf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsbc_isf )
+
+      IF ( lwp ) WRITE(numout,*)
+      IF ( lwp ) WRITE(numout,*) 'sbc_isf: heat flux of the ice shelf'
+      IF ( lwp ) WRITE(numout,*) '~~~~~~~~~'
+      IF ( lwp ) WRITE(numout,*) 'sbcisf :' 
+      IF ( lwp ) WRITE(numout,*) '~~~~~~~~'
+      IF ( lwp ) WRITE(numout,*) '        nn_isf      = ', nn_isf
+      IF ( lwp ) WRITE(numout,*) '        nn_isfblk   = ', nn_isfblk
+      IF ( lwp ) WRITE(numout,*) '        rn_hisf_tbl = ', rn_hisf_tbl
+      IF ( lwp ) WRITE(numout,*) '        nn_gammablk = ', nn_gammablk 
+      IF ( lwp ) WRITE(numout,*) '        rn_gammat0  = ', rn_gammat0  
+      IF ( lwp ) WRITE(numout,*) '        rn_gammas0  = ', rn_gammas0  
+      IF ( lwp ) WRITE(numout,*) '        rn_tfri2    = ', rn_tfri2 
+      !
+      ! Allocate public variable
+      IF ( sbc_isf_alloc()  /= 0 )         CALL ctl_stop( 'STOP', 'sbc_isf : unable to allocate arrays' )
+      !
+      ! initialisation
+      qisf(:,:)        = 0._wp  ; fwfisf  (:,:) = 0._wp
+      risf_tsc(:,:,:)  = 0._wp  ; fwfisf_b(:,:) = 0._wp
+      !
+      ! define isf tbl tickness, top and bottom indice
+      SELECT CASE ( nn_isf )
+      CASE ( 1 ) 
+         rhisf_tbl(:,:) = rn_hisf_tbl
+         misfkt(:,:)    = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
+
+      CASE ( 2 , 3 )
+         ALLOCATE( sf_rnfisf(1), STAT=ierror )
+         ALLOCATE( sf_rnfisf(1)%fnow(jpi,jpj,1), sf_rnfisf(1)%fdta(jpi,jpj,1,2) )
+         CALL fld_fill( sf_rnfisf, (/ sn_rnfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' )
+
+         !  read effective lenght (BG03)
+         IF (nn_isf == 2) THEN
+            CALL iom_open( sn_Leff_isf%clname, inum )
+            cvarLeff = TRIM(sn_Leff_isf%clvar)
+            CALL iom_get( inum, jpdom_data, cvarLeff, risfLeff , 1)
+            CALL iom_close(inum)
+            !
+            risfLeff = risfLeff*1000.0_wp           !: convertion in m
+         END IF
+
+         ! read depth of the top and bottom of the isf top boundary layer (in this case, isf front depth and grounding line depth)
+         CALL iom_open( sn_depmax_isf%clname, inum )
+         cvarhisf = TRIM(sn_depmax_isf%clvar)
+         CALL iom_get( inum, jpdom_data, cvarhisf, rhisf_tbl, 1) !: depth of deepest point of the ice shelf base
+         CALL iom_close(inum)
+         !
+         CALL iom_open( sn_depmin_isf%clname, inum )
+         cvarzisf = TRIM(sn_depmin_isf%clvar)
+         CALL iom_get( inum, jpdom_data, cvarzisf, rzisf_tbl, 1) !: depth of shallowest point of the ice shelves base
+         CALL iom_close(inum)
+         !
+         rhisf_tbl(:,:) = rhisf_tbl(:,:) - rzisf_tbl(:,:)        !: tickness isf boundary layer
+
+         !! compute first level of the top boundary layer
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+                ik = 2
+                DO WHILE ( ik <= mbkt(ji,jj) .AND. gdepw_n(ji,jj,ik) < rzisf_tbl(ji,jj) ) ;  ik = ik + 1 ;  END DO
+                misfkt(ji,jj) = ik-1
+            END DO
+         END DO
+
+      CASE ( 4 ) 
+         ! as in nn_isf == 1
+         rhisf_tbl(:,:) = rn_hisf_tbl
+         misfkt(:,:)    = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
+         
+         ! load variable used in fldread (use for temporal interpolation of isf fwf forcing)
+         ALLOCATE( sf_fwfisf(1), STAT=ierror )
+         ALLOCATE( sf_fwfisf(1)%fnow(jpi,jpj,1), sf_fwfisf(1)%fdta(jpi,jpj,1,2) )
+         CALL fld_fill( sf_fwfisf, (/ sn_fwfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' )
+
+      END SELECT
+         
+      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), e3t_n(ji,jj,ikt))
+
+            ! determine the deepest level influenced by the boundary layer
+            DO jk = ikt+1, mbkt(ji,jj)
+               IF ( (SUM(e3t_n(ji,jj,ikt:jk-1)) < rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
+            END DO
+            rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_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( e3t_n(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 ) / e3t_n(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer
+         END DO
+      END DO
+
+  END SUBROUTINE sbc_isf_init
+
   SUBROUTINE sbc_isf_bg03(kt)
-   !!==========================================================================
-   !!                 *** SUBROUTINE sbcisf_bg03  ***
-   !! add net heat and fresh water flux from ice shelf melting
-   !! into the adjacent ocean using the parameterisation by
-   !! Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean
-   !!     interaction for climate models", Ocean Modelling 5(2003) 157-170.
-   !!  (hereafter BG)
-   !!==========================================================================
-   !!----------------------------------------------------------------------
-   !!   sbc_isf_bg03      : routine called from sbcmod
-   !!----------------------------------------------------------------------
-   !!
-   !! ** Purpose   :   Add heat and fresh water fluxes due to ice shelf melting
-   !! ** Reference :   Beckmann et Goosse, 2003, Ocean Modelling
-   !!
-   !! History :
-   !!      !  06-02  (C. Wang) Original code
-   !!----------------------------------------------------------------------
-
-    INTEGER, INTENT ( in ) :: kt
-
-    INTEGER :: ji, jj, jk, jish  !temporary integer
-    INTEGER :: ijkmin
-    INTEGER :: ii, ij, ik 
-    INTEGER :: inum
-
-    REAL(wp) :: zt_sum      ! sum of the temperature between 200m and 600m
-    REAL(wp) :: zt_ave      ! averaged temperature between 200m and 600m
-    REAL(wp) :: zt_frz      ! freezing point temperature at depth z
-    REAL(wp) :: zpress      ! pressure to compute the freezing point in depth
-    
-    !!----------------------------------------------------------------------
-    IF ( nn_timing == 1 ) CALL timing_start('sbc_isf_bg03')
-     !
-
-    ! This test is false only in the very first time step of a run (JMM ???- Initialy build to skip 1rst year of run )
-    DO ji = 1, jpi
-       DO jj = 1, jpj
-          ik = misfkt(ji,jj)
-          !! Initialize arrays to 0 (each step)
-          zt_sum = 0.e0_wp
-          IF ( ik .GT. 1 ) THEN
-    ! 3. -----------the average temperature between 200m and 600m ---------------------
-             DO jk = misfkt(ji,jj),misfkb(ji,jj)
-             ! freezing point temperature  at ice shelf base BG eq. 2 (JMM sign pb ??? +7.64e-4 !!!)
-             ! after verif with UNESCO, wrong sign in BG eq. 2
-             ! 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_sum = zt_sum + (tsn(ji,jj,ik,jp_tem)-zt_frz) * fse3t(ji,jj,ik) * tmask(ji,jj,ik)  ! sum temp
-             ENDDO
-             zt_ave = zt_sum/rhisf_tbl(ji,jj) ! calcul mean value
-    
-    ! 4. ------------Net heat flux and fresh water flux due to the ice shelf
-          ! For those corresponding to zonal boundary    
-             qisf(ji,jj) = - rau0 * rcp * rn_gammat0 * risfLeff(ji,jj) * e1t(ji,jj) * zt_ave  &
-                         & / (e1t(ji,jj) * e2t(ji,jj)) * tmask(ji,jj,ik) 
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_isf_bg03  ***
+      !!
+      !! ** Purpose : add net heat and fresh water flux from ice shelf melting
+      !!          into the adjacent ocean
+      !!
+      !! ** Method  :   See reference
+      !!
+      !! ** Reference : Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean
+      !!         interaction for climate models", Ocean Modelling 5(2003) 157-170.
+      !!         (hereafter BG)
+      !! History :
+      !!         06-02  (C. Wang) Original code
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT ( in ) :: kt
+      !
+      INTEGER  :: ji, jj, jk ! dummy loop index
+      INTEGER  :: ik         ! current level
+      REAL(wp) :: zt_sum     ! sum of the temperature between 200m and 600m
+      REAL(wp) :: zt_ave     ! averaged temperature between 200m and 600m
+      REAL(wp) :: zt_frz     ! freezing point temperature at depth z
+      REAL(wp) :: zpress     ! pressure to compute the freezing point in depth
+      !!----------------------------------------------------------------------
+
+      IF ( nn_timing == 1 ) CALL timing_start('sbc_isf_bg03')
+      !
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+            ik = misfkt(ji,jj)
+            !! Initialize arrays to 0 (each step)
+            zt_sum = 0.e0_wp
+            IF ( ik > 1 ) THEN
+               ! 1. -----------the average temperature between 200m and 600m ---------------------
+               DO jk = misfkt(ji,jj),misfkb(ji,jj)
+                  ! freezing point temperature  at ice shelf base BG eq. 2 (JMM sign pb ??? +7.64e-4 !!!)
+                  ! after verif with UNESCO, wrong sign in BG eq. 2
+                  ! Calculate freezing temperature
+                  CALL eos_fzp(stbl(ji,jj), zt_frz, zpress) 
+                  zt_sum = zt_sum + (tsn(ji,jj,jk,jp_tem)-zt_frz) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)  ! sum temp
+               END DO
+               zt_ave = zt_sum/rhisf_tbl(ji,jj) ! calcul mean value
+               ! 2. ------------Net heat flux and fresh water flux due to the ice shelf
+               ! For those corresponding to zonal boundary    
+               qisf(ji,jj) = - rau0 * rcp * rn_gammat0 * risfLeff(ji,jj) * e1t(ji,jj) * zt_ave  &
+                           & * r1_e1e2t(ji,jj) * tmask(ji,jj,jk)
              
-             fwfisf(ji,jj) = qisf(ji,jj) / lfusisf          !fresh water flux kg/(m2s)                  
-             fwfisf(ji,jj) = fwfisf(ji,jj) * ( soce / stbl(ji,jj) )
-             !add to salinity trend
-          ELSE
-             qisf(ji,jj) = 0._wp ; fwfisf(ji,jj) = 0._wp
-          END IF
-       ENDDO
-    ENDDO
-    !
-    IF( nn_timing == 1 )  CALL timing_stop('sbc_isf_bg03')
+               fwfisf(ji,jj) = qisf(ji,jj) / rlfusisf          !fresh water flux kg/(m2s)                  
+               fwfisf(ji,jj) = fwfisf(ji,jj) * ( soce / stbl(ji,jj) )
+               !add to salinity trend
+            ELSE
+               qisf(ji,jj) = 0._wp ; fwfisf(ji,jj) = 0._wp
+            END IF
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sbc_isf_bg03')
+      !
   END SUBROUTINE sbc_isf_bg03
 
-   SUBROUTINE sbc_isf_cav( kt )
+  SUBROUTINE sbc_isf_cav( kt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE sbc_isf_cav  ***
@@ -407,166 +416,125 @@
       INTEGER, INTENT(in)          ::   kt         ! ocean time step
       !
-      LOGICAL :: ln_isomip = .true.
-      REAL(wp), DIMENSION(:,:), POINTER       ::   zfrz,zpress,zti
-      REAL(wp), DIMENSION(:,:), POINTER       ::   zgammat2d, zgammas2d 
-      !REAL(wp), DIMENSION(:,:), POINTER ::   zqisf, zfwfisf
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      INTEGER  ::   nit
       REAL(wp) ::   zlamb1, zlamb2, zlamb3
       REAL(wp) ::   zeps1,zeps2,zeps3,zeps4,zeps6,zeps7
       REAL(wp) ::   zaqe,zbqe,zcqe,zaqer,zdis,zsfrz,zcfac
-      REAL(wp) ::   zfwflx, zhtflx, zhtflx_b
-      REAL(wp) ::   zgammat, zgammas
-      REAL(wp) ::   zeps   =  -1.e-20_wp        !==   Local constant initialization   ==!
-      INTEGER  ::   ji, jj     ! dummy loop indices
-      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integers
-      INTEGER  ::   ierror     ! return error code
-      LOGICAL  ::   lit=.TRUE.
-      INTEGER  ::   nit
+      REAL(wp) ::   zeps = 1.e-20_wp        
+      REAL(wp) ::   zerr
+      REAL(wp), DIMENSION(:,:), POINTER ::   zfrz
+      REAL(wp), DIMENSION(:,:), POINTER ::   zgammat, zgammas 
+      REAL(wp), DIMENSION(:,:), POINTER ::   zfwflx, zhtflx, zhtflx_b
+      LOGICAL  ::   lit
       !!---------------------------------------------------------------------
-      !
-      ! coeficient for linearisation of tfreez
-      zlamb1=-0.0575
-      zlamb2=0.0901
-      zlamb3=-7.61e-04
+      ! coeficient for linearisation of potential tfreez
+      ! Crude approximation for pressure (but commonly used)
+      zlamb1 =-0.0573_wp
+      zlamb2 = 0.0832_wp
+      zlamb3 =-7.53e-08_wp * grav * rau0
       IF( nn_timing == 1 )  CALL timing_start('sbc_isf_cav')
       !
-      CALL wrk_alloc( jpi,jpj, zfrz,zpress,zti, zgammat2d, zgammas2d )
-
-      zcfac=0.0_wp 
-      IF (ln_conserve)  zcfac=1.0_wp
-      zpress(:,:)=0.0_wp
-      zgammat2d(:,:)=0.0_wp
-      zgammas2d(:,:)=0.0_wp
-      !
-      !
-!CDIR COLLAPSE
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ! Crude approximation for pressure (but commonly used)
-            ! 1e-04 to convert from Pa to dBar
-            zpress(ji,jj)=grav*rau0*fsdepw(ji,jj,mikt(ji,jj))*1.e-04
-            !
-         END DO
+      CALL wrk_alloc( jpi,jpj, zfrz  , zgammat, zgammas  )
+      CALL wrk_alloc( jpi,jpj, zfwflx, zhtflx , zhtflx_b )
+
+      ! initialisation
+      zgammat(:,:) = rn_gammat0 ; zgammas (:,:) = rn_gammas0
+      zhtflx (:,:) = 0.0_wp     ; zhtflx_b(:,:) = 0.0_wp    
+      zfwflx (:,:) = 0.0_wp
+
+      ! compute ice shelf melting
+      nit = 1 ; lit = .TRUE.
+      DO WHILE ( lit )    ! maybe just a constant number of iteration as in blk_core is fine
+         SELECT CASE ( nn_isfblk )
+         CASE ( 1 )   !  ISOMIP formulation (2 equations) for volume flux (Hunter et al., 2006)
+            ! Calculate freezing temperature
+            CALL eos_fzp( stbl(:,:), zfrz(:,:), risfdep(:,:) )
+
+            ! compute gammat every where (2d)
+            CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx)
+            
+            ! compute upward heat flux zhtflx and upward water flux zwflx
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zhtflx(ji,jj) =   zgammat(ji,jj)*rcp*rau0*(ttbl(ji,jj)-zfrz(ji,jj))
+                  zfwflx(ji,jj) = - zhtflx(ji,jj)/rlfusisf
+               END DO
+            END DO
+
+            ! Compute heat flux and upward fresh water flux
+            qisf  (:,:) = - zhtflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
+            fwfisf(:,:) =   zfwflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
+
+         CASE ( 2 )  ! ISOMIP+ formulation (3 equations) for volume flux (Asay-Davis et al., 2015)
+            ! compute gammat every where (2d)
+            CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx)
+
+            ! compute upward heat flux zhtflx and upward water flux zwflx
+            ! Resolution of a 2d equation from equation 21, 22 and 23 to find Sb (Asay-Davis et al., 2015)
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! compute coeficient to solve the 2nd order equation
+                  zeps1 = rcp*rau0*zgammat(ji,jj)
+                  zeps2 = rlfusisf*rau0*zgammas(ji,jj)
+                  zeps3 = rhoisf*rcpi*rkappa/MAX(risfdep(ji,jj),zeps)
+                  zeps4 = zlamb2+zlamb3*risfdep(ji,jj)
+                  zeps6 = zeps4-ttbl(ji,jj)
+                  zeps7 = zeps4-tsurf
+                  zaqe  = zlamb1 * (zeps1 + zeps3)
+                  zaqer = 0.5_wp/MIN(zaqe,-zeps)
+                  zbqe  = zeps1*zeps6+zeps3*zeps7-zeps2
+                  zcqe  = zeps2*stbl(ji,jj)
+                  zdis  = zbqe*zbqe-4.0_wp*zaqe*zcqe               
+
+                  ! Presumably zdis can never be negative because gammas is very small compared to gammat
+                  ! compute s freeze
+                  zsfrz=(-zbqe-SQRT(zdis))*zaqer
+                  IF ( zsfrz < 0.0_wp ) zsfrz=(-zbqe+SQRT(zdis))*zaqer
+
+                  ! compute t freeze (eq. 22)
+                  zfrz(ji,jj)=zeps4+zlamb1*zsfrz
+  
+                  ! zfwflx is upward water flux
+                  ! zhtflx is upward heat flux (out of ocean)
+                  ! compute the upward water and heat flux (eq. 28 and eq. 29)
+                  zfwflx(ji,jj) = rau0 * zgammas(ji,jj) * (zsfrz-stbl(ji,jj)) / MAX(zsfrz,zeps)
+                  zhtflx(ji,jj) = zgammat(ji,jj) * rau0 * rcp * (ttbl(ji,jj) - zfrz(ji,jj) ) 
+               END DO
+            END DO
+
+            ! compute heat and water flux
+            qisf  (:,:) = - zhtflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
+            fwfisf(:,:) =   zfwflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
+
+         END SELECT
+
+         ! define if we need to iterate (nn_gammablk 0/1 do not need iteration)
+         IF ( nn_gammablk <  2 ) THEN ; lit = .FALSE.
+         ELSE                           
+            ! check total number of iteration
+            IF (nit >= 100) THEN ; CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' )
+            ELSE                 ; nit = nit + 1
+            END IF
+
+            ! compute error between 2 iterations
+            ! if needed save gammat and compute zhtflx_b for next iteration
+            zerr = MAXVAL(ABS(zhtflx-zhtflx_b))
+            IF ( zerr <= 0.01_wp ) THEN ; lit = .FALSE.
+            ELSE                        ; zhtflx_b(:,:) = zhtflx(:,:)
+            END IF
+         END IF
       END DO
-
-! Calculate in-situ temperature (ref to surface)
-      zti(:,:)=tinsitu( ttbl, stbl, zpress )
-! Calculate freezing temperature
-      CALL eos_fzp( sss_m(:,:), zfrz(:,:), zpress )
-
-      
-      zhtflx=0._wp ; zfwflx=0._wp
-      IF (nn_isfblk == 1) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF (mikt(ji,jj) > 1 ) THEN
-                  nit = 1; lit = .TRUE.; zgammat=rn_gammat0; zgammas=rn_gammas0; zhtflx_b=0._wp
-                  DO WHILE ( lit )
-! compute gamma
-                     CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx, ji, jj, lit)
-! zhtflx is upward heat flux (out of ocean)
-                     zhtflx = zgammat*rcp*rau0*(zti(ji,jj)-zfrz(ji,jj))
-! zwflx is upward water flux
-                     zfwflx = - zhtflx/lfusisf
-! test convergence and compute gammat
-                     IF ( (zhtflx - zhtflx_b) .LE. 0.01 ) lit = .FALSE.
-
-                     nit = nit + 1
-                     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
-                     zhtflx_b = zhtflx
-                  END DO
-
-                  qisf(ji,jj) = - zhtflx
-! For genuine ISOMIP protocol this should probably be something like
-                  fwfisf(ji,jj) = zfwflx  * ( soce / MAX(stbl(ji,jj),zeps))
-               ELSE
-                  fwfisf(ji,jj) = 0._wp
-                  qisf(ji,jj)   = 0._wp
-               END IF
-            !
-            END DO
-         END DO
-
-      ELSE IF (nn_isfblk == 2 ) THEN
-
-! More complicated 3 equation thermodynamics as in MITgcm
-!CDIR COLLAPSE
-         DO jj = 2, jpj
-            DO ji = 2, jpi
-               IF (mikt(ji,jj) > 1 ) THEN
-                  nit=1; lit=.TRUE.; zgammat=rn_gammat0; zgammas=rn_gammas0; zhtflx_b=0._wp; zhtflx=0._wp
-                  DO WHILE ( lit )
-                     CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx, ji, jj, lit)
-
-                     zeps1=rcp*rau0*zgammat
-                     zeps2=lfusisf*rau0*zgammas
-                     zeps3=rhoisf*rcpi*kappa/risfdep(ji,jj)
-                     zeps4=zlamb2+zlamb3*risfdep(ji,jj)
-                     zeps6=zeps4-zti(ji,jj)
-                     zeps7=zeps4-tsurf
-                     zaqe=zlamb1 * (zeps1 + zeps3)
-                     zaqer=0.5/zaqe
-                     zbqe=zeps1*zeps6+zeps3*zeps7-zeps2
-                     zcqe=zeps2*stbl(ji,jj)
-                     zdis=zbqe*zbqe-4.0*zaqe*zcqe               
-! Presumably zdis can never be negative because gammas is very small compared to gammat
-                     zsfrz=(-zbqe-SQRT(zdis))*zaqer
-                     IF (zsfrz .lt. 0.0) zsfrz=(-zbqe+SQRT(zdis))*zaqer
-                     zfrz(ji,jj)=zeps4+zlamb1*zsfrz
-  
-! zfwflx is upward water flux
-                     zfwflx= rau0 * zgammas * ( (zsfrz-stbl(ji,jj)) / zsfrz )
-! zhtflx is upward heat flux (out of ocean)
-! If non conservative we have zcfac=0.0 so zhtflx is as ISOMIP but with different zfrz value
-                     zhtflx = ( zgammat*rau0 - zcfac*zfwflx ) * rcp * (zti(ji,jj) - zfrz(ji,jj) ) 
-! zwflx is upward water flux
-! If non conservative we have zcfac=0.0 so what follows is then zfwflx*sss_m/zsfrz
-                     zfwflx = ( zgammas*rau0 - zcfac*zfwflx ) * (zsfrz - stbl(ji,jj)) / stbl(ji,jj)
-! test convergence and compute gammat
-                     IF (( zhtflx - zhtflx_b) .LE. 0.01 ) lit = .FALSE.
-
-                     nit = nit + 1
-                     IF (nit .GE. 51) THEN
-                        WRITE(numout,*) "sbcisf : too many iteration ... ", &
-                            &  zhtflx, zhtflx_b, zgammat, zgammas, nn_gammablk, ji, jj, mikt(ji,jj), narea
-                        CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' )
-                     END IF
-! save gammat and compute zhtflx_b
-                     zgammat2d(ji,jj)=zgammat
-                     zgammas2d(ji,jj)=zgammas
-                     zhtflx_b = zhtflx
-
-                  END DO
-! If non conservative we have zcfac=0.0 so zhtflx is as ISOMIP but with different zfrz value
-                  qisf(ji,jj) = - zhtflx 
-! If non conservative we have zcfac=0.0 so what follows is then zfwflx*sss_m/zsfrz
-                  fwfisf(ji,jj) = zfwflx 
-               ELSE
-                  fwfisf(ji,jj) = 0._wp
-                  qisf(ji,jj)   = 0._wp
-               ENDIF
-               !
-            END DO
-         END DO
-      ENDIF
-      ! lbclnk
-      CALL lbc_lnk(zgammas2d(:,:),'T',1.)
-      CALL lbc_lnk(zgammat2d(:,:),'T',1.)
-      ! output
-      CALL iom_put('isfgammat', zgammat2d)
-      CALL iom_put('isfgammas', zgammas2d)
-      !
-      CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zgammat2d, zgammas2d )
+      !
+      CALL iom_put('isfgammat', zgammat)
+      CALL iom_put('isfgammas', zgammas)
+      ! 
+      CALL wrk_dealloc( jpi,jpj, zfrz  , zgammat, zgammas  )
+      CALL wrk_dealloc( jpi,jpj, zfwflx, zhtflx , zhtflx_b )
       !
       IF( nn_timing == 1 )  CALL timing_stop('sbc_isf_cav')
-
+      !
    END SUBROUTINE sbc_isf_cav
 
-   SUBROUTINE sbc_isf_gammats(gt, gs, zqhisf, zqwisf, ji, jj, lit )
+   SUBROUTINE sbc_isf_gammats(pgt, pgs, pqhisf, pqwisf )
       !!----------------------------------------------------------------------
       !! ** Purpose    : compute the coefficient echange for heat flux
@@ -577,10 +545,10 @@
       !!                Jenkins et al., 2010, JPO, p2298-2312
       !!---------------------------------------------------------------------
-      REAL(wp), INTENT(inout) :: gt, gs, zqhisf, zqwisf
-      INTEGER , INTENT(in)    :: ji,jj
-      LOGICAL , INTENT(inout) :: lit
-
-      INTEGER  :: ikt                 ! loop index
-      REAL(wp) :: zut, zvt, zustar           ! U, V at T point and friction velocity
+      REAL(wp), DIMENSION(:,:), INTENT(out) :: pgt, pgs
+      REAL(wp), DIMENSION(:,:), INTENT(in ) :: pqhisf, pqwisf
+      !
+      INTEGER  :: ikt                        
+      INTEGER  :: ji, jj                     ! loop index
+      REAL(wp), DIMENSION(:,:), POINTER :: zustar           ! U, V at T point and friction velocity
       REAL(wp) :: zdku, zdkv                 ! U, V shear 
       REAL(wp) :: zPr, zSc, zRc              ! Prandtl, Scmidth and Richardson number 
@@ -592,169 +560,212 @@
       REAL(wp) :: zcoef                      ! temporary coef
       REAL(wp) :: zdep
-      REAL(wp), PARAMETER :: zxsiN = 0.052   ! dimensionless constant
-      REAL(wp), PARAMETER :: epsln = 1.0e-20 ! a small positive number
-      REAL(wp), PARAMETER :: znu   = 1.95e-6 ! kinamatic viscosity of sea water (m2.s-1)
-      REAL(wp) ::   rcs      = 1.0e-3_wp        ! conversion: mm/s ==> m/s
+      REAL(wp) :: zeps = 1.0e-20_wp    
+      REAL(wp), PARAMETER :: zxsiN = 0.052_wp   ! dimensionless constant
+      REAL(wp), PARAMETER :: znu   = 1.95e-6_wp ! kinamatic viscosity of sea water (m2.s-1)
       REAL(wp), DIMENSION(2) :: zts, zab
       !!---------------------------------------------------------------------
-      !
-      IF( nn_gammablk == 0 ) THEN
-      !! gamma is constant (specified in namelist)
-         gt = rn_gammat0
-         gs = rn_gammas0
-         lit = .FALSE.
-      ELSE IF ( nn_gammablk == 1 ) THEN
-      !! gamma is assume to be proportional to u* 
-      !! WARNING in case of Losh 2008 tbl parametrization, 
-      !! you have to used the mean value of u in the boundary layer) 
-      !! not yet coded
-      !! Jenkins et al., 2010, JPO, p2298-2312
-         ikt = mikt(ji,jj)
-      !! Compute U and V at T points
-   !      zut = 0.5 * ( utbl(ji-1,jj  ) + utbl(ji,jj) )
-   !      zvt = 0.5 * ( vtbl(ji  ,jj-1) + vtbl(ji,jj) )
-          zut = utbl(ji,jj)
-          zvt = vtbl(ji,jj)
-
-      !! compute ustar
-         zustar = SQRT( rn_tfri2 * (zut * zut + zvt * zvt) )
-      !! Compute mean value over the TBL
-
-      !! Compute gammats
-         gt = zustar * rn_gammat0
-         gs = zustar * rn_gammas0
-         lit = .FALSE.
-      ELSE IF ( nn_gammablk == 2 ) THEN
-      !! gamma depends of stability of boundary layer
-      !! WARNING in case of Losh 2008 tbl parametrization, 
-      !! you have to used the mean value of u in the boundary layer) 
-      !! not yet coded
-      !! Holland and Jenkins, 1999, JPO, p1787-1800, eq 14
-      !! as MOL depends of flux and flux depends of MOL, best will be iteration (TO DO)
+      CALL wrk_alloc( jpi,jpj, zustar )
+      !
+      SELECT CASE ( nn_gammablk )
+      CASE ( 0 ) ! gamma is constant (specified in namelist)
+         !! ISOMIP formulation (Hunter et al, 2006)
+         pgt(:,:) = rn_gammat0
+         pgs(:,:) = rn_gammas0
+
+      CASE ( 1 ) ! gamma is assume to be proportional to u*
+         !! Jenkins et al., 2010, JPO, p2298-2312
+         !! Adopted by Asay-Davis et al. (2015)
+
+         !! compute ustar (eq. 24)
+         zustar(:,:) = SQRT( rn_tfri2 * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + rn_tfeb2) )
+
+         !! Compute gammats
+         pgt(:,:) = zustar(:,:) * rn_gammat0
+         pgs(:,:) = zustar(:,:) * rn_gammas0
+      
+      CASE ( 2 ) ! gamma depends of stability of boundary layer
+         !! Holland and Jenkins, 1999, JPO, p1787-1800, eq 14
+         !! as MOL depends of flux and flux depends of MOL, best will be iteration (TO DO)
+         !! compute ustar
+         zustar(:,:) = SQRT( rn_tfri2 * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + rn_tfeb2) )
+
+         !! compute Pr and Sc number (can be improved)
+         zPr =   13.8_wp
+         zSc = 2432.0_wp
+
+         !! compute gamma mole
+         zgmolet = 12.5_wp * zPr ** (2.0/3.0) - 6.0_wp
+         zgmoles = 12.5_wp * zSc ** (2.0/3.0) - 6.0_wp
+
+         !! compute gamma
+         DO ji=2,jpi
+            DO jj=2,jpj
                ikt = mikt(ji,jj)
 
-      !! Compute U and V at T points
-               zut = 0.5 * ( utbl(ji-1,jj  ) + utbl(ji,jj) )
-               zvt = 0.5 * ( vtbl(ji  ,jj-1) + vtbl(ji,jj) )
-
-      !! compute ustar
-               zustar = SQRT( rn_tfri2 * (zut * zut + zvt * zvt) )
-               IF (zustar == 0._wp) THEN           ! only for kt = 1 I think
-                 gt = rn_gammat0
-                 gs = rn_gammas0
+               IF (zustar(ji,jj) == 0._wp) THEN           ! only for kt = 1 I think
+                  pgt = rn_gammat0
+                  pgs = rn_gammas0
                ELSE
-      !! compute Rc number (as done in zdfric.F90)
-               zcoef = 0.5 / fse3w(ji,jj,ikt)
-               !                                            ! shear of horizontal velocity
-               zdku = zcoef * (  un(ji-1,jj  ,ikt  ) + un(ji,jj,ikt  )   &
-                  &             -un(ji-1,jj  ,ikt+1) - un(ji,jj,ikt+1)  )
-               zdkv = zcoef * (  vn(ji  ,jj-1,ikt  ) + vn(ji,jj,ikt  )   &
-                  &             -vn(ji  ,jj-1,ikt+1) - vn(ji,jj,ikt+1)  )
-               !                                            ! richardson number (minimum value set to zero)
-               zRc = rn2(ji,jj,ikt+1) / ( zdku*zdku + zdkv*zdkv + 1.e-20 )
-
-      !! compute Pr and Sc number (can be improved)
-               zPr =   13.8
-               zSc = 2432.0
-
-      !! compute gamma mole
-               zgmolet = 12.5 * zPr ** (2.0/3.0) - 6.0
-               zgmoles = 12.5 * zSc ** (2.0/3.0) -6.0
-
-      !! compute bouyancy 
-               zts(jp_tem) = ttbl(ji,jj)
-               zts(jp_sal) = stbl(ji,jj)
-               zdep        = fsdepw(ji,jj,ikt)
-               !
-               CALL eos_rab( zts, zdep, zab )
+                  !! compute Rc number (as done in zdfric.F90)
+                  zcoef = 0.5_wp / e3w_n(ji,jj,ikt)
+                  !                                            ! shear of horizontal velocity
+                  zdku = zcoef * (  un(ji-1,jj  ,ikt  ) + un(ji,jj,ikt  )  &
+                     &             -un(ji-1,jj  ,ikt+1) - un(ji,jj,ikt+1)  )
+                  zdkv = zcoef * (  vn(ji  ,jj-1,ikt  ) + vn(ji,jj,ikt  )  &
+                     &             -vn(ji  ,jj-1,ikt+1) - vn(ji,jj,ikt+1)  )
+                  !                                            ! richardson number (minimum value set to zero)
+                  zRc = rn2(ji,jj,ikt+1) / MAX( zdku*zdku + zdkv*zdkv, zeps )
+
+                  !! compute bouyancy 
+                  zts(jp_tem) = ttbl(ji,jj)
+                  zts(jp_sal) = stbl(ji,jj)
+                  zdep        = gdepw_n(ji,jj,ikt)
                   !
-      !! compute length scale 
-               zbuofdep = grav * ( zab(jp_tem) * zqhisf - zab(jp_sal) * zqwisf )  !!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      !! compute Monin Obukov Length
-               ! Maximum boundary layer depth
-               zhmax = fsdept(ji,jj,mbkt(ji,jj)) - fsdepw(ji,jj,mikt(ji,jj)) -0.001
-               ! Compute Monin obukhov length scale at the surface and Ekman depth:
-               zmob   = zustar ** 3 / (vkarmn * (zbuofdep + epsln))
-               zmols  = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt)
-
-      !! compute eta* (stability parameter)
-               zetastar = 1 / ( SQRT(1 + MAX(zxsiN * zustar / ( ABS(ff(ji,jj)) * zmols * zRc ), 0.0)))
-
-      !! compute the sublayer thickness
-               zhnu = 5 * znu / zustar
-      !! compute gamma turb
-               zgturb = 1/vkarmn * LOG(zustar * zxsiN * zetastar * zetastar / ( ABS(ff(ji,jj)) * zhnu )) &
-               &      + 1 / ( 2 * zxsiN * zetastar ) - 1/vkarmn
-
-      !! compute gammats
-               gt = zustar / (zgturb + zgmolet)
-               gs = zustar / (zgturb + zgmoles)
+                  CALL eos_rab( zts, zdep, zab )
+                  !
+                  !! compute length scale 
+                  zbuofdep = grav * ( zab(jp_tem) * pqhisf(ji,jj) - zab(jp_sal) * pqwisf(ji,jj) )  !!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+                  !! compute Monin Obukov Length
+                  ! Maximum boundary layer depth
+                  zhmax = gdept_n(ji,jj,mbkt(ji,jj)) - gdepw_n(ji,jj,mikt(ji,jj)) -0.001_wp
+                  ! Compute Monin obukhov length scale at the surface and Ekman depth:
+                  zmob   = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps))
+                  zmols  = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt)
+
+                  !! compute eta* (stability parameter)
+                  zetastar = 1._wp / ( SQRT(1._wp + MAX(zxsiN * zustar(ji,jj) / ( ABS(ff(ji,jj)) * zmols * zRc ), 0.0_wp)))
+
+                  !! compute the sublayer thickness
+                  zhnu = 5 * znu / zustar(ji,jj)
+
+                  !! compute gamma turb
+                  zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / ( ABS(ff(ji,jj)) * zhnu )) &
+                  &      + 1._wp / ( 2 * zxsiN * zetastar ) - 1._wp / vkarmn
+
+                  !! compute gammats
+                  pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet)
+                  pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles)
                END IF
-      END IF
-
-   END SUBROUTINE
-
-   SUBROUTINE sbc_isf_tbl( varin, varout, cptin )
+            END DO
+         END DO
+         CALL lbc_lnk(pgt(:,:),'T',1.)
+         CALL lbc_lnk(pgs(:,:),'T',1.)
+      END SELECT
+      CALL wrk_dealloc( jpi,jpj, zustar )
+      !
+   END SUBROUTINE sbc_isf_gammats
+
+   SUBROUTINE sbc_isf_tbl( pvarin, pvarout, cd_ptin )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE sbc_isf_tbl  ***
       !!
-      !! ** Purpose : compute mean T/S/U/V in the boundary layer 
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(in) :: varin
-      REAL(wp), DIMENSION(:,:)  , INTENT(out):: varout
+      !! ** Purpose : compute mean T/S/U/V in the boundary layer at T- point
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT( in  ) :: pvarin
+      REAL(wp), DIMENSION(:,:)  , INTENT( out ) :: pvarout
+      CHARACTER(len=1),           INTENT( in  ) :: cd_ptin ! point of variable in/out
+      !
+      REAL(wp) :: ze3, zhk
+      REAL(wp), DIMENSION(:,:), POINTER :: zhisf_tbl ! thickness of the tbl
+
+      INTEGER :: ji, jj, jk                  ! loop index
+      INTEGER :: ikt, ikb                    ! top and bottom index of the tbl
+      !!----------------------------------------------------------------------
+      ! allocation
+      CALL wrk_alloc( jpi,jpj, zhisf_tbl)
       
-      CHARACTER(len=1), INTENT(in) :: cptin ! point of variable in/out
-
-      REAL(wp) :: ze3, zhk
-      REAL(wp), DIMENSION(:,:), POINTER :: zikt
-
-      INTEGER :: ji,jj,jk
-      INTEGER :: ikt,ikb
-      INTEGER, DIMENSION(:,:), POINTER :: mkt, mkb
-
-      CALL wrk_alloc( jpi,jpj, mkt, mkb  )
-      CALL wrk_alloc( jpi,jpj, zikt )
-
-      ! get first and last level of tbl
-      mkt(:,:) = misfkt(:,:)
-      mkb(:,:) = misfkb(:,:)
-
-      varout(:,:)=0._wp
-      DO jj = 2,jpj
-         DO ji = 2,jpi
-            IF (ssmask(ji,jj) == 1) THEN
-               ikt = mkt(ji,jj)
-               ikb = mkb(ji,jj)
+      ! initialisation
+      pvarout(:,:)=0._wp
+   
+      SELECT CASE ( cd_ptin )
+      CASE ( 'U' ) ! compute U in the top boundary layer at T- point 
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               ikt = miku(ji,jj) ; ikb = miku(ji,jj)
+               ! thickness of boundary layer at least the top level thickness
+               zhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3u_n(ji,jj,ikt))
+
+               ! determine the deepest level influenced by the boundary layer
+               DO jk = ikt+1, mbku(ji,jj)
+                  IF ( (SUM(e3u_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (umask(ji,jj,jk) == 1) ) ikb = jk
+               END DO
+               zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3u_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
 
                ! level fully include in the ice shelf boundary layer
                DO jk = ikt, ikb - 1
-                  ze3 = fse3t_n(ji,jj,jk)
-                  IF (cptin == 'T' ) varout(ji,jj) = varout(ji,jj) + varin(ji,jj,jk) * r1_hisf_tbl(ji,jj) * ze3
-                  IF (cptin == 'U' ) varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,jk) + varin(ji-1,jj,jk)) &
-                     &                                                       * r1_hisf_tbl(ji,jj) * ze3
-                  IF (cptin == 'V' ) varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,jk) + varin(ji,jj-1,jk)) &
-                     &                                                       * r1_hisf_tbl(ji,jj) * ze3
+                  ze3 = e3u_n(ji,jj,jk)
+                  pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) / zhisf_tbl(ji,jj) * ze3
                END DO
 
                ! level partially include in ice shelf boundary layer 
-               zhk = SUM( fse3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)
-               IF (cptin == 'T') &
-                   &  varout(ji,jj) = varout(ji,jj) + varin(ji,jj,ikb) * (1._wp - zhk)
-               IF (cptin == 'U') &
-                   &  varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,ikb) + varin(ji-1,jj,ikb)) * (1._wp - zhk)
-               IF (cptin == 'V') &
-                   &  varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,ikb) + varin(ji,jj-1,ikb)) * (1._wp - zhk)
-            END IF
-         END DO
-      END DO
-
-      CALL wrk_dealloc( jpi,jpj, mkt, mkb )      
-      CALL wrk_dealloc( jpi,jpj, zikt ) 
-
-      IF (cptin == 'T') CALL lbc_lnk(varout,'T',1.)
-      IF (cptin == 'U' .OR. cptin == 'V') CALL lbc_lnk(varout,'T',-1.)
-
+               zhk = SUM( e3u_n(ji, jj, ikt:ikb - 1)) / zhisf_tbl(ji,jj)
+               pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk)
+            END DO
+         END DO
+         DO jj = 2,jpj
+            DO ji = 2,jpi
+               pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji-1,jj))
+            END DO
+         END DO
+         CALL lbc_lnk(pvarout,'T',-1.)
+      
+      CASE ( 'V' ) ! compute V in the top boundary layer at T- point 
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               ikt = mikv(ji,jj) ; ikb = mikv(ji,jj)
+               ! thickness of boundary layer at least the top level thickness
+               zhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3v_n(ji,jj,ikt))
+
+               ! determine the deepest level influenced by the boundary layer
+               DO jk = ikt+1, mbkv(ji,jj)
+                  IF ( (SUM(e3v_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (vmask(ji,jj,jk) == 1) ) ikb = jk
+               END DO
+               zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3v_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
+
+               ! level fully include in the ice shelf boundary layer
+               DO jk = ikt, ikb - 1
+                  ze3 = e3v_n(ji,jj,jk)
+                  pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) / zhisf_tbl(ji,jj) * ze3
+               END DO
+
+               ! level partially include in ice shelf boundary layer 
+               zhk = SUM( e3v_n(ji, jj, ikt:ikb - 1)) / zhisf_tbl(ji,jj)
+               pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk)
+            END DO
+         END DO
+         DO jj = 2,jpj
+            DO ji = 2,jpi
+               pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji,jj-1))
+            END DO
+         END DO
+         CALL lbc_lnk(pvarout,'T',-1.)
+
+      CASE ( 'T' ) ! compute T in the top boundary layer at T- point 
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               ikt = misfkt(ji,jj)
+               ikb = misfkb(ji,jj)
+
+               ! level fully include in the ice shelf boundary layer
+               DO jk = ikt, ikb - 1
+                  ze3 = e3t_n(ji,jj,jk)
+                  pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) * r1_hisf_tbl(ji,jj) * ze3
+               END DO
+
+               ! level partially include in ice shelf boundary layer 
+               zhk = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)
+               pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk)
+            END DO
+         END DO
+      END SELECT
+
+      ! mask mean tbl value
+      pvarout(:,:) = pvarout(:,:) * ssmask(:,:)
+
+      ! deallocation
+      CALL wrk_dealloc( jpi,jpj, zhisf_tbl )      
+      !
    END SUBROUTINE sbc_isf_tbl
       
@@ -772,16 +783,15 @@
       !! ** Action  :   phdivn   decreased by the runoff inflow
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
-      !!
+      REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   phdivn   ! horizontal divergence
+      ! 
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       INTEGER  ::   ikt, ikb 
-      INTEGER  ::   nk_isf
-      REAL(wp)     ::   zhk, z1_hisf_tbl, zhisf_tbl
-      REAL(wp)     ::   zfact     ! local scalar
+      REAL(wp) ::   zhk
+      REAL(wp) ::   zfact     ! local scalar
       !!----------------------------------------------------------------------
       !
       zfact   = 0.5_wp
       !
-      IF (lk_vvl) THEN     ! need to re compute level distribution of isf fresh water
+      IF(.NOT.ln_linssh ) THEN     ! need to re compute level distribution of isf fresh water
          DO jj = 1,jpj
             DO ji = 1,jpi
@@ -789,21 +799,21 @@
                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(ji,jj,ikt))
+               rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t_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(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.
+                  IF ( (SUM(e3t_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(e3t_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 ! vvl case
-      !
+               zhk           = SUM( e3t_n(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 ) / e3t_n(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer
+            END DO
+         END DO
+      END IF 
+      !
+      !==   ice shelf melting distributed over several levels   ==!
       DO jj = 1,jpj
          DO ji = 1,jpi
@@ -813,89 +823,13 @@
                DO jk = ikt, ikb - 1
                   phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + ( fwfisf(ji,jj) + fwfisf_b(ji,jj) ) &
-                    &               * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact
+                    &              * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact
                END DO
                ! level partially include in ice shelf boundary layer 
                phdivn(ji,jj,ikb) = phdivn(ji,jj,ikb) + ( fwfisf(ji,jj) &
-                  &             + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact * ralpha(ji,jj) 
-            !==   ice shelf melting mass distributed over several levels   ==!
+                    &            + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact * ralpha(ji,jj) 
          END DO
       END DO
       !
    END SUBROUTINE sbc_isf_div
-                        
-   FUNCTION tinsitu( ptem, psal, ppress ) RESULT( pti )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE eos_init  ***
-      !!
-      !! ** Purpose :   Compute the in-situ temperature [Celcius]
-      !!
-      !! ** Method  :   
-      !!
-      !! Reference  :   Bryden,h.,1973,deep-sea res.,20,401-408
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptem   ! potential temperature [Celcius]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ppress ! pressure             [dBar]
-      REAL(wp), DIMENSION(:,:), POINTER           ::   pti    ! in-situ temperature [Celcius]
-!      REAL(wp) :: fsatg
-!      REAL(wp) :: pfps, pfpt, pfphp 
-      REAL(wp) :: zt, zs, zp, zh, zq, zxk
-      INTEGER  :: ji, jj            ! dummy loop indices
-      !
-      CALL wrk_alloc( jpi,jpj, pti  )
-      ! 
-      DO jj=1,jpj
-         DO ji=1,jpi
-            zh = ppress(ji,jj)
-! Theta1
-            zt = ptem(ji,jj)
-            zs = psal(ji,jj)
-            zp = 0.0
-            zxk= zh * fsatg( zs, zt, zp )
-            zt = zt + 0.5 * zxk
-            zq = zxk
-! Theta2
-            zp = zp + 0.5 * zh
-            zxk= zh*fsatg( zs, zt, zp )
-            zt = zt + 0.29289322 * ( zxk - zq )
-            zq = 0.58578644 * zxk + 0.121320344 * zq
-! Theta3
-            zxk= zh * fsatg( zs, zt, zp )
-            zt = zt + 1.707106781 * ( zxk - zq )
-            zq = 3.414213562 * zxk - 4.121320344 * zq
-! Theta4
-            zp = zp + 0.5 * zh
-            zxk= zh * fsatg( zs, zt, zp )
-            pti(ji,jj) = zt + ( zxk - 2.0 * zq ) / 6.0
-         END DO
-      END DO
-      !
-      CALL wrk_dealloc( jpi,jpj, pti  )
-      !
-   END FUNCTION tinsitu
-   !
-   FUNCTION fsatg( pfps, pfpt, pfphp )
-      !!----------------------------------------------------------------------
-      !!                 ***  FUNCTION fsatg  ***
-      !!
-      !! ** Purpose    :   Compute the Adiabatic laspse rate [Celcius].[decibar]^-1
-      !!
-      !! ** Reference  :   Bryden,h.,1973,deep-sea res.,20,401-408
-      !! 
-      !! ** units      :   pressure        pfphp    decibars
-      !!                   temperature     pfpt     deg celsius (ipts-68)
-      !!                   salinity        pfps     (ipss-78)
-      !!                   adiabatic       fsatg    deg. c/decibar
-      !!----------------------------------------------------------------------
-      REAL(wp) :: pfps, pfpt, pfphp 
-      REAL(wp) :: fsatg
-      !
-      fsatg = (((-2.1687e-16*pfpt+1.8676e-14)*pfpt-4.6206e-13)*pfphp         &
-        &    +((2.7759e-12*pfpt-1.1351e-10)*(pfps-35.)+((-5.4481e-14*pfpt    &
-        &    +8.733e-12)*pfpt-6.7795e-10)*pfpt+1.8741e-8))*pfphp             &
-        &    +(-4.2393e-8*pfpt+1.8932e-6)*(pfps-35.)                         &
-        &    +((6.6228e-10*pfpt-6.836e-8)*pfpt+8.5258e-6)*pfpt+3.5803e-5
-      !
-    END FUNCTION fsatg
-    !!======================================================================
+   !!======================================================================
 END MODULE sbcisf
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 6808)
@@ -17,41 +17,44 @@
 
    !!----------------------------------------------------------------------
-   !!   sbc_init       : read namsbc namelist
-   !!   sbc            : surface ocean momentum, heat and freshwater boundary conditions
+   !!   sbc_init      : read namsbc namelist
+   !!   sbc           : surface ocean momentum, heat and freshwater boundary conditions
    !!----------------------------------------------------------------------
-   USE oce              ! ocean dynamics and tracers
-   USE dom_oce          ! ocean space and time domain
-   USE phycst           ! physical constants
-   USE sbc_oce          ! Surface boundary condition: ocean fields
-   USE trc_oce          ! shared ocean-passive tracers variables
-   USE sbc_ice          ! Surface boundary condition: ice fields
-   USE sbcdcy           ! surface boundary condition: diurnal cycle
-   USE sbcssm           ! surface boundary condition: sea-surface mean variables
-   USE sbcapr           ! surface boundary condition: atmospheric pressure
-   USE sbcana           ! surface boundary condition: analytical formulation
-   USE sbcflx           ! surface boundary condition: flux formulation
-   USE sbcblk_clio      ! surface boundary condition: bulk formulation : CLIO
-   USE sbcblk_core      ! surface boundary condition: bulk formulation : CORE
-   USE sbcblk_mfs       ! surface boundary condition: bulk formulation : MFS
-   USE sbcice_if        ! surface boundary condition: ice-if sea-ice model
-   USE sbcice_lim       ! surface boundary condition: LIM 3.0 sea-ice model
-   USE sbcice_lim_2     ! surface boundary condition: LIM 2.0 sea-ice model
-   USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model
-   USE sbccpl           ! surface boundary condition: coupled florulation
-   USE cpl_oasis3       ! OASIS routines for coupling
-   USE sbcssr           ! surface boundary condition: sea surface restoring
-   USE sbcrnf           ! surface boundary condition: runoffs
-   USE sbcisf           ! surface boundary condition: ice shelf
-   USE sbcfwb           ! surface boundary condition: freshwater budget
-   USE closea           ! closed sea
-   USE icbstp           ! Icebergs!
-
-   USE prtctl           ! Print control                    (prt_ctl routine)
-   USE iom              ! IOM library
-   USE in_out_manager   ! I/O manager
-   USE lib_mpp          ! MPP library
-   USE timing           ! Timing
-   USE sbcwave          ! Wave module
-   USE bdy_par          ! Require lk_bdy
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE trc_oce        ! shared ocean-passive tracers variables
+   USE sbc_ice        ! Surface boundary condition: ice fields
+   USE sbcdcy         ! surface boundary condition: diurnal cycle
+   USE sbcssm         ! surface boundary condition: sea-surface mean variables
+   USE sbcana         ! surface boundary condition: analytical formulation
+   USE sbcflx         ! surface boundary condition: flux formulation
+   USE sbcblk_clio    ! surface boundary condition: bulk formulation : CLIO
+   USE sbcblk_core    ! surface boundary condition: bulk formulation : CORE
+   USE sbcblk_mfs     ! surface boundary condition: bulk formulation : MFS
+   USE sbcice_if      ! surface boundary condition: ice-if sea-ice model
+   USE sbcice_lim     ! surface boundary condition: LIM 3.0 sea-ice model
+   USE sbcice_lim_2   ! surface boundary condition: LIM 2.0 sea-ice model
+   USE sbcice_cice    ! surface boundary condition: CICE    sea-ice model
+   USE sbccpl         ! surface boundary condition: coupled florulation
+   USE cpl_oasis3     ! OASIS routines for coupling
+   USE sbcssr         ! surface boundary condition: sea surface restoring
+   USE sbcrnf         ! surface boundary condition: runoffs
+   USE sbcisf         ! surface boundary condition: ice shelf
+   USE sbcfwb         ! surface boundary condition: freshwater budget
+   USE closea         ! closed sea
+   USE icbstp         ! Icebergs
+   USE traqsr         ! active tracers: light penetration
+   USE sbcwave        ! Wave module
+   USE bdy_par        ! Require lk_bdy
+   !
+   USE prtctl         ! Print control                    (prt_ctl routine)
+   USE iom            ! IOM library
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
+
+   USE diurnal_bulk, ONLY: &
+      & ln_diurnal_only 
 
    IMPLICIT NONE
@@ -63,6 +66,4 @@
    INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations)
       
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO-consortium (2011) 
@@ -86,13 +87,16 @@
       INTEGER ::   icpt   ! local integer
       !!
-      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx, ln_blk_clio, ln_blk_core, ln_mixcpl,   &
-         &             ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc   , ln_rnf   ,   &
-         &             ln_ssr    , nn_isf    , nn_fwb, ln_cdgw    , ln_wave    , ln_sdw   ,   &
-         &             nn_lsm    , nn_limflx , nn_components, ln_cpl
+      NAMELIST/namsbc/ nn_fsbc  , ln_ana   , ln_flx, ln_blk_clio, ln_blk_core, ln_blk_mfs,   &
+         &             ln_cpl   , ln_mixcpl, nn_components      , nn_limflx  ,               &
+         &             ln_traqsr, ln_dm2dc ,                                                 &  
+         &             nn_ice   , nn_ice_embd,                                               &
+         &             ln_rnf   , ln_ssr   , ln_isf   , nn_fwb    , ln_apr_dyn,              &
+         &             ln_wave  ,                                                            &
+         &             nn_lsm   
       INTEGER  ::   ios
       INTEGER  ::   ierr, ierr0, ierr1, ierr2, ierr3, jpm
       LOGICAL  ::   ll_purecpl
       !!----------------------------------------------------------------------
-
+      !
       IF(lwp) THEN
          WRITE(numout,*)
@@ -100,14 +104,14 @@
          WRITE(numout,*) '~~~~~~~~ '
       ENDIF
-
+      !
       REWIND( numnam_ref )              ! Namelist namsbc in reference namelist : Surface boundary
       READ  ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp )
-
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp )
+      !
       REWIND( numnam_cfg )              ! Namelist namsbc in configuration namelist : Parameters of the run
       READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namsbc )
-
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp )
+      IF(lwm) WRITE( numond, namsbc )
+      !
       !                          ! overwrite namelist parameter using CPP key information
       IF( Agrif_Root() ) THEN                ! AGRIF zoom
@@ -120,52 +124,54 @@
           nn_ice      =   0
       ENDIF
-
+      !
       IF(lwp) THEN               ! Control print
          WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)'
          WRITE(numout,*) '           frequency update of sbc (and ice)             nn_fsbc     = ', nn_fsbc
-         WRITE(numout,*) '           Type of sbc : '
-         WRITE(numout,*) '              analytical formulation                     ln_ana      = ', ln_ana
-         WRITE(numout,*) '              flux       formulation                     ln_flx      = ', ln_flx
-         WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_clio = ', ln_blk_clio
-         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core
-         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs
-         WRITE(numout,*) '              ocean-atmosphere coupled formulation       ln_cpl      = ', ln_cpl
-         WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl   = ', ln_mixcpl
-         WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis    = ', lk_oasis
+         WRITE(numout,*) '           Type of air-sea fluxes : '
+         WRITE(numout,*) '              analytical formulation                     ln_ana        = ', ln_ana
+         WRITE(numout,*) '              flux       formulation                     ln_flx        = ', ln_flx
+         WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_clio   = ', ln_blk_clio
+         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core   = ', ln_blk_core
+         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs    = ', ln_blk_mfs
+         WRITE(numout,*) '           Type of coupling (Ocean/Ice/Atmosphere) : '
+         WRITE(numout,*) '              ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl
+         WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl     = ', ln_mixcpl
+         WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis      = ', lk_oasis
          WRITE(numout,*) '              components of your executable              nn_components = ', nn_components
-         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx
+         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx     = ', nn_limflx
+         WRITE(numout,*) '           Sea-ice : '
+         WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice        = ', nn_ice 
+         WRITE(numout,*) '              ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd   = ', nn_ice_embd
          WRITE(numout,*) '           Misc. options of sbc : '
-         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn
-         WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice      = ', nn_ice 
-         WRITE(numout,*) '              ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd = ', nn_ice_embd
-         WRITE(numout,*) '              daily mean to diurnal cycle qsr            ln_dm2dc    = ', ln_dm2dc 
-         WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf      = ', ln_rnf
-         WRITE(numout,*) '              iceshelf formulation                       nn_isf      = ', nn_isf
-         WRITE(numout,*) '              Sea Surface Restoring on SST and/or SSS    ln_ssr      = ', ln_ssr
-         WRITE(numout,*) '              FreshWater Budget control  (=0/1/2)        nn_fwb      = ', nn_fwb
-         WRITE(numout,*) '              closed sea (=0/1) (set in namdom)          nn_closea   = ', nn_closea
-         WRITE(numout,*) '              n. of iterations if land-sea-mask applied  nn_lsm      = ', nn_lsm
-      ENDIF
-
-      ! LIM3 Multi-category heat flux formulation
-      SELECT CASE ( nn_limflx)
-      CASE ( -1 )
-         IF(lwp) WRITE(numout,*) '              Use of per-category fluxes (nn_limflx = -1) '
-      CASE ( 0  )
-         IF(lwp) WRITE(numout,*) '              Average per-category fluxes (nn_limflx = 0) ' 
-      CASE ( 1  )
-         IF(lwp) WRITE(numout,*) '              Average then redistribute per-category fluxes (nn_limflx = 1) '
-      CASE ( 2  )
-         IF(lwp) WRITE(numout,*) '              Redistribute a single flux over categories (nn_limflx = 2) '
-      END SELECT
-      !
-      IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis )   &
-         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
-      IF ( nn_components == jp_iam_opa .AND. ln_cpl )   &
-         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' )
-      IF ( nn_components == jp_iam_opa .AND. ln_mixcpl )   &
-         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
-      IF ( ln_cpl .AND. .NOT. lk_oasis )    &
-         &      CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' )
+         WRITE(numout,*) '              Light penetration in temperature Eq.       ln_traqsr     = ', ln_traqsr
+         WRITE(numout,*) '                 daily mean to diurnal cycle qsr            ln_dm2dc   = ', ln_dm2dc 
+         WRITE(numout,*) '              Sea Surface Restoring on SST and/or SSS    ln_ssr        = ', ln_ssr
+         WRITE(numout,*) '              FreshWater Budget control  (=0/1/2)        nn_fwb        = ', nn_fwb
+         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn    = ', ln_apr_dyn
+         WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf        = ', ln_rnf
+         WRITE(numout,*) '              iceshelf formulation                       ln_isf        = ', ln_isf
+         WRITE(numout,*) '              closed sea (=0/1) (set in namdom)          nn_closea     = ', nn_closea
+         WRITE(numout,*) '              nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm
+         WRITE(numout,*) '              surface wave                               ln_wave       = ', ln_wave  
+      ENDIF
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         SELECT CASE ( nn_limflx )        ! LIM3 Multi-category heat flux formulation
+         CASE ( -1 )   ;   WRITE(numout,*) '   LIM3: use per-category fluxes (nn_limflx = -1) '
+         CASE ( 0  )   ;   WRITE(numout,*) '   LIM3: use average per-category fluxes (nn_limflx = 0) ' 
+         CASE ( 1  )   ;   WRITE(numout,*) '   LIM3: use average then redistribute per-category fluxes (nn_limflx = 1) '
+         CASE ( 2  )   ;   WRITE(numout,*) '   LIM3: Redistribute a single flux over categories (nn_limflx = 2) '
+         END SELECT
+      ENDIF
+      !
+      IF( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis )   &
+         &      CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
+      IF( nn_components == jp_iam_opa .AND. ln_cpl )   &
+         &      CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' )
+      IF( nn_components == jp_iam_opa .AND. ln_mixcpl )   &
+         &      CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
+      IF( ln_cpl .AND. .NOT. lk_oasis )    &
+         &      CALL ctl_stop( 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' )
       IF( ln_mixcpl .AND. .NOT. lk_oasis )    &
          &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' )
@@ -176,20 +182,20 @@
 
       !                              ! allocate sbc arrays
-      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' )
+      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'sbc_init : unable to allocate sbc_oce arrays' )
 
       !                          ! Checks:
-      IF( nn_isf .EQ. 0 ) THEN                      ! no specific treatment in vicinity of ice shelf 
+      IF( .NOT. ln_isf ) THEN                      ! variable initialisation if no 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
+         fwfisf  (:,:)   = 0.0_wp ; fwfisf_b  (:,:)   = 0.0_wp
+         risf_tsc(:,:,:) = 0.0_wp ; risf_tsc_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
-
-      sfx(:,:) = 0.0_wp                            ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero) 
+      IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa )   fr_i(:,:) = 0._wp    ! no ice in the domain, ice fraction is always zero
+
+      sfx(:,:) = 0._wp                             ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero) 
                                                    ! only if sea-ice is present
  
-      fmmflx(:,:) = 0.0_wp                        ! freezing-melting array initialisation
+      fmmflx(:,:) = 0._wp                          ! freezing-melting array initialisation
       
-      taum(:,:) = 0.0_wp                           ! Initialise taum for use in gls in case of reduced restart
+      taum(:,:) = 0._wp                            ! Initialise taum for use in gls in case of reduced restart
 
       !                                            ! restartability   
@@ -214,17 +220,4 @@
          &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' )
       
-      IF ( ln_wave ) THEN
-      !Activated wave module but neither drag nor stokes drift activated
-         IF ( .NOT.(ln_cdgw .OR. ln_sdw) )   THEN
-            CALL ctl_warn( 'Ask for wave coupling but nor drag coefficient (ln_cdgw=F) neither stokes drift activated (ln_sdw=F)' )
-      !drag coefficient read from wave model definable only with mfs bulk formulae and core 
-         ELSEIF (ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) )       THEN       
-             CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core')
-         ENDIF
-      ELSE
-      IF ( ln_cdgw .OR. ln_sdw  )                                         & 
-         &   CALL ctl_stop('Not Activated Wave Module (ln_wave=F) but     &
-         & asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ')
-      ENDIF 
       !                          ! Choice of the Surface Boudary Condition (set nsbc)
       ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl
@@ -240,38 +233,31 @@
       IF( nn_components == jp_iam_opa )   &
          &                  THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module
-      IF( lk_esopa        )            nsbc = jp_esopa                                       ! esopa test, ALL formulations
-      !
-      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '           E R R O R in setting the sbc, one and only one namelist/CPP key option '
-         WRITE(numout,*) '                     must be choosen. You choose ', icpt, ' option(s)'
-         WRITE(numout,*) '                     We stop'
-         nstop = nstop + 1
-      ENDIF
+      !
+      IF( icpt /= 1 )    CALL ctl_stop( 'sbc_init: choose ONE and only ONE sbc option' )
+      !
       IF(lwp) THEN
          WRITE(numout,*)
-         IF( nsbc == jp_esopa   )   WRITE(numout,*) '              ESOPA test All surface boundary conditions'
-         IF( nsbc == jp_gyre    )   WRITE(numout,*) '              GYRE analytical formulation'
-         IF( nsbc == jp_ana     )   WRITE(numout,*) '              analytical formulation'
-         IF( nsbc == jp_flx     )   WRITE(numout,*) '              flux formulation'
-         IF( nsbc == jp_clio    )   WRITE(numout,*) '              CLIO bulk formulation'
-         IF( nsbc == jp_core    )   WRITE(numout,*) '              CORE bulk formulation'
-         IF( nsbc == jp_purecpl )   WRITE(numout,*) '              pure coupled formulation'
-         IF( nsbc == jp_mfs     )   WRITE(numout,*) '              MFS Bulk formulation'
-         IF( nsbc == jp_none    )   WRITE(numout,*) '              OPA coupled to SAS via oasis'
-         IF( ln_mixcpl          )   WRITE(numout,*) '              + forced-coupled mixed formulation'
+         SELECT CASE( nsbc )
+         CASE( jp_gyre    )   ;   WRITE(numout,*) '   GYRE analytical formulation'
+         CASE( jp_ana     )   ;   WRITE(numout,*) '   analytical formulation'
+         CASE( jp_flx     )   ;   WRITE(numout,*) '   flux formulation'
+         CASE( jp_clio    )   ;   WRITE(numout,*) '   CLIO bulk formulation'
+         CASE( jp_core    )   ;   WRITE(numout,*) '   CORE bulk formulation'
+         CASE( jp_purecpl )   ;   WRITE(numout,*) '   pure coupled formulation'
+         CASE( jp_mfs     )   ;   WRITE(numout,*) '   MFS Bulk formulation'
+         CASE( jp_none    )   ;   WRITE(numout,*) '   OPA coupled to SAS via oasis'
+            IF( ln_mixcpl )       WRITE(numout,*) '       + forced-coupled mixed formulation'
+         END SELECT
          IF( nn_components/= jp_iam_nemo )  &
-            &                       WRITE(numout,*) '              + OASIS coupled SAS'
+            &                     WRITE(numout,*) '       + OASIS coupled SAS'
       ENDIF
       !
       IF( lk_oasis )   CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step
-      !                                                     !                                            (2) the use of nn_fsbc
-
-!     nn_fsbc initialization if OPA-SAS coupling via OASIS
-!     sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly
-      IF ( nn_components /= jp_iam_nemo ) THEN
-
-         IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt)
-         IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt)
+      !                                             !                                            (2) the use of nn_fsbc
+      !     nn_fsbc initialization if OPA-SAS coupling via OASIS
+      !     sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly
+      IF( nn_components /= jp_iam_nemo ) THEN
+         IF( nn_components == jp_iam_opa )   nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt)
+         IF( nn_components == jp_iam_sas )   nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt)
          !
          IF(lwp)THEN
@@ -281,5 +267,5 @@
          ENDIF
       ENDIF
-
+      !
       IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   &
           MOD( nstock             , nn_fsbc) /= 0 ) THEN 
@@ -294,15 +280,15 @@
       IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   &
          &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
-
-                               CALL sbc_ssm_init               ! Sea-surface mean fields initialisation
-      !
-      IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation
-      !
-                               CALL sbc_rnf_init               ! Runof initialisation
-      !
-      IF( nn_ice == 3      )   CALL sbc_lim_init               ! LIM3 initialisation
-
-      IF( nn_ice == 4      )   CALL cice_sbc_init( nsbc )      ! CICE initialisation
-      
+      !
+                          CALL sbc_ssm_init               ! Sea-surface mean fields initialisation
+      !
+      IF( ln_ssr      )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation
+      !
+                          CALL sbc_rnf_init               ! Runof initialisation
+      !
+      IF( nn_ice == 3 )   CALL sbc_lim_init               ! LIM3 initialisation
+      !
+      IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )      ! CICE initialisation
+      !
    END SUBROUTINE sbc_init
 
@@ -335,8 +321,6 @@
          vtau_b(:,:) = vtau(:,:)                         ! (except at nit000 where before fields
          qns_b (:,:) = qns (:,:)                         !  are set at the end of the routine)
-         ! The 3D heat content due to qsr forcing is treated in traqsr
-         ! qsr_b (:,:) = qsr (:,:)
-         emp_b(:,:) = emp(:,:)
-         sfx_b(:,:) = sfx(:,:)
+         emp_b (:,:) = emp (:,:)
+         sfx_b (:,:) = sfx (:,:)
       ENDIF
       !                                            ! ---------------------------------------- !
@@ -344,13 +328,9 @@
       !                                            ! ---------------------------------------- !
       !
-      IF ( .NOT. lk_bdy ) then
-         IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc
-      ENDIF
-                                                         ! (caution called before sbc_ssm)
-      !
-      IF( nn_components /= jp_iam_sas )   CALL sbc_ssm( kt )   ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
+      IF( nn_components /= jp_iam_sas )   CALL sbc_ssm ( kt )  ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
       !                                                        ! averaged over nf_sbc time-step
-
-      IF (ln_wave) CALL sbc_wave( kt )
+      IF( ln_wave                     )   CALL sbc_wave( kt )  ! surface waves
+      
+      
                                                    !==  sbc formulation  ==!
                                                             
@@ -370,20 +350,13 @@
       CASE( jp_mfs   )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean
       CASE( jp_none  ) 
-         IF( nn_components == jp_iam_opa ) &
-                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS
-      CASE( jp_esopa )                                
-                             CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations
-                             CALL sbc_gyre    ( kt )                    !
-                             CALL sbc_flx     ( kt )                    !
-                             CALL sbc_blk_clio( kt )                    !
-                             CALL sbc_blk_core( kt )                    !
-                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   !
+         IF( nn_components == jp_iam_opa )   &
+            &                CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS
       END SELECT
 
       IF( ln_mixcpl )        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing
 
-
+      !
       !                                            !==  Misc. Options  ==!
-      
+      !
       SELECT CASE( nn_ice )                                       ! Update heat and freshwater fluxes over sea-ice areas
       CASE(  1 )   ;         CALL sbc_ice_if   ( kt )                ! Ice-cover climatology ("Ice-if" model)
@@ -395,5 +368,5 @@
       IF( ln_icebergs    )   CALL icb_stp( kt )                   ! compute icebergs
 
-      IF( nn_isf   /= 0  )   CALL sbc_isf( kt )                    ! compute iceshelves
+      IF( ln_isf         )   CALL sbc_isf( kt )                   ! compute iceshelves
 
       IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes
@@ -403,6 +376,9 @@
       IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
 
-      IF( nn_closea == 1 )   CALL sbc_clo( kt )                   ! treatment of closed sea in the model domain 
-      !                                                           ! (update freshwater fluxes)
+      ! treatment of closed sea in the model domain 
+      ! (update freshwater fluxes)
+      ! Should not be ran if ln_diurnal_only
+      IF( .NOT.(ln_diurnal_only) .AND. (nn_closea == 1) )   CALL sbc_clo( kt )   
+
 !RBbug do not understand why see ticket 667
 !clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
@@ -450,5 +426,4 @@
          CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx  )
       ENDIF
-
       !                                                ! ---------------------------------------- !
       !                                                !        Outputs and control print         !
@@ -472,7 +447,7 @@
       !
       IF(ln_ctl) THEN         ! print mean trends (used for debugging)
-         CALL prt_ctl(tab2d_1=fr_i              , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 )
-         CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 )
-         CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf  - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=fr_i              , clinfo1=' fr_i    - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf - : ', mask1=tmask, ovlap=1 )
          CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 )
          CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 6808)
@@ -12,49 +12,51 @@
 
    !!----------------------------------------------------------------------
-   !!   sbc_rnf      : monthly runoffs read in a NetCDF file
-   !!   sbc_rnf_init : runoffs initialisation
-   !!   rnf_mouth    : set river mouth mask
+   !!   sbc_rnf       : monthly runoffs read in a NetCDF file
+   !!   sbc_rnf_init  : runoffs initialisation
+   !!   rnf_mouth     : set river mouth mask
    !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE sbc_oce         ! surface boundary condition variables
-   USE sbcisf          ! PM we could remove it I think
-   USE closea          ! closed seas
-   USE fldread         ! read input field at current time step
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O module
-   USE lib_mpp         ! MPP library
-   USE eosbn2
-   USE wrk_nemo        ! Memory allocation
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE sbc_oce        ! surface boundary condition variables
+   USE sbcisf         ! PM we could remove it I think
+   USE closea         ! closed seas
+   USE eosbn2         ! Equation Of State
+   !
+   USE in_out_manager ! I/O manager
+   USE fldread        ! read input field at current time step
+   USE iom            ! I/O module
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory allocation
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   sbc_rnf       ! routine call in sbcmod module
-   PUBLIC   sbc_rnf_div   ! routine called in divcurl module
-   PUBLIC   sbc_rnf_alloc ! routine call in sbcmod module
-   PUBLIC   sbc_rnf_init  ! (PUBLIC for TAM)
-   !                                                     !!* namsbc_rnf namelist *
-   CHARACTER(len=100)         ::   cn_dir          !: Root directory for location of rnf files
+   PUBLIC   sbc_rnf       ! called in sbcmod module
+   PUBLIC   sbc_rnf_div   ! called in divhor module
+   PUBLIC   sbc_rnf_alloc ! called in sbcmod module
+   PUBLIC   sbc_rnf_init  ! called in sbcmod module
+   
+   !                                                !!* namsbc_rnf namelist *
+   CHARACTER(len=100)         ::   cn_dir            !: Root directory for location of rnf files
    LOGICAL                    ::   ln_rnf_depth      !: depth       river runoffs attribute specified in a file
-   LOGICAL                    ::   ln_rnf_depth_ini  !: depth       river runoffs  computed at the initialisation
-   REAL(wp)                   ::   rn_rnf_max        !: maximum value of the runoff climatologie ( ln_rnf_depth_ini = .true )
-   REAL(wp)                   ::   rn_dep_max        !: depth over which runoffs is spread ( ln_rnf_depth_ini = .true )
-   INTEGER                    ::   nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0)
-   LOGICAL                    ::   ln_rnf_tem      !: temperature river runoffs attribute specified in a file
-   LOGICAL           , PUBLIC ::   ln_rnf_sal      !: salinity    river runoffs attribute specified in a file
-   TYPE(FLD_N)       , PUBLIC ::   sn_rnf          !: information about the runoff file to be read
-   TYPE(FLD_N)                ::   sn_cnf          !: information about the runoff mouth file to be read
-   TYPE(FLD_N)                ::   sn_s_rnf        !: information about the salinities of runoff file to be read
-   TYPE(FLD_N)                ::   sn_t_rnf        !: information about the temperatures of runoff file to be read
-   TYPE(FLD_N)                ::   sn_dep_rnf      !: information about the depth which river inflow affects
-   LOGICAL           , PUBLIC ::   ln_rnf_mouth    !: specific treatment in mouths vicinity
-   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)                   ::   rn_rfact        !: multiplicative factor for runoff
-
-   LOGICAL           , PUBLIC ::   l_rnfcpl = .false.       ! runoffs recieved from oasis
-
-   INTEGER , PUBLIC  ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths
+   LOGICAL                    ::      ln_rnf_depth_ini  !: depth       river runoffs  computed at the initialisation
+   REAL(wp)                   ::      rn_rnf_max        !: maximum value of the runoff climatologie (ln_rnf_depth_ini =T)
+   REAL(wp)                   ::      rn_dep_max        !: depth over which runoffs is spread       (ln_rnf_depth_ini =T)
+   INTEGER                    ::      nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0)
+   LOGICAL                    ::   ln_rnf_tem        !: temperature river runoffs attribute specified in a file
+   LOGICAL           , PUBLIC ::   ln_rnf_sal        !: salinity    river runoffs attribute specified in a file
+   TYPE(FLD_N)       , PUBLIC ::   sn_rnf            !: information about the runoff file to be read
+   TYPE(FLD_N)                ::   sn_cnf            !: information about the runoff mouth file to be read
+   TYPE(FLD_N)                ::   sn_s_rnf          !: information about the salinities of runoff file to be read
+   TYPE(FLD_N)                ::   sn_t_rnf          !: information about the temperatures of runoff file to be read
+   TYPE(FLD_N)                ::   sn_dep_rnf        !: information about the depth which river inflow affects
+   LOGICAL           , PUBLIC ::   ln_rnf_mouth      !: specific treatment in mouths vicinity
+   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
+
+   LOGICAL , PUBLIC ::   l_rnfcpl = .false.   !: runoffs recieved from oasis
+   INTEGER , PUBLIC ::   nkrnf = 0            !: nb of levels over which Kz is increased at river mouths
+   
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rnfmsk              !: river mouth mask (hori.)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   rnfmsk_z            !: river mouth mask (vert.)
@@ -67,6 +69,4 @@
    TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)  
  
-   !! * Substitutions  
-#  include "domzgr_substitute.h90"  
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -126,12 +126,4 @@
       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
          !
@@ -141,10 +133,10 @@
          IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data
             rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+            CALL eos_fzp( sss_m(:,:), ztfrz(:,:) )
             WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature
                rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
             END WHERE
             WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg
-               ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study)
-               rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp
+               rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * rlfusisf * r1_rau0_rcp
             END WHERE
          ELSE                                                        ! use SST as runoffs temperature
@@ -210,10 +202,18 @@
       !
       IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==!
-         IF( lk_vvl ) THEN             ! variable volume case
+         IF( ln_linssh ) THEN    !* constant volume case : just apply the runoff input flow
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  DO jk = 1, nk_rnf(ji,jj)
+                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
+                  END DO
+               END DO
+            END DO
+         ELSE                    !* variable volume case
             DO jj = 1, jpj                   ! update the depth over which runoffs are distributed
                DO ji = 1, jpi
                   h_rnf(ji,jj) = 0._wp
                   DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
-                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)   ! to the bottom of the relevant grid box
+                     h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)   ! to the bottom of the relevant grid box
                   END DO
                   !                          ! apply the runoff input flow
@@ -223,18 +223,8 @@
                END DO
             END DO
-         ELSE                          ! constant volume case : just apply the runoff input flow
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  DO jk = 1, nk_rnf(ji,jj)
-                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
-                  END DO
-               END DO
-            END DO
          ENDIF
       ELSE                       !==   runoff put only at the surface   ==!
-         IF( lk_vvl ) THEN              ! variable volume case
-            h_rnf(:,:) = fse3t(:,:,1)   ! recalculate h_rnf to be depth of top box
-         ENDIF
-         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / fse3t(:,:,1)
+         h_rnf (:,:)   = e3t_n (:,:,1)        ! update h_rnf to be depth of top box
+         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1)
       ENDIF
       !
@@ -376,5 +366,5 @@
                h_rnf(ji,jj) = 0._wp
                DO jk = 1, nk_rnf(ji,jj)
-                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
+                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)
                END DO
             END DO
@@ -434,5 +424,5 @@
                h_rnf(ji,jj) = 0._wp
                DO jk = 1, nk_rnf(ji,jj)
-                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
+                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)
                END DO
             END DO
@@ -447,5 +437,5 @@
       ELSE                                       ! runoffs applied at the surface
          nk_rnf(:,:) = 1
-         h_rnf (:,:) = fse3t(:,:,1)
+         h_rnf (:,:) = e3t_n(:,:,1)
       ENDIF
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 6808)
@@ -6,31 +6,29 @@
    !! History :  9.0  ! 2006-07  (G. Madec)  Original code
    !!            3.3  ! 2010-10  (C. Bricaud, G. Madec)  add the Patm forcing for sea-ice
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   sbc_ssm        : calculate sea surface mean currents, temperature,  
-   !!                    and salinity over nn_fsbc time-step
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface boundary condition: ocean fields
-   USE sbcapr          ! surface boundary condition: atmospheric pressure
-   USE eosbn2          ! equation of state and related derivatives
+   !!            3.7  ! 2015-11  (G. Madec)  non linear free surface by default: e3t_m always computed
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_ssm       : calculate sea surface mean currents, temperature,  
+   !!                   and salinity over nn_fsbc time-step
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! surface boundary condition: ocean fields
+   USE sbcapr         ! surface boundary condition: atmospheric pressure
+   USE eosbn2         ! equation of state and related derivatives
    !
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
-   USE iom             ! IOM library
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE iom            ! IOM library
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   sbc_ssm         ! routine called by step.F90
-   PUBLIC   sbc_ssm_init    ! routine called by sbcmod.F90
-
-   LOGICAL, SAVE  ::   l_ssm_mean = .FALSE.       ! keep track of whether means have been read
-                                                  ! from restart file
+   PUBLIC   sbc_ssm        ! routine called by step.F90
+   PUBLIC   sbc_ssm_init   ! routine called by sbcmod.F90
+
+   LOGICAL, SAVE ::   l_ssm_mean = .FALSE.   ! keep track of whether means have been read from restart file
    
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -59,5 +57,5 @@
       REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts
       !!---------------------------------------------------------------------
-
+      !
       !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity)
       DO jj = 1, jpj
@@ -81,5 +79,5 @@
          ENDIF
          !
-         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1)
+         e3t_m(:,:) = e3t_n(:,:,1)
          !
          frq_m(:,:) = fraqsr_1lev(:,:)
@@ -103,5 +101,5 @@
             ENDIF
             !
-            IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_n(:,:,1)
+            e3t_m(:,:) = zcoef * e3t_n(:,:,1)
             !
             frq_m(:,:) = zcoef * fraqsr_1lev(:,:)
@@ -109,11 +107,11 @@
          ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   !
             !                                             ! ---------------------------------------- !
-            ssu_m(:,:) = 0.e0      ! reset to zero ocean mean sbc fields
-            ssv_m(:,:) = 0.e0
-            sst_m(:,:) = 0.e0
-            sss_m(:,:) = 0.e0
-            ssh_m(:,:) = 0.e0
-            IF( lk_vvl )   e3t_m(:,:) = 0.e0
-            frq_m(:,:) = 0.e0
+            ssu_m(:,:) = 0._wp     ! reset to zero ocean mean sbc fields
+            ssv_m(:,:) = 0._wp
+            sst_m(:,:) = 0._wp
+            sss_m(:,:) = 0._wp
+            ssh_m(:,:) = 0._wp
+            e3t_m(:,:) = 0._wp
+            frq_m(:,:) = 0._wp
          ENDIF
          !                                                ! ---------------------------------------- !
@@ -131,7 +129,7 @@
          ENDIF
          !
-         IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1)
-         !
-         frq_m(:,:) =   frq_m(:,:) + fraqsr_1lev(:,:)
+         e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1)
+         !
+         frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:)
 
          !                                                ! ---------------------------------------- !
@@ -139,11 +137,11 @@
             !                                             ! ---------------------------------------- !
             zcoef = 1. / REAL( nn_fsbc, wp )
-            sst_m(:,:) = sst_m(:,:) * zcoef           ! mean SST             [Celcius]
-            sss_m(:,:) = sss_m(:,:) * zcoef           ! mean SSS             [psu]
-            ssu_m(:,:) = ssu_m(:,:) * zcoef           ! mean suface current  [m/s]
-            ssv_m(:,:) = ssv_m(:,:) * zcoef           !
-            ssh_m(:,:) = ssh_m(:,:) * zcoef           ! mean SSH             [m]
-            IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) * zcoef   ! mean vertical scale factor [m]
-            frq_m(:,:) = frq_m(:,:) * zcoef   ! mean fraction of solar net radiation absorbed in the 1st T level [-]
+            sst_m(:,:) = sst_m(:,:) * zcoef     ! mean SST             [Celcius]
+            sss_m(:,:) = sss_m(:,:) * zcoef     ! mean SSS             [psu]
+            ssu_m(:,:) = ssu_m(:,:) * zcoef     ! mean suface current  [m/s]
+            ssv_m(:,:) = ssv_m(:,:) * zcoef     !
+            ssh_m(:,:) = ssh_m(:,:) * zcoef     ! mean SSH             [m]
+            e3t_m(:,:) = e3t_m(:,:) * zcoef     ! mean vertical scale factor [m]
+            frq_m(:,:) = frq_m(:,:) * zcoef     ! mean fraction of solar net radiation absorbed in the 1st T level [-]
             !
          ENDIF
@@ -162,5 +160,5 @@
             CALL iom_rstput( kt, nitrst, numrow, 'sss_m'  , sss_m  )
             CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  )
-            IF( lk_vvl )   CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m  )
+            CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m  )
             CALL iom_rstput( kt, nitrst, numrow, 'frq_m'  , frq_m  )
             !
@@ -175,9 +173,10 @@
          CALL iom_put( 'sss_m', sss_m )
          CALL iom_put( 'ssh_m', ssh_m )
-         IF( lk_vvl )   CALL iom_put( 'e3t_m', e3t_m )
+         CALL iom_put( 'e3t_m', e3t_m )
          CALL iom_put( 'frq_m', frq_m )
       ENDIF
       !
    END SUBROUTINE sbc_ssm
+
 
    SUBROUTINE sbc_ssm_init
@@ -189,7 +188,7 @@
       !! ** Action  : - read parameters
       !!----------------------------------------------------------------------
-      REAL(wp) ::   zcoef, zf_sbc       ! local scalar
+      REAL(wp) ::   zcoef, zf_sbc   ! local scalar
       !!----------------------------------------------------------------------
-
+      !
       IF( nn_fsbc == 1 ) THEN
          !
@@ -206,11 +205,11 @@
          IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN
             l_ssm_mean = .TRUE.
-            CALL iom_get( numror               , 'nn_fsbc', zf_sbc )   ! sbc frequency of previous run
-            CALL iom_get( numror, jpdom_autoglo, 'ssu_m'  , ssu_m  )   ! sea surface mean velocity    (T-point)
-            CALL iom_get( numror, jpdom_autoglo, 'ssv_m'  , ssv_m  )   !   "         "    velocity    (V-point)
-            CALL iom_get( numror, jpdom_autoglo, 'sst_m'  , sst_m  )   !   "         "    temperature (T-point)
-            CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m  )   !   "         "    salinity    (T-point)
-            CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m  )   !   "         "    height      (T-point)
-            IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m )
+            CALL iom_get( numror               , 'nn_fsbc', zf_sbc )    ! sbc frequency of previous run
+            CALL iom_get( numror, jpdom_autoglo, 'ssu_m'  , ssu_m  )    ! sea surface mean velocity    (U-point)
+            CALL iom_get( numror, jpdom_autoglo, 'ssv_m'  , ssv_m  )    !   "         "    velocity    (V-point)
+            CALL iom_get( numror, jpdom_autoglo, 'sst_m'  , sst_m  )    !   "         "    temperature (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m  )    !   "         "    salinity    (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m  )    !   "         "    height      (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'e3t_m'  , e3t_m  )    ! 1st level thickness          (T-point)
             ! fraction of solar net radiation absorbed in 1st T level
             IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN
@@ -229,5 +228,5 @@
                sss_m(:,:) = zcoef * sss_m(:,:)
                ssh_m(:,:) = zcoef * ssh_m(:,:)
-               IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_m(:,:)
+               e3t_m(:,:) = zcoef * e3t_m(:,:)
                frq_m(:,:) = zcoef * frq_m(:,:)
             ELSE
@@ -245,7 +244,7 @@
          ELSE                    ;   sst_m(:,:) = tsn(:,:,1,jp_tem)
          ENDIF
-         sss_m(:,:) = tsn(:,:,1,jp_sal)
-         ssh_m(:,:) = sshn(:,:)
-         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1)
+         sss_m(:,:) = tsn  (:,:,1,jp_sal)
+         ssh_m(:,:) = sshn (:,:)
+         e3t_m(:,:) = e3t_n(:,:,1)
          frq_m(:,:) = 1._wp
          !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 6808)
@@ -19,6 +19,6 @@
    !
    USE fldread        ! read input fields
+   USE in_out_manager ! I/O manager
    USE iom            ! I/O manager
-   USE in_out_manager ! I/O manager
    USE lib_mpp        ! distribued memory computing library
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
@@ -47,6 +47,4 @@
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sss   ! structure of input SSS (file informations, fields read)
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
@@ -107,5 +105,4 @@
             IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx))
                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
-!CDIR COLLAPSE
                DO jj = 1, jpj
                   DO ji = 1, jpi
@@ -121,5 +118,4 @@
                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
                zerp_bnd = rn_sssr_bnd / rday                          !       -              -    
-!CDIR COLLAPSE
                DO jj = 1, jpj
                   DO ji = 1, jpi                            
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90	(revision 6808)
@@ -6,15 +6,14 @@
    !! History :  9.0  !  2007  (O. Le Galloudec)  Original code
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain
-   USE phycst
-   USE daymod
-   USE dynspg_oce
-   USE tideini
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constant
+   USE daymod         ! calandar
+   USE tideini        ! 
    !
-   USE iom
-   USE in_out_manager  ! I/O units
-   USE ioipsl          ! NetCDF IPSL library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager ! I/O units
+   USE iom            ! xIOs server
+   USE ioipsl         ! NetCDF IPSL library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
 
    IMPLICIT NONE
@@ -47,7 +46,8 @@
       INTEGER, INTENT( in ) ::   kt     ! ocean time-step
       INTEGER               ::   jk     ! dummy loop index
+      INTEGER               ::   nsec_day_orig     ! Temporary variable
       !!----------------------------------------------------------------------
-
-      IF( nsec_day == NINT(0.5_wp * rdttra(1)) ) THEN      ! start a new day
+      
+      IF( nsec_day == NINT(0.5_wp * rdt) .OR. kt == nit000 ) THEN      ! start a new day
          !
          IF( kt == nit000 ) THEN
@@ -60,7 +60,16 @@
          pot_astro(:,:) = 0._wp
          !
+         ! If the run does not start from midnight then need to initialise tides
+         ! at the start of the current day (only occurs when kt==nit000)
+         ! Temporarily set nsec_day to beginning of day.
+         nsec_day_orig = nsec_day
+         IF ( nsec_day /= NINT(0.5_wp * rdt) ) THEN 
+            kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt
+            nsec_day = NINT(0.5_wp * rdt)
+         ELSE
+            kt_tide = kt 
+         ENDIF
          CALL tide_harmo( omega_tide, v0tide, utide, ftide, ntide, nb_harmo )
          !
-         kt_tide = kt
          !
          IF(lwp) THEN
@@ -75,4 +84,6 @@
          IF( ln_tide_pot )   CALL tide_init_potential
          !
+         ! Reset nsec_day
+         nsec_day = nsec_day_orig 
       ENDIF
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 6808)
@@ -4,19 +4,21 @@
    !! Wave module 
    !!======================================================================
-   !! History :  3.3.1  !   2011-09  (Adani M)  Original code: Drag Coefficient 
-   !!         :  3.4    !   2012-10  (Adani M)                 Stokes Drift 
+   !! History :  3.3  !   2011-09  (Adani M)  Original code: Drag Coefficient 
+   !!         :  3.4  !   2012-10  (Adani M)                 Stokes Drift 
    !!----------------------------------------------------------------------
-   USE iom             ! I/O manager library
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distribued memory computing library
+
+   !!----------------------------------------------------------------------
+   !!   sbc_wave      : read drag coefficient from wave model in netcdf files 
+   !!----------------------------------------------------------------------
+   USE oce            ! 
+   USE sbc_oce	       ! Surface boundary condition: ocean fields
+   USE bdy_oce        !
+   USE domvvl         !
+   !
+   USE iom            ! I/O manager library
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
    USE fldread	       ! read input fields
-   USE oce
-   USE sbc_oce	       ! Surface boundary condition: ocean fields
-   USE domvvl
-
-   
-   !!----------------------------------------------------------------------
-   !!   sbc_wave       : read drag coefficient from wave model in netcdf files 
-   !!----------------------------------------------------------------------
+   USE wrk_nemo       !
 
    IMPLICIT NONE
@@ -25,18 +27,20 @@
    PUBLIC   sbc_wave    ! routine called in sbc_blk_core or sbc_blk_mfs
    
-   INTEGER , PARAMETER ::   jpfld  = 3           ! maximum number of files to read for srokes drift
-   INTEGER , PARAMETER ::   jp_usd = 1           ! index of stokes drift  (i-component) (m/s)    at T-point
-   INTEGER , PARAMETER ::   jp_vsd = 2           ! index of stokes drift  (j-component) (m/s)    at T-point
-   INTEGER , PARAMETER ::   jp_wn  = 3           ! index of wave number                 (1/m)    at T-point
+   INTEGER , PARAMETER ::   jpfld  = 3   ! maximum number of files to read for srokes drift
+   INTEGER , PARAMETER ::   jp_usd = 1   ! index of stokes drift  (i-component) (m/s)    at T-point
+   INTEGER , PARAMETER ::   jp_vsd = 2   ! index of stokes drift  (j-component) (m/s)    at T-point
+   INTEGER , PARAMETER ::   jp_wn  = 3   ! index of wave number                 (1/m)    at T-point
+
    TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_cd	  ! structure of input fields (file informations, fields read) Drag Coefficient
    TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_sd	  ! structure of input fields (file informations, fields read) Stokes Drift
-   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:)       :: cdn_wave 
-   REAL(wp),ALLOCATABLE,DIMENSION (:,:)              :: usd2d,vsd2d,uwavenum,vwavenum 
-   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:,:)     :: usd3d,vsd3d,wsd3d 
+
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION (:,:)   :: cdn_wave 
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION (:,:,:) :: usd3d, vsd3d, wsd3d 
+   REAL(wp),         ALLOCATABLE, DIMENSION (:,:)   :: usd2d, vsd2d, uwavenum, vwavenum 
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -56,27 +60,17 @@
       !!              - Compute 3d stokes drift using monochromatic
       !! ** action  :   
-      !!               
       !!---------------------------------------------------------------------
-      USE oce,  ONLY : un,vn,hdivn,rotn
-      USE divcur
-      USE wrk_nemo
-#if defined key_bdy
-      USE bdy_oce, ONLY : bdytmask
-#endif
-      INTEGER, INTENT( in  ) ::  kt       ! ocean time step
-      INTEGER                ::  ierror   ! return error code
-      INTEGER                ::  ifpr, jj,ji,jk 
+      INTEGER, INTENT( in  ) ::   kt       ! ocean time step
+      !
+      INTEGER                ::   ierror   ! return error code
+      INTEGER                ::   ifpr, jj,ji,jk 
       INTEGER                ::   ios     ! Local integer output status for namelist read
-      REAL(wp),DIMENSION(:,:,:),POINTER             ::  udummy,vdummy,hdivdummy,rotdummy
-      REAL                                          ::  z2dt,z1_2dt
       TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read
       CHARACTER(len=100)     ::  cn_dir                          ! Root directory for location of drag coefficient files
       TYPE(FLD_N)            ::  sn_cdg, sn_usd, sn_vsd, sn_wn   ! informations about the fields to be read
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   zusd_t, zvsd_t, ze3hdiv   ! 3D workspace
+      !!
+      NAMELIST/namsbc_wave/  sn_cdg, cn_dir, sn_usd, sn_vsd, sn_wn, ln_cdgw , ln_sdw
       !!---------------------------------------------------------------------
-      NAMELIST/namsbc_wave/  sn_cdg, cn_dir, sn_usd, sn_vsd, sn_wn
-      !!---------------------------------------------------------------------
-
-      !!----------------------------------------------------------------------
-      !
       !
       !                                         ! -------------------- !
@@ -86,5 +80,5 @@
          READ  ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901)
 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in reference namelist', lwp )
-
+         !
          REWIND( numnam_cfg )              ! Namelist namsbc_wave in configuration namelist : File for drag coeff. from wave model
          READ  ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 )
@@ -92,6 +86,16 @@
          IF(lwm) WRITE ( numond, namsbc_wave )
          !
-
-         IF ( ln_cdgw ) THEN
+         IF(lwp) THEN               ! Control print
+            WRITE(numout,*) '        Namelist namsbc_wave : surface wave setting' 
+            WRITE(numout,*) '           wave drag coefficient                      ln_cdgw  = ', ln_cdgw  
+            WRITE(numout,*) '           wave stokes drift                          ln_sdw   = ', ln_sdw
+         ENDIF
+         !
+         IF( .NOT.( ln_cdgw .OR. ln_sdw ) )    &
+            &  CALL ctl_warn( 'ln_sbcwave=T but nor drag coefficient (ln_cdgw=F) neither stokes drift activated (ln_sdw=F)' )
+         IF( ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) )   &       
+            &  CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core')
+         !
+         IF( ln_cdgw ) THEN
             ALLOCATE( sf_cd(1), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg
             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' )
@@ -102,6 +106,6 @@
             ALLOCATE( cdn_wave(jpi,jpj) )
             cdn_wave(:,:) = 0.0
-        ENDIF
-         IF ( ln_sdw ) THEN
+         ENDIF
+         IF( ln_sdw ) THEN
             slf_i(jp_usd) = sn_usd ; slf_i(jp_vsd) = sn_vsd; slf_i(jp_wn) = sn_wn
             ALLOCATE( sf_sd(3), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg
@@ -113,80 +117,70 @@
             END DO
             CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' )
-            ALLOCATE( usd2d(jpi,jpj),vsd2d(jpi,jpj),uwavenum(jpi,jpj),vwavenum(jpi,jpj) )
+            ALLOCATE( usd2d(jpi,jpj) , vsd2d(jpi,jpj) , uwavenum(jpi,jpj) , vwavenum(jpi,jpj) )
             ALLOCATE( usd3d(jpi,jpj,jpk),vsd3d(jpi,jpj,jpk),wsd3d(jpi,jpj,jpk) )
-            usd2d(:,:) = 0.0 ;  vsd2d(:,:) = 0.0 ; uwavenum(:,:) = 0.0 ; vwavenum(:,:) = 0.0
-            usd3d(:,:,:) = 0.0 ;vsd3d(:,:,:) = 0.0 ; wsd3d(:,:,:) = 0.0
+            usd3d(:,:,:) = 0._wp   ;   usd2d(:,:) = 0._wp   ;    uwavenum(:,:) = 0._wp
+            vsd3d(:,:,:) = 0._wp   ;   vsd2d(:,:) = 0._wp   ;    vwavenum(:,:) = 0._wp
+            wsd3d(:,:,:) = 0._wp
          ENDIF
       ENDIF
-         !
-         !
-      IF ( ln_cdgw ) THEN
-         CALL fld_read( kt, nn_fsbc, sf_cd )      !* read drag coefficient from external forcing
+      !
+      IF( ln_cdgw ) THEN               !==  Neutral drag coefficient  ==!
+         CALL fld_read( kt, nn_fsbc, sf_cd )      ! read from external forcing
          cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1)
       ENDIF
-      IF ( ln_sdw )  THEN
-          CALL fld_read( kt, nn_fsbc, sf_sd )      !* read drag coefficient from external forcing
-
-         ! Interpolate wavenumber, stokes drift into the grid_V and grid_V
-         !-------------------------------------------------
-
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               uwavenum(ji,jj)=0.5 * ( 2. - umask(ji,jj,1) ) * ( sf_sd(3)%fnow(ji,jj,1) * tmask(ji,jj,1) &
-               &                                + sf_sd(3)%fnow(ji+1,jj,1) * tmask(ji+1,jj,1) )
-
-               vwavenum(ji,jj)=0.5 * ( 2. - vmask(ji,jj,1) ) * ( sf_sd(3)%fnow(ji,jj,1) * tmask(ji,jj,1) &
-               &                                + sf_sd(3)%fnow(ji,jj+1,1) * tmask(ji,jj+1,1) )
-
-               usd2d(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( sf_sd(1)%fnow(ji,jj,1) * tmask(ji,jj,1) &
-               &                                + sf_sd(1)%fnow(ji+1,jj,1) * tmask(ji+1,jj,1) )
-
-               vsd2d(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( sf_sd(2)%fnow(ji,jj,1) * tmask(ji,jj,1) &
-               &                                + sf_sd(2)%fnow(ji,jj+1,1) * tmask(ji,jj+1,1) )
+      !
+      IF( ln_sdw )  THEN               !==  Computation of the 3d Stokes Drift  ==!
+         !
+         CALL wrk_alloc( jpi,jpj,jpk,   zusd_t, zvsd_t, ze3hdiv )
+         !
+         CALL fld_read( kt, nn_fsbc, sf_sd )    !* read drag coefficient from external forcing
+         !
+         DO jk = 1, jpkm1                       !* distribute it on the vertical
+            zusd_t(:,:,jk) = sf_sd(jp_usd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * gdept_n(:,:,jk) )
+            zvsd_t(:,:,jk) = sf_sd(jp_vsd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * gdept_n(:,:,jk) )
+         END DO
+         DO jk = 1, jpkm1                       !* interpolate the stokes drift from t-point to u- and v-points
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                   usd3d(ji,jj,jk) = 0.5_wp * ( zusd_t(ji  ,jj,jk) + zusd_t(ji+1,jj,jk) ) * umask(ji,jj,jk)
+                   vsd3d(ji,jj,jk) = 0.5_wp * ( zvsd_t(ji  ,jj,jk) + zvsd_t(ji,jj+1,jk) ) * vmask(ji,jj,jk)
+               END DO
             END DO
          END DO
-
-          !Computation of the 3d Stokes Drift
-          DO jk = 1, jpk
-             DO jj = 1, jpj-1
-                DO ji = 1, jpi-1
-                   usd3d(ji,jj,jk) = usd2d(ji,jj)*exp(2.0*uwavenum(ji,jj)*(-MIN( gdept_0(ji,jj,jk) , gdept_0(ji+1,jj  ,jk))))
-                   vsd3d(ji,jj,jk) = vsd2d(ji,jj)*exp(2.0*vwavenum(ji,jj)*(-MIN( gdept_0(ji,jj,jk) , gdept_0(ji  ,jj+1,jk))))
-                END DO
-             END DO
-             usd3d(jpi,:,jk) = usd2d(jpi,:)*exp( 2.0*uwavenum(jpi,:)*(-gdept_0(jpi,:,jk)) )
-             vsd3d(:,jpj,jk) = vsd2d(:,jpj)*exp( 2.0*vwavenum(:,jpj)*(-gdept_0(:,jpj,jk)) )
-          END DO
-
-          CALL wrk_alloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy)
-          
-          udummy(:,:,:)=un(:,:,:)
-          vdummy(:,:,:)=vn(:,:,:)
-          hdivdummy(:,:,:)=hdivn(:,:,:)
-          rotdummy(:,:,:)=rotn(:,:,:)
-          un(:,:,:)=usd3d(:,:,:)
-          vn(:,:,:)=vsd3d(:,:,:)
-          CALL div_cur(kt)
-      !                                           !------------------------------!
-      !                                           !     Now Vertical Velocity    !
-      !                                           !------------------------------!
-          z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
-
-          z1_2dt = 1.e0 / z2dt
-          DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence
-             ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise
-             wsd3d(:,:,jk) = wsd3d(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        &
-                &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    &
-                &                         * tmask(:,:,jk) * z1_2dt
+         CALL lbc_lnk( usd3d(:,:,:), 'U', -1. )
+         CALL lbc_lnk( vsd3d(:,:,:), 'V', -1. )
+         !
+         DO jk = 1, jpkm1                       !* e3t * Horizontal divergence  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ze3hdiv(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * usd3d(ji  ,jj,jk)     &
+                     &                 - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * usd3d(ji-1,jj,jk)     &
+                     &                 + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vsd3d(ji,jj  ,jk)     &
+                     &                 - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vsd3d(ji,jj-1,jk)   ) * r1_e1e2t(ji,jj)
+               END DO  
+            END DO  
+            IF( .NOT. AGRIF_Root() ) THEN
+               IF( nbondi ==  1 .OR. nbondi == 2 )   ze3hdiv(nlci-1,   :  ,jk) = 0._wp      ! east
+               IF( nbondi == -1 .OR. nbondi == 2 )   ze3hdiv(  2   ,   :  ,jk) = 0._wp      ! west
+               IF( nbondj ==  1 .OR. nbondj == 2 )   ze3hdiv(  :   ,nlcj-1,jk) = 0._wp      ! north
+               IF( nbondj == -1 .OR. nbondj == 2 )   ze3hdiv(  :   ,  2   ,jk) = 0._wp      ! south
+            ENDIF
+         END DO
+         CALL lbc_lnk( ze3hdiv, 'T', 1. ) 
+         !
+         DO jk = jpkm1, 1, -1                   !* integrate from the bottom the e3t * hor. divergence
+            wsd3d(:,:,jk) = wsd3d(:,:,jk+1) - ze3hdiv(:,:,jk)
+         END DO
 #if defined key_bdy
-             wsd3d(:,:,jk) = wsd3d(:,:,jk) * bdytmask(:,:)
+         IF( lk_bdy ) THEN
+            DO jk = 1, jpkm1
+               wsd3d(:,:,jk) = wsd3d(:,:,jk) * bdytmask(:,:)
+            END DO
+         ENDIF
 #endif
-          END DO
-          hdivn(:,:,:)=hdivdummy(:,:,:)
-          rotn(:,:,:)=rotdummy(:,:,:)
-          vn(:,:,:)=vdummy(:,:,:)
-          un(:,:,:)=udummy(:,:,:)
-          CALL wrk_dealloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy)
+         CALL wrk_dealloc( jpi,jpj,jpk,   zusd_t, zvsd_t, ze3hdiv )
+         ! 
       ENDIF
+      !
    END SUBROUTINE sbc_wave
       
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90	(revision 6808)
@@ -6,15 +6,14 @@
    !! History :  1.0  !  2007  (O. Le Galloudec)  Original code
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain
-   USE phycst
-   USE daymod
-   USE dynspg_oce
-   USE tide_mod
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constant
+   USE daymod         ! calandar
+   USE tide_mod       ! 
    !
-   USE iom
-   USE in_out_manager  ! I/O units
-   USE ioipsl          ! NetCDF IPSL library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager ! I/O units
+   USE iom            ! xIOs server
+   USE ioipsl         ! NetCDF IPSL library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
 
    IMPLICIT NONE
@@ -28,7 +27,7 @@
    LOGICAL , PUBLIC ::   ln_tide_pot     !:
    LOGICAL , PUBLIC ::   ln_tide_ramp    !:
-   INTEGER , PUBLIC ::   nb_harmo                 !:
-   INTEGER , PUBLIC ::   kt_tide                  !:
-   REAL(wp), PUBLIC ::   rdttideramp              !:
+   INTEGER , PUBLIC ::   nb_harmo        !:
+   INTEGER , PUBLIC ::   kt_tide         !:
+   REAL(wp), PUBLIC ::   rdttideramp     !:
    
    INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ntide   !:
@@ -41,76 +40,68 @@
 CONTAINS
    
-  SUBROUTINE tide_init ( kt )
-    !!----------------------------------------------------------------------
-    !!                 ***  ROUTINE tide_init  ***
-    !!----------------------------------------------------------------------      
-    !! * Local declarations
-    INTEGER  :: ji, jk
-    INTEGER, INTENT( in ) ::   kt     ! ocean time-step
-    CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname
-    INTEGER  ::   ios                 ! Local integer output status for namelist read
-    !
-    NAMELIST/nam_tide/ln_tide_pot, ln_tide_ramp, rdttideramp, clname
-    !!----------------------------------------------------------------------
-
-    IF ( kt == nit000 ) THEN
-       !
-       IF(lwp) THEN
-          WRITE(numout,*)
-          WRITE(numout,*) 'tide_init : Initialization of the tidal components'
-          WRITE(numout,*) '~~~~~~~~~ '
-       ENDIF
-       !
-       CALL tide_init_Wave
-       !
-       ! Read Namelist nam_tide
-       REWIND( numnam_ref )              ! Namelist nam_tide in reference namelist : Tides
-       READ  ( numnam_ref, nam_tide, IOSTAT = ios, ERR = 901)
-901    IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in reference namelist', lwp )
-
-       REWIND( numnam_cfg )              ! Namelist nam_tide in configuration namelist : Tides
-       READ  ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 )
-902    IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in configuration namelist', lwp )
-       IF(lwm) WRITE ( numond, nam_tide )
-       !
-       nb_harmo=0
-       DO jk = 1, jpmax_harmo
-          DO ji = 1,jpmax_harmo
-             IF( TRIM(clname(jk)) == Wave(ji)%cname_tide )   nb_harmo = nb_harmo + 1
-          END DO
-       END DO
-       !       
-       ! Ensure that tidal components have been set in namelist_cfg
-       IF( nb_harmo .EQ. 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' )
-       !
-       IF(lwp) THEN
-          WRITE(numout,*) '   Namelist nam_tide'
-          WRITE(numout,*) '      Apply astronomical potential : ln_tide_pot  =', ln_tide_pot
-          WRITE(numout,*) '                                     nb_harmo     = ', nb_harmo
-          WRITE(numout,*) '                                     ln_tide_ramp = ', ln_tide_ramp 
-          WRITE(numout,*) '                                     rdttideramp  = ', rdttideramp
-       ENDIF
-       IF( ln_tide_ramp.AND.((nitend-nit000+1)*rdt/rday < rdttideramp) )   &
-          &   CALL ctl_stop('rdttideramp must be lower than run duration')
-       IF( ln_tide_ramp.AND.(rdttideramp<0.) ) &
-          &   CALL ctl_stop('rdttideramp must be positive')
-       !
-       IF( .NOT. lk_dynspg_ts )   CALL ctl_warn( 'sbc_tide : use of time splitting is recommended' )
-       !
-       ALLOCATE( ntide(nb_harmo) )
-       DO jk = 1, nb_harmo
-          DO ji = 1, jpmax_harmo
-             IF( TRIM(clname(jk)) .eq. Wave(ji)%cname_tide ) THEN
-                ntide(jk) = ji
-                EXIT
-             END IF
-          END DO
-       END DO
-       !
-       ALLOCATE( omega_tide(nb_harmo), v0tide    (nb_harmo),   &
-          &      utide     (nb_harmo), ftide     (nb_harmo)  )
-       kt_tide = kt
-       !
+   SUBROUTINE tide_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tide_init  ***
+      !!----------------------------------------------------------------------      
+      INTEGER  :: ji, jk
+      CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !
+      NAMELIST/nam_tide/ln_tide_pot, ln_tide_ramp, rdttideramp, clname
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tide_init : Initialization of the tidal components'
+         WRITE(numout,*) '~~~~~~~~~ '
       ENDIF
+      !
+      CALL tide_init_Wave
+      !
+      ! Read Namelist nam_tide
+      REWIND( numnam_ref )              ! Namelist nam_tide in reference namelist : Tides
+      READ  ( numnam_ref, nam_tide, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_tide in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist nam_tide in configuration namelist : Tides
+      READ  ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_tide in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nam_tide )
+      !
+      nb_harmo=0
+      DO jk = 1, jpmax_harmo
+         DO ji = 1,jpmax_harmo
+            IF( TRIM(clname(jk)) == Wave(ji)%cname_tide )   nb_harmo = nb_harmo + 1
+         END DO
+      END DO
+      !       
+      ! Ensure that tidal components have been set in namelist_cfg
+      IF( nb_harmo == 0 )   CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' )
+      !
+      IF(lwp) THEN
+         WRITE(numout,*) '   Namelist nam_tide'
+         WRITE(numout,*) '      Apply astronomical potential : ln_tide_pot  =', ln_tide_pot
+         WRITE(numout,*) '                                     nb_harmo     = ', nb_harmo
+         WRITE(numout,*) '                                     ln_tide_ramp = ', ln_tide_ramp 
+         WRITE(numout,*) '                                     rdttideramp  = ', rdttideramp
+      ENDIF
+      IF( ln_tide_ramp.AND.((nitend-nit000+1)*rdt/rday < rdttideramp) )   &
+         &   CALL ctl_stop('rdttideramp must be lower than run duration')
+      IF( ln_tide_ramp.AND.(rdttideramp<0.) ) &
+         &   CALL ctl_stop('rdttideramp must be positive')
+      !
+      ALLOCATE( ntide(nb_harmo) )
+      DO jk = 1, nb_harmo
+         DO ji = 1, jpmax_harmo
+            IF( TRIM(clname(jk)) == Wave(ji)%cname_tide ) THEN
+               ntide(jk) = ji
+               EXIT
+            ENDIF
+         END DO
+      END DO
+      !
+      ALLOCATE( omega_tide(nb_harmo), v0tide    (nb_harmo),   &
+         &      utide     (nb_harmo), ftide     (nb_harmo)  )
+      kt_tide = nit000
       !
    END SUBROUTINE tide_init
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90	(revision 6808)
@@ -31,5 +31,5 @@
 CONTAINS
 
-   SUBROUTINE upd_tide( kt, kit, kbaro, koffset )
+   SUBROUTINE upd_tide( kt, kit, time_offset )
       !!----------------------------------------------------------------------
       !!                 ***  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 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, 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  ::   joffset      ! local integer
@@ -57,8 +57,8 @@
       !
       joffset = 0
-      IF( PRESENT( koffset ) )   joffset = koffset
+      IF( PRESENT( time_offset ) )   joffset = time_offset
       !
-      IF( PRESENT( kit ) .AND. PRESENT( kbaro ) )   THEN
-         zt = zt + ( kit + 0.5_wp * ( joffset - 1 ) ) * rdt / REAL( kbaro, wp )
+      IF( PRESENT( kit ) )   THEN
+         zt = zt + ( kit +  joffset - 1 ) * rdt / REAL( nn_baro, 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 ) .AND. PRESENT( kbaro ) )   zt = zt + kit * rdt / REAL( kbaro, wp )
+         IF( PRESENT( kit ) )   zt = zt + ( kit + joffset -1) * rdt / REAL( nn_baro, wp )
          zramp = MIN(  MAX( zt / (rdttideramp*rday) , 0._wp ) , 1._wp  )
          pot_astro(:,:) = zramp * pot_astro(:,:)
@@ -86,9 +86,8 @@
   !!----------------------------------------------------------------------
 CONTAINS
-  SUBROUTINE upd_tide( kt, kit, kbaro, koffset )          ! Empty routine
+  SUBROUTINE upd_tide( kt, kit, time_offset )  ! Empty routine
     INTEGER, INTENT(in)           ::   kt      !  integer  arg, dummy routine
     INTEGER, INTENT(in), OPTIONAL ::   kit     !  optional arg, dummy routine
-    INTEGER, INTENT(in), OPTIONAL ::   kbaro   !  optional arg, dummy routine
-    INTEGER, INTENT(in), OPTIONAL ::   koffset !  optional arg, dummy routine
+    INTEGER, INTENT(in), OPTIONAL ::   time_offset !  optional arg, dummy routine
     WRITE(*,*) 'upd_tide: You should not have seen this print! error?', kt
   END SUBROUTINE upd_tide
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90	(revision 6808)
@@ -849,5 +849,5 @@
 
 
-   REAL(wp) FUNCTION sto_par_flt_fac( kpasses )
+   FUNCTION sto_par_flt_fac( kpasses )
       !!----------------------------------------------------------------------
       !!                  ***  FUNCTION sto_par_flt_fac  ***
@@ -858,4 +858,5 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) :: kpasses
+      REAL(wp) :: sto_par_flt_fac
       !!
       INTEGER :: jpasses, ji, jj, jflti, jfltj
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 6808)
@@ -2,6 +2,5 @@
    !!==============================================================================
    !!                       ***  MODULE  eosbn2  ***
-   !! Ocean diagnostic variable : equation of state - in situ and potential density
-   !!                                               - Brunt-Vaisala frequency
+   !! Equation Of Seawater : in situ density - Brunt-Vaisala frequency
    !!==============================================================================
    !! History :  OPA  ! 1989-03  (O. Marti)  Original code
@@ -26,33 +25,33 @@
 
    !!----------------------------------------------------------------------
-   !!   eos            : generic interface of the equation of state
-   !!   eos_insitu     : Compute the in situ density
-   !!   eos_insitu_pot : Compute the insitu and surface referenced potential volumic mass
-   !!   eos_insitu_2d  : Compute the in situ density for 2d fields
-   !!   bn2            : Compute the Brunt-Vaisala frequency
-   !!   eos_rab        : generic interface of in situ thermal/haline expansion ratio 
-   !!   eos_rab_3d     : compute in situ thermal/haline expansion ratio
-   !!   eos_rab_2d     : compute in situ thermal/haline expansion ratio for 2d fields
-   !!   eos_fzp_2d     : freezing temperature for 2d fields
-   !!   eos_fzp_0d     : freezing temperature for scalar
-   !!   eos_init       : set eos parameters (namelist)
+   !!   eos           : generic interface of the equation of state
+   !!   eos_insitu    : Compute the in situ density
+   !!   eos_insitu_pot: Compute the insitu and surface referenced potential volumic mass
+   !!   eos_insitu_2d : Compute the in situ density for 2d fields
+   !!   bn2           : Compute the Brunt-Vaisala frequency
+   !!   eos_rab       : generic interface of in situ thermal/haline expansion ratio 
+   !!   eos_rab_3d    : compute in situ thermal/haline expansion ratio
+   !!   eos_rab_2d    : compute in situ thermal/haline expansion ratio for 2d fields
+   !!   eos_fzp_2d    : freezing temperature for 2d fields
+   !!   eos_fzp_0d    : freezing temperature for scalar
+   !!   eos_init      : set eos parameters (namelist)
    !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE stopar         ! Stochastic T/S fluctuations
+   USE stopts         ! Stochastic T/S fluctuations
    !
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE prtctl          ! Print control
-   USE wrk_nemo        ! Memory Allocation
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
    USE lbclnk         ! ocean lateral boundary conditions
-   USE timing          ! Timing
-   USE stopar          ! Stochastic T/S fluctuations
-   USE stopts          ! Stochastic T/S fluctuations
+   USE timing         ! Timing
 
    IMPLICIT NONE
    PRIVATE
 
-   !                   !! * Interface
+   !                  !! * Interface
    INTERFACE eos
       MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d
@@ -75,10 +74,9 @@
    PUBLIC   eos_init       ! called by istate module
 
-   !                                !!* Namelist (nameos) *
+   !                               !!** Namelist nameos **
    INTEGER , PUBLIC ::   nn_eos     ! = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
    LOGICAL , PUBLIC ::   ln_useCT   ! determine if eos_pt_from_ct is used to compute sst_m
 
-   !                                   !!!  simplified eos coefficients
-   ! default value: Vallis 2006
+   !                               !!!  simplified eos coefficients (default value: Vallis 2006)
    REAL(wp) ::   rn_a0      = 1.6550e-1_wp     ! thermal expansion coeff. 
    REAL(wp) ::   rn_b0      = 7.6554e-1_wp     ! saline  expansion coeff. 
@@ -172,5 +170,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -587,5 +584,5 @@
                DO ji = 1, jpi
                   !
-                  zh  = fsdept(ji,jj,jk) * r1_Z0                                ! depth
+                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth
                   zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
                   zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
@@ -645,5 +642,5 @@
                   zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
                   zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
-                  zh  = fsdept(ji,jj,jk)                 ! depth in meters at t-point
+                  zh  = gdept_n(ji,jj,jk)                ! depth in meters at t-point
                   ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask
                   !
@@ -913,6 +910,6 @@
          DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90
             DO ji = 1, jpi
-               zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   &
-                  &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 
+               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
+                  &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 
                   !
                zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 
@@ -921,5 +918,5 @@
                pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     &
                   &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  &
-                  &            / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                  &            / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
             END DO
          END DO
@@ -1129,5 +1126,5 @@
                DO ji = 1, jpi
                   !
-                  zh  = fsdept(ji,jj,jk) * r1_Z0                                ! depth
+                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth
                   zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
                   zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
@@ -1193,5 +1190,5 @@
                   zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0)
                   zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0)
-                  zh  = fsdept(ji,jj,jk)               ! depth in meters  at t-point
+                  zh  = gdept_n(ji,jj,jk)              ! depth in meters  at t-point
                   ztm = tmask(ji,jj,jk)                ! tmask
                   zn  = 0.5_wp * zh * r1_rau0 * ztm
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 6808)
@@ -6,34 +6,33 @@
    !! History :  2.0  !  2005-11  (G. Madec)  Original code
    !!            3.3  !  2010-09  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!            4.0  !  2011-06  (G. Madec)  Addition of Mixed Layer Eddy parameterisation
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv      : compute ocean tracer advection trend
-   !!   tra_adv_ctl  : control the different options of advection scheme
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE domvvl          ! variable vertical scale factors
-   USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine)
-   USE traadv_tvd      ! TVD      scheme           (tra_adv_tvd    routine)
-   USE traadv_muscl    ! MUSCL    scheme           (tra_adv_muscl  routine)
-   USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine)
-   USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine)
-   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine)
-   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine)
-   USE traadv_mle      ! ML eddy induced velocity  (tra_adv_mle    routine)
-   USE cla             ! cross land advection      (cla_traadv     routine)
-   USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   !!            3.6  !  2011-06  (G. Madec)  Addition of Mixed Layer Eddy parameterisation
+   !!            3.7  !  2014-05  (G. Madec)  Add 2nd/4th order cases for CEN and FCT schemes 
+   !!             -   !  2014-12  (G. Madec) suppression of cross land advection option
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv       : compute ocean tracer advection trend
+   !!   tra_adv_ctl   : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE domvvl         ! variable vertical scale factors
+   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine)
+   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine)
+   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine)
+   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine)
+   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine)
+   USE traadv_mle     ! ML eddy induced velocity  (tra_adv_mle  routine)
+   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
+   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces
    !
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O module
-   USE prtctl          ! Print control
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-   USE sbc_oce
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O module
+   USE prtctl         ! Print control
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
    USE diaptr          ! Poleward heat transport 
-
 
    IMPLICIT NONE
@@ -43,22 +42,31 @@
    PUBLIC   tra_adv_init   ! routine called by opa module
 
-   !                              !!* Namelist namtra_adv *
-   LOGICAL ::   ln_traadv_cen2     ! 2nd order centered scheme flag
-   LOGICAL ::   ln_traadv_tvd      ! TVD scheme flag
-   LOGICAL ::   ln_traadv_tvd_zts  ! TVD scheme flag with vertical sub time-stepping
-   LOGICAL ::   ln_traadv_muscl    ! MUSCL scheme flag
-   LOGICAL ::   ln_traadv_muscl2   ! MUSCL2 scheme flag
-   LOGICAL ::   ln_traadv_ubs      ! UBS scheme flag
-   LOGICAL ::   ln_traadv_qck      ! QUICKEST scheme flag
-   LOGICAL ::   ln_traadv_msc_ups  ! use upstream scheme within muscl
-
-
-   INTEGER ::   nadv   ! choice of the type of advection scheme
-
+   !                            !!* Namelist namtra_adv *
+   LOGICAL ::   ln_traadv_cen    ! centered scheme flag
+   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme
+   LOGICAL ::   ln_traadv_fct    ! FCT scheme flag
+   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme
+   INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping
+   LOGICAL ::   ln_traadv_mus    ! MUSCL scheme flag
+   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths
+   LOGICAL ::   ln_traadv_ubs    ! UBS scheme flag
+   INTEGER ::      nn_ubs_v             ! =2/4 : vertical choice of the order of UBS scheme
+   LOGICAL ::   ln_traadv_qck    ! QUICKEST scheme flag
+
+   INTEGER ::              nadv             ! choice of the type of advection scheme
+   !
+   !                                        ! associated indices:
+   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection
+   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme
+   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme
+   INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping
+   INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme
+   INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme
+   INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme
+   
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -74,5 +82,4 @@
       !! ** Method  : - Update (ua,va) with the advection term following nadv
       !!----------------------------------------------------------------------
-      !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !
@@ -83,73 +90,60 @@
       IF( nn_timing == 1 )  CALL timing_start('tra_adv')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn )
+      CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn )
+      !
       !                                          ! set time step
       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
-         r2dtra(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping)
+         r2dt = rdt                                 ! = rdt (restarting with Euler time stepping)
       ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
-         r2dtra(:) = 2._wp * rdttra(:)                   ! = 2 rdttra (leapfrog)
-      ENDIF
-      !
-      IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_traadv( kt )       !==  Cross Land Advection  ==! (hor. advection)
-      !
-      !                                               !==  effective transport  ==!
+         r2dt = 2._wp * rdt                         ! = 2 rdt (leapfrog)
+      ENDIF
+      !
+      !                                         !==  effective transport  ==!
       DO jk = 1, jpkm1
-         zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only
-         zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
-         zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * wn(:,:,jk)
+         zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                  ! eulerian transport only
+         zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
+         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
       END DO
       !
-      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
+      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections
          zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
          zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
       ENDIF
       !
-      zun(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
-      zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
-      zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
-      !
-      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &
-         &              CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the eiv transport (if necessary)
-      !
-      IF( ln_mle    )   CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the mle transport (if necessary)
-      !
-      CALL iom_put( "uocetr_eff", zun )                                         ! output effective transport      
+      zun(:,:,jpk) = 0._wp                                                      ! no transport trough the bottom
+      zvn(:,:,jpk) = 0._wp
+      zwn(:,:,jpk) = 0._wp
+      !
+      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &
+         &              CALL ldf_eiv_trp( kt, nit000, zun, zvn, zwn, 'TRA' )   ! add the eiv transport (if necessary)
+      !
+      IF( ln_mle    )   CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' )   ! add the mle transport (if necessary)
+      !
+      CALL iom_put( "uocetr_eff", zun )                                        ! output effective transport      
       CALL iom_put( "vocetr_eff", zvn )
       CALL iom_put( "wocetr_eff", zwn )
       !
-      IF( ln_diaptr )   CALL dia_ptr( zvn )                                     ! diagnose the effective MSF 
-      !
-   
-      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
-      CASE ( 1 )   ;    CALL tra_adv_cen2   ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered
-      CASE ( 2 )   ;    CALL tra_adv_tvd    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD 
-      CASE ( 3 )   ;    CALL tra_adv_muscl  ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts, ln_traadv_msc_ups )   !  MUSCL 
-      CASE ( 4 )   ;    CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2 
-      CASE ( 5 )   ;    CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS 
-      CASE ( 6 )   ;    CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST 
-      CASE ( 7 )   ;    CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD ZTS
-      !
-      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
-         CALL tra_adv_cen2  ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )          
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_adv_tvd   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts, ln_traadv_msc_ups )          
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_adv_ubs   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_adv_qck   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+!!gm ???
+      IF( ln_diaptr )   CALL dia_ptr( zvn )                                    ! diagnose the effective MSF 
+!!gm ???
+      !
+      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
+      !
+      CASE ( np_CEN )                                    ! Centered scheme : 2nd / 4th order
+         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zun, zvn, zwn     , tsn, tsa, jpts, nn_cen_h, nn_cen_v )
+      CASE ( np_FCT )                                    ! FCT scheme      : 2nd / 4th order
+         CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v )
+      CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting
+         CALL tra_adv_fct_zts( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_fct_zts )
+      CASE ( np_MUS )                                    ! MUSCL
+         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups ) 
+      CASE ( np_UBS )                                    ! UBS
+         CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   )
+      CASE ( np_QCK )                                    ! QUICKEST
+         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     )
+      !
       END SELECT
       !
-      !                                              ! print mean trends (used for debugging)
+      !                                         ! print mean trends (used for debugging)
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               &
          &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
@@ -157,5 +151,5 @@
       IF( nn_timing == 1 )  CALL timing_stop( 'tra_adv' )
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zun, zvn, zwn )
       !                                          
    END SUBROUTINE tra_adv
@@ -169,75 +163,109 @@
       !!              tracer advection schemes and set nadv
       !!----------------------------------------------------------------------
-      INTEGER ::   ioptio
-      INTEGER ::   ios                 ! Local integer output status for namelist read
-      !!
-      NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd,     &
-         &                 ln_traadv_muscl, ln_traadv_muscl2,  &
-         &                 ln_traadv_ubs  , ln_traadv_qck,     &
-         &                 ln_traadv_msc_ups, ln_traadv_tvd_zts
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )              ! Namelist namtra_adv in reference namelist : Tracer advection scheme
+      INTEGER ::   ioptio, ios   ! Local integers
+      !
+      NAMELIST/namtra_adv/ ln_traadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN
+         &                 ln_traadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT
+         &                 ln_traadv_mus,                     ln_mus_ups,   &   ! MUSCL
+         &                 ln_traadv_ubs,           nn_ubs_v,               &   ! UBS
+         &                 ln_traadv_qck                                        ! QCK
+      !!----------------------------------------------------------------------
+      !
+      !                                !==  Namelist  ==!
+      REWIND( numnam_ref )                   ! Namelist namtra_adv in reference namelist : Tracer advection scheme
       READ  ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namtra_adv in configuration namelist : Tracer advection scheme
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_adv in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )                   ! Namelist namtra_adv in configuration namelist : Tracer advection scheme
       READ  ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namtra_adv )
-
-      IF(lwp) THEN                    ! Namelist print
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_adv in configuration namelist', lwp )
+      IF(lwm) WRITE( numond, namtra_adv )
+      !
+      IF(lwp) THEN                           ! Namelist print
          WRITE(numout,*)
          WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers'
-         WRITE(numout,*) '      2nd order advection scheme     ln_traadv_cen2    = ', ln_traadv_cen2
-         WRITE(numout,*) '      TVD advection scheme           ln_traadv_tvd     = ', ln_traadv_tvd
-         WRITE(numout,*) '      MUSCL  advection scheme        ln_traadv_muscl   = ', ln_traadv_muscl
-         WRITE(numout,*) '      MUSCL2 advection scheme        ln_traadv_muscl2  = ', ln_traadv_muscl2
-         WRITE(numout,*) '      UBS    advection scheme        ln_traadv_ubs     = ', ln_traadv_ubs
-         WRITE(numout,*) '      QUICKEST advection scheme      ln_traadv_qck     = ', ln_traadv_qck
-         WRITE(numout,*) '      upstream scheme within muscl   ln_traadv_msc_ups = ', ln_traadv_msc_ups
-         WRITE(numout,*) '      TVD advection scheme with zts  ln_traadv_tvd_zts = ', ln_traadv_tvd_zts
-      ENDIF
-
-      ioptio = 0                      ! Parameter control
-      IF( ln_traadv_cen2   )   ioptio = ioptio + 1
-      IF( ln_traadv_tvd    )   ioptio = ioptio + 1
-      IF( ln_traadv_muscl  )   ioptio = ioptio + 1
-      IF( ln_traadv_muscl2 )   ioptio = ioptio + 1
-      IF( ln_traadv_ubs    )   ioptio = ioptio + 1
-      IF( ln_traadv_qck    )   ioptio = ioptio + 1
-      IF( ln_traadv_tvd_zts)   ioptio = ioptio + 1
-      IF( lk_esopa         )   ioptio =          1
-
-      IF( ( ln_traadv_muscl .OR. ln_traadv_muscl2 .OR. ln_traadv_ubs .OR. ln_traadv_qck .OR. ln_traadv_tvd_zts )   &
-         .AND. ln_isfcav )   CALL ctl_stop( 'Only traadv_cen2 and traadv_tvd is compatible with ice shelf cavity')
-
-      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' )
-
-      !                              ! Set nadv
-      IF( ln_traadv_cen2   )   nadv =  1
-      IF( ln_traadv_tvd    )   nadv =  2
-      IF( ln_traadv_muscl  )   nadv =  3
-      IF( ln_traadv_muscl2 )   nadv =  4
-      IF( ln_traadv_ubs    )   nadv =  5
-      IF( ln_traadv_qck    )   nadv =  6
-      IF( ln_traadv_tvd_zts)   nadv =  7
-      IF( lk_esopa         )   nadv = -1
-
-      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*) '      centered scheme                           ln_traadv_cen = ', ln_traadv_cen
+         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v
+         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_traadv_fct = ', ln_traadv_fct
+         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v
+         WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts
+         WRITE(numout,*) '      MUSCL scheme                              ln_traadv_mus = ', ln_traadv_mus
+         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups
+         WRITE(numout,*) '      UBS scheme                                ln_traadv_ubs = ', ln_traadv_ubs
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v
+         WRITE(numout,*) '      QUICKEST scheme                           ln_traadv_qck = ', ln_traadv_qck
+      ENDIF
+      !
+      ioptio = 0                       !==  Parameter control  ==!
+      IF( ln_traadv_cen )   ioptio = ioptio + 1
+      IF( ln_traadv_fct )   ioptio = ioptio + 1
+      IF( ln_traadv_mus )   ioptio = ioptio + 1
+      IF( ln_traadv_ubs )   ioptio = ioptio + 1
+      IF( ln_traadv_qck )   ioptio = ioptio + 1
+      !
+      IF( ioptio == 0 ) THEN
+         nadv = np_NO_adv
+         CALL ctl_warn( 'tra_adv_init: You are running without tracer advection.' )
+      ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection scheme in namelist namtra_adv' )
+      !
+      IF( ln_traadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &          ! Centered
+                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN
+        CALL ctl_stop( 'tra_adv_init: CEN scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_traadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   &          ! FCT
+                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN
+        CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_traadv_fct .AND. nn_fct_zts > 0 ) THEN
+         IF( nn_fct_h == 4 ) THEN
+            nn_fct_h = 2
+            CALL ctl_stop( 'tra_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' )
+         ENDIF
+         IF( .NOT.ln_linssh ) THEN
+            CALL ctl_stop( 'tra_adv_init: vertical sub-timestepping not allow in non-linear free surface' )
+         ENDIF
+         IF( nn_fct_zts == 1 )   CALL ctl_warn( 'tra_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' )
+      ENDIF
+      IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS
+        CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_traadv_ubs .AND. nn_ubs_v == 4 ) THEN
+         CALL ctl_warn( 'tra_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
+      ENDIF
+      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities
+         IF(  ln_traadv_cen .AND. nn_cen_v == 4    .OR.   &                            ! NO 4th order with ISF
+            & ln_traadv_fct .AND. nn_fct_v == 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' )
+      ENDIF
+      !
+      !                                !==  used advection scheme  ==!  
+      !                                      ! set nadv
+      IF( ln_traadv_cen                      )   nadv = np_CEN
+      IF( ln_traadv_fct                      )   nadv = np_FCT
+      IF( ln_traadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts
+      IF( ln_traadv_mus                      )   nadv = np_MUS
+      IF( ln_traadv_ubs                      )   nadv = np_UBS
+      IF( ln_traadv_qck                      )   nadv = np_QCK
+      !
+      IF(lwp) THEN                           ! Print the choice
          WRITE(numout,*)
-         IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used'
-         IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used'
-         IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used'
-         IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used'
-         IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used'
-         IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used'
-         IF( nadv ==  7 )   WRITE(numout,*) '         TVD ZTS   scheme is used'
-         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme'
-      ENDIF
-      !
-      CALL tra_adv_mle_init          ! initialisation of the Mixed Layer Eddy parametrisation (MLE)
+         SELECT CASE ( nadv )
+         CASE( np_NO_adv  )   ;   WRITE(numout,*) '         NO T-S advection'
+         CASE( np_CEN     )   ;   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   &
+            &                                                                     ' Vertical   order: ', nn_cen_v
+         CASE( np_FCT     )   ;   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   &
+            &                                                                      ' Vertical   order: ', nn_fct_v
+         CASE( np_FCT_zts )   ;   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping'
+         CASE( np_MUS     )   ;   WRITE(numout,*) '         MUSCL    scheme is used'
+         CASE( np_UBS     )   ;   WRITE(numout,*) '         UBS      scheme is used'
+         CASE( np_QCK     )   ;   WRITE(numout,*) '         QUICKEST scheme is used'
+         END SELECT
+      ENDIF
+      !
+      CALL tra_adv_mle_init            !== initialisation of the Mixed Layer Eddy parametrisation (MLE)  ==!
       !
    END SUBROUTINE tra_adv_init
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90	(revision 6808)
@@ -0,0 +1,206 @@
+MODULE traadv_cen
+   !!======================================================================
+   !!                     ***  MODULE  traadv_cen  ***
+   !! Ocean  tracers:   advective trend (2nd/4th order centered)
+   !!======================================================================
+   !! History :  3.7  ! 2014-05  (G. Madec)  original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_cen   : update the tracer trend with the advection trends using a centered or scheme (2nd or 4th order)
+   !!                   NB: on the vertical it is actually a 4th order COMPACT scheme which is used
+   !!----------------------------------------------------------------------
+   USE oce      , ONLY: tsn ! now ocean temperature and salinity
+   USE dom_oce        ! ocean space and time domain
+   USE eosbn2         ! equation of state
+   USE traadv_fct     ! acces to routine interp_4th_cpt 
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends manager: tracers 
+   USE diaptr         ! poleward transport diagnostics
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! IOM library
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_cen       ! routine called by step.F90
+   
+   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: traadv_cen2.F90 5737 2015-09-13 07:42:41Z gm $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pun, pvn, pwn,     &
+      &                                             ptn, pta, kjpt, kn_cen_h, kn_cen_v ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_cen  ***
+      !!                 
+      !! ** Purpose :   Compute the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations.
+      !!
+      !! ** Method  :   The advection is evaluated by a 2nd or 4th order scheme
+      !!               using now fields (leap-frog scheme). 
+      !!       kn_cen_h = 2  ==>> 2nd order centered scheme on the horizontal
+      !!                = 4  ==>> 4th order    -        -       -      -
+      !!       kn_cen_v = 2  ==>> 2nd order centered scheme on the vertical
+      !!                = 4  ==>> 4th order COMPACT  scheme     -      -
+      !!
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme)
+      INTEGER                              , INTENT(in   ) ::   kn_cen_v        ! =2/4 (2nd or 4th order scheme)
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn             ! now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::   ierr             ! local integer
+      REAL(wp) ::   zC2t_u, zC4t_u   ! local scalars
+      REAL(wp) ::   zC2t_v, zC4t_v   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zwy, zwz, ztu, ztv, ztw
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_cen : centered advection scheme on ', cdtype, ' order h/v =', kn_cen_h,'/', kn_cen_v
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
+      ENDIF
+      !
+      !                    
+      zwz(:,:, 1 ) = 0._wp       ! surface & bottom vertical flux set to zero for all tracers
+      zwz(:,:,jpk) = 0._wp
+      !
+      DO jn = 1, kjpt            !==  loop over the tracers  ==!
+         !
+         SELECT CASE( kn_cen_h )       !--  Horizontal fluxes  --!
+         !
+         CASE(  2  )                         !* 2nd order centered
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
+                     zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
+                  END DO
+               END DO
+            END DO
+            !
+         CASE(  4  )                         !* 4th order centered
+            ztu(:,:,jpk) = 0._wp                   ! Bottom value : flux set to zero
+            ztv(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1                       ! masked gradient
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO jk = 1, jpkm1                       ! Horizontal advective fluxes
+               DO jj = 2, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! C2 interpolation of T at u- & v-points (x2)
+                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn)
+                     !                                                  ! C4 interpolation of T at u- & v-points (x2)
+                     zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj,jk) - ztu(ji+1,jj,jk) )
+                     zC4t_v =  zC2t_v + r1_6 * ( ztv(ji,jj-1,jk) - ztv(ji,jj+1,jk) )
+                     !                                                  ! C4 fluxes
+                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * zC4t_u
+                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * zC4t_v
+                  END DO
+               END DO
+            END DO         
+            !
+         CASE DEFAULT
+            CALL ctl_stop( 'traadv_fct: wrong value for nn_fct' )
+         END SELECT
+         !
+         SELECT CASE( kn_cen_v )       !--  Vertical fluxes  --!   (interior)
+         !
+         CASE(  2  )                         !* 2nd order centered
+            DO jk = 2, jpk
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         CASE(  4  )                         !* 4th order compact
+            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )      ! ztw = interpolated value of T at w-point
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zwz(ji,jj,jk) = pwn(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         END SELECT
+         !
+         IF( ln_linssh ) THEN                !* top value   (linear free surf. only as zwz is multiplied by wmask)
+            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn) 
+                  END DO
+               END DO   
+            ELSE                                   ! no ice-shelf cavities (only ocean surface)
+               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn)
+            ENDIF
+         ENDIF
+         !               
+         DO jk = 1, jpkm1              !--  Divergence of advective fluxes  --!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)    &
+                     &             - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )    &
+                     &                + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )    &
+                     &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                             ! trend diagnostics
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) )
+         END IF
+         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )   htr_adv(:) = ptr_sj( zwy(:,:,:) )
+           IF( jn == jp_sal )   str_adv(:) = ptr_sj( zwy(:,:,:) )
+         ENDIF
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_cen')
+      !
+   END SUBROUTINE tra_adv_cen
+   
+   !!======================================================================
+END MODULE traadv_cen
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 6807)
+++ 	(revision )
@@ -1,368 +1,0 @@
-MODULE traadv_cen2
-   !!======================================================================
-   !!                     ***  MODULE  traadv_cen2  ***
-   !! Ocean  tracers:  horizontal & vertical advective trend
-   !!======================================================================
-   !! History :  OPA  ! 2001-08  (G. Madec, E. Durand) v8.2 trahad+trazad=traadv 
-   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
-   !!             -   ! 2004-08  (C. Talandier) New trends organization
-   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
-   !!            2.0  ! 2006-04  (R. Benshila, G. Madec) Step reorganization
-   !!             -   ! 2006-07  (G. madec)  add ups_orca_set routine
-   !!            3.2  ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection
-   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_cen2 : update the tracer trend with the advection trends using a 2nd order centered scheme
-   !!   ups_orca_set : allow mixed upstream/centered scheme in specific area (set for orca 2 and 4 only)
-   !!----------------------------------------------------------------------
-   USE oce, ONLY: tsn  ! now ocean temperature and salinity
-   USE dom_oce         ! ocean space and time domain
-   USE eosbn2          ! equation of state
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
-   USE closea          ! closed sea
-   USE sbcrnf          ! river runoffs
-   USE in_out_manager  ! I/O manager
-   USE iom             ! IOM library
-   USE diaptr          ! poleward transport diagnostics
-   USE zdf_oce         ! ocean vertical physics
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-   USE phycst
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_cen2   ! routine called by traadv.F90
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits 
-   !                                                             !  and in closed seas (orca 2 and 4 configurations)
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_cen2( kt, kit000, cdtype, pun, pvn, pwn,     &
-      &                                         ptb, ptn, pta, kjpt   ) 
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_cen2  ***
-      !!                 
-      !! ** Purpose :   Compute the now trend due to the advection of tracers
-      !!      and add it to the general trend of passive tracer equations.
-      !!
-      !! ** Method  :   The advection is evaluated by a second order centered
-      !!      scheme using now fields (leap-frog scheme). In specific areas
-      !!      (vicinity of major river mouths, some straits, or where tn is
-      !!      approaching the freezing point) it is mixed with an upstream
-      !!      scheme for stability reasons.
-      !!         Part 0 : compute the upstream / centered flag
-      !!                  (3D array, zind, defined at T-point (0<zind<1))
-      !!         Part I : horizontal advection
-      !!       * centered flux:
-      !!               zcenu = e2u*e3u  un  mi(ptn)
-      !!               zcenv = e1v*e3v  vn  mj(ptn)
-      !!       * upstream flux:
-      !!               zupsu = e2u*e3u  un  (ptb(i) or ptb(i-1) ) [un>0 or <0]
-      !!               zupsv = e1v*e3v  vn  (ptb(j) or ptb(j-1) ) [vn>0 or <0]
-      !!       * mixed upstream / centered horizontal advection scheme
-      !!               zcofi = max(zind(i+1), zind(i))
-      !!               zcofj = max(zind(j+1), zind(j))
-      !!               zwx = zcofi * zupsu + (1-zcofi) * zcenu
-      !!               zwy = zcofj * zupsv + (1-zcofj) * zcenv
-      !!       * horizontal advective trend (divergence of the fluxes)
-      !!               ztra = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] }
-      !!       * Add this trend now to the general trend of tracer (ta,sa):
-      !!               pta = pta + ztra
-      !!       * trend diagnostic (l_trdtra=T or l_trctra=T): the trend is
-      !!      saved for diagnostics. The trends saved is expressed as
-      !!      Uh.gradh(T), i.e.  save trend = ztra + ptn divn
-      !!
-      !!         Part II : vertical advection
-      !!      For temperature (idem for salinity) the advective trend is com-
-      !!      puted as follows :
-      !!            ztra = 1/e3t dk+1[ zwz ]
-      !!      where the vertical advective flux, zwz, is given by :
-      !!            zwz = zcofk * zupst + (1-zcofk) * zcent
-      !!      with
-      !!        zupsv = upstream flux = wn * (ptb(k) or ptb(k-1) ) [wn>0 or <0]
-      !!        zcenu = centered flux = wn * mk(tn)
-      !!         The surface boundary condition is :
-      !!      variable volume (lk_vvl = T) : zero advective flux
-      !!      lin. free-surf  (lk_vvl = F) : wn(:,:,1) * ptn(:,:,1)
-      !!         Add this trend now to the general trend of tracer (ta,sa):
-      !!             pta = pta + ztra
-      !!         Trend diagnostic (l_trdtra=T or l_trctra=T): the trend is
-      !!      saved for diagnostics. The trends saved is expressed as :
-      !!             save trend =  w.gradz(T) = ztra - ptn divn.
-      !!
-      !! ** Action :  - update pta  with the now advective tracer trends
-      !!              - save trends if needed
-      !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
-      !
-      INTEGER  ::   ji, jj, jk, jn, ikt   ! dummy loop indices
-      INTEGER  ::   ierr                 ! local integer
-      REAL(wp) ::   zbtr, ztra                            ! local scalars
-      REAL(wp) ::   zfp_ui, zfp_vj, zfp_w, zcofi          !   -      -
-      REAL(wp) ::   zfm_ui, zfm_vj, zfm_w, zcofj, zcofk   !   -      -
-      REAL(wp) ::   zupsut, zcenut, zupst                 !   -      -
-      REAL(wp) ::   zupsvt, zcenvt, zcent, zice           !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:)   :: zfzp, zpres   ! 2D workspace
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zwy     ! 3D     -
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zind    !  -     -
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen2')
-      !
-      CALL wrk_alloc( jpi, jpj, zpres, zfzp )
-      CALL wrk_alloc( jpi, jpj, jpk, zwx, zwy, zwz, zind )
-      !
-
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
-         IF(lwp) WRITE(numout,*)
-         !
-         IF( .NOT. ALLOCATED( upsmsk ) )  THEN
-             ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
-             IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array')
-         ENDIF
-
-         !
-         upsmsk(:,:) = 0._wp                             ! not upstream by default
-         ! 
-         IF( cp_cfg == "orca" )   CALL ups_orca_set      ! set mixed Upstream/centered scheme near some straits
-         !                                               ! and in closed seas (orca2 and orca4 only)
-         IF( jp_cfg == 2 .AND. .NOT. ln_rstart ) THEN    ! Increase the background in the surface layers
-            avmb(1) = 10.  * avmb(1)      ;      avtb(1) = 10.  * avtb(1)
-            avmb(2) = 10.  * avmb(2)      ;      avtb(2) = 10.  * avtb(2)
-            avmb(3) =  5.  * avmb(3)      ;      avtb(3) =  5.  * avtb(3)
-            avmb(4) =  2.5 * avmb(4)      ;      avtb(4) =  2.5 * avtb(4)
-         ENDIF
-      ENDIF
-      !
-      ! Upstream / centered scheme indicator
-      ! ------------------------------------
-!!gm  not strickly exact : the freezing point should be computed at each ocean levels...
-!!gm  not a big deal since cen2 is no more used in global ice-ocean simulations
-!!ch  changes for ice shelf to retain standard behaviour elsewhere, even if not optimal 
-      DO jj = 1, jpj 
-         DO ji = 1, jpi 
-            ikt = mikt(ji,jj) 
-            IF (ikt > 1 ) THEN 
-               zpres(ji,jj) = grav * rau0 * fsdept(ji,jj,ikt) * 1.e-04  
-            ELSE 
-               zpres(ji,jj) = 0.0 
-            ENDIF  
-         END DO 
-      END DO 
-      CALL eos_fzp( tsn(:,:,1,jp_sal), zfzp(:,:), zpres(:,:) )
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !                                        ! below ice covered area (if tn < "freezing"+0.1 )
-               IF( tsn(ji,jj,jk,jp_tem) <= zfzp(ji,jj) + 0.1 ) THEN   ;   zice = 1._wp
-               ELSE                                                   ;   zice = 0._wp
-               ENDIF
-               zind(ji,jj,jk) = MAX (   &
-                  rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows)
-                  upsmsk(ji,jj)               ,      &  ! some of some straits
-                  zice                               &  ! below ice covered area (if tn < "freezing"+0.1 )
-                  &                  ) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      DO jn = 1, kjpt
-         !
-         ! I. Horizontal advection
-         !    ====================
-         !
-         DO jk = 1, jpkm1
-            !                        ! Second order centered tracer flux at u- and v-points
-            DO jj = 1, jpjm1
-               !
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ! upstream indicator
-                  zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
-                  zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) )
-                  !
-                  ! upstream scheme
-                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
-                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
-                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
-                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
-                  zupsut = zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn)
-                  zupsvt = zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn)
-                  ! centered scheme
-                  zcenut = pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
-                  zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
-                  ! mixed centered / upstream scheme
-                  zwx(ji,jj,jk) = 0.5 * ( zcofi * zupsut + (1.-zcofi) * zcenut )
-                  zwy(ji,jj,jk) = 0.5 * ( zcofj * zupsvt + (1.-zcofj) * zcenvt )
-               END DO
-            END DO
-         END DO
-
-         ! II. Vertical advection
-         !     ==================
-         !
-         !                                                ! Vertical advective fluxes
-         zwz(:,:,jpk) = 0.e0                                   ! Bottom  value : flux set to zero
-         !                                                     ! Surface value : 
-         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable
-         ELSE
-            DO jj = 1, jpj   ! vector opt.
-               DO ji = 1, jpi   ! vector opt.
-                  ikt = mikt(ji,jj)                
-                  zwz(ji,jj,ikt ) = pwn(ji,jj,ikt) * ptn(ji,jj,ikt,jn)   ! linear free surface 
-                  zwz(ji,jj,1:ikt-1) = 0.e0
-               END DO
-            END DO
-         ENDIF
-         !
-         DO jk = 2, jpk              ! Second order centered tracer flux at w-point
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! upstream indicator
-                  zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) ) 
-                  ! mixed centered / upstream scheme
-                  zfp_w = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
-                  zfm_w = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
-                  zupst = zfp_w * ptb(ji,jj,jk,jn) + zfm_w * ptb(ji,jj,jk-1,jn)
-                  ! centered scheme
-                  zcent = pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )
-                  ! mixed centered / upstream scheme
-                  zwz(ji,jj,jk) = 0.5 * ( zcofk * zupst + (1.-zcofk) * zcent )
-               END DO
-            END DO
-         END DO
-
-         ! II. Divergence of advective fluxes
-         ! ----------------------------------
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) *  fse3t(ji,jj,jk) )
-                  ! advective trends
-                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-                  &                + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
-                  &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  )
-                  ! advective trends added to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-         END DO
-
-         !                                 ! trend diagnostics
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.    &
-            &( cdtype == 'TRC' .AND. l_trdtrc ) )   THEN
-            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )
-            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )
-            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) )
-         END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )   htr_adv(:) = ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )   str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
-         !
-      END DO
-
-      ! ---------------------------  required in restart file to ensure restartability)
-      ! avmb, avtb will be read in zdfini in restart case as they are used in zdftke, kpp etc...
-      IF( lrst_oce .AND. cdtype == 'TRA' ) THEN
-         CALL iom_rstput( kt, nitrst, numrow, 'avmb', avmb )
-         CALL iom_rstput( kt, nitrst, numrow, 'avtb', avtb )
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, zpres, zfzp )
-      CALL wrk_dealloc( jpi, jpj, jpk, zwx, zwy, zwz, zind )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_cen2')
-      !
-   END SUBROUTINE tra_adv_cen2
-   
-   
-   SUBROUTINE ups_orca_set
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ups_orca_set  ***
-      !!       
-      !! ** Purpose :   add a portion of upstream scheme in area where the
-      !!                centered scheme generates too strong overshoot
-      !!
-      !! ** Method  :   orca (R4 and R2) confiiguration setting. Set upsmsk
-      !!                array to nozero value in some straith. 
-      !!
-      !! ** Action : - upsmsk set to 1 at some strait, 0 elsewhere for orca
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ups_orca_set')
-      !
-      ! mixed upstream/centered scheme near river mouths
-      ! ------------------------------------------------
-      SELECT CASE ( jp_cfg )
-      !                                        ! =======================
-      CASE ( 4 )                               !  ORCA_R4 configuration 
-         !                                     ! =======================
-         !                                          ! Gibraltar Strait
-         ii0 =  70   ;   ii1 =  71
-         ij0 =  52   ;   ij1 =  53   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         !
-         !                                     ! =======================
-      CASE ( 2 )                               !  ORCA_R2 configuration 
-         !                                     ! =======================
-         !                                          ! Gibraltar Strait
-         ij0 = 102   ;   ij1 = 102
-         ii0 = 138   ;   ii1 = 138   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.20
-         ii0 = 139   ;   ii1 = 139   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
-         ii0 = 140   ;   ii1 = 140   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         ij0 = 101   ;   ij1 = 102
-         ii0 = 141   ;   ii1 = 141   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         !                                          ! Bab el Mandeb Strait
-         ij0 =  87   ;   ij1 =  88
-         ii0 = 164   ;   ii1 = 164   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.10
-         ij0 =  88   ;   ij1 =  88
-         ii0 = 163   ;   ii1 = 163   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
-         ii0 = 162   ;   ii1 = 162   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
-         ii0 = 160   ;   ii1 = 161   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         ij0 =  89   ;   ij1 =  89
-         ii0 = 158   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
-         ij0 =  90   ;   ij1 =  90
-         ii0 = 160   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
-         !                                          ! Sound Strait
-         ij0 = 116   ;   ij1 = 116
-         ii0 = 144   ;   ii1 = 144   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
-         ii0 = 145   ;   ii1 = 147   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         ii0 = 148   ;   ii1 = 148   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
-         !
-      END SELECT 
-      
-      ! mixed upstream/centered scheme over closed seas
-      ! -----------------------------------------------
-      CALL clo_ups( upsmsk(:,:) )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('ups_orca_set')
-      !
-   END SUBROUTINE ups_orca_set
-
-   !!======================================================================
-END MODULE traadv_cen2
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 6807)
+++ 	(revision )
@@ -1,219 +1,0 @@
-MODULE traadv_eiv
-   !!======================================================================
-   !!                    ***  MODULE  traadv_eiv  ***
-   !! Ocean tracers:  advection trend - eddy induced velocity
-   !!======================================================================
-   !! History :  1.0  !  2005-11 (G. Madec)  Original code, from traldf and zdf _iso
-   !!            3.3  !  2010-05 (C. Ethe, G. Madec)  merge TRC-TRA 
-   !!----------------------------------------------------------------------
-#if defined key_traldf_eiv   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_traldf_eiv'                  rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-   !!   tra_ldf_iso : update the tracer trend with the horizontal component
-   !!                 of iso neutral laplacian operator or horizontal 
-   !!                 laplacian operator in s-coordinate
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE ldfslp          ! iso-neutral slopes
-   USE in_out_manager  ! I/O manager
-   USE iom
-   USE trc_oce         ! share passive tracers/Ocean variables
-# if defined key_diaeiv
-   USE phycst          ! physical constants
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-# endif  
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_eiv   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
-#  include "ldfeiv_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_eiv( kt, kit000, pun, pvn, pwn, cdtype )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_eiv  ***
-      !! 
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   The eddy induced advection is computed from the slope
-      !!      of iso-neutral surfaces computed in routine ldf_slp as follows:
-      !!         zu_eiv =  1/(e2u e3u)   dk[ aeiu e2u mi(wslpi) ]
-      !!         zv_eiv =  1/(e1v e3v)   dk[ aeiv e1v mj(wslpj)
-      !!         zw_eiv = -1/(e1t e2t) { di[ aeiu e2u mi(wslpi) ]
-      !!                               + dj[ aeiv e1v mj(wslpj) ] }
-      !!      add the eiv component to the model velocity:
-      !!         p.n = p.n + z._eiv
-      !!
-      !! ** Action  : - add to p.n the eiv component
-      !!----------------------------------------------------------------------
-      INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index
-      INTEGER                         , INTENT(in   ) ::   kit000   ! first time step index
-      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean velocity components 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv
-      !!
-      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
-      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars
-      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      -
-# if defined key_diaeiv 
-      REAL(wp) ::   zztmp                      ! local scalar
-# endif  
-      REAL(wp), POINTER, DIMENSION(:,:) :: zu_eiv, zv_eiv, zw_eiv, z2d
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'tra_adv_eiv')
-      !
-# if defined key_diaeiv 
-      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d )
-# else
-      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv )
-# endif
-
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection on ', cdtype,' :'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   add to velocity fields the eiv component'
-# if defined key_diaeiv 
-         IF( cdtype == 'TRA') THEN
-            u_eiv(:,:,:) = 0.e0
-            v_eiv(:,:,:) = 0.e0
-            w_eiv(:,:,:) = 0.e0
-         END IF
-# endif
-      ENDIF
-
-      zu_eiv(:,:) = 0.e0   ;   zv_eiv(:,:) = 0.e0   ;    zw_eiv(:,:) = 0.e0  
-      
-                                                    ! =================
-      DO jk = 1, jpkm1                              !  Horizontal slab
-         !                                          ! =================
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zuwk = ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk  ) ) * fsaeiu(ji,jj,jk  ) * umask(ji,jj,jk  )
-               zuwk1= ( wslpi(ji,jj,jk+1) + wslpi(ji+1,jj,jk+1) ) * fsaeiu(ji,jj,jk+1) * umask(ji,jj,jk+1)
-               zvwk = ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk  ) ) * fsaeiv(ji,jj,jk  ) * vmask(ji,jj,jk  )
-               zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji,jj+1,jk+1) ) * fsaeiv(ji,jj,jk+1) * vmask(ji,jj,jk+1)
-
-               zu_eiv(ji,jj) = 0.5 * umask(ji,jj,jk) * ( zuwk - zuwk1 ) 
-               zv_eiv(ji,jj) = 0.5 * vmask(ji,jj,jk) * ( zvwk - zvwk1 ) 
-   
-               pun(ji,jj,jk) = pun(ji,jj,jk) + e2u(ji,jj) * zu_eiv(ji,jj)
-               pvn(ji,jj,jk) = pvn(ji,jj,jk) + e1v(ji,jj) * zv_eiv(ji,jj)
-            END DO
-         END DO
-# if defined key_diaeiv 
-         IF( cdtype == 'TRA') THEN
-            u_eiv(:,:,jk) = zu_eiv(:,:) / fse3u(:,:,jk)
-            v_eiv(:,:,jk) = zv_eiv(:,:) / fse3v(:,:,jk)
-         END IF
-# endif
-         IF( jk >=2 ) THEN                             ! jk=1 zw_eiv=0, not computed
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-# if defined key_traldf_c2d || defined key_traldf_c3d
-                  zuwi  = ( wslpi(ji,jj,jk)+wslpi(ji-1,jj,jk) ) * fsaeiu(ji-1,jj,jk) * e2u(ji-1,jj) * umask(ji-1,jj,jk)
-                  zuwi1 = ( wslpi(ji,jj,jk)+wslpi(ji+1,jj,jk) ) * fsaeiu(ji  ,jj,jk) * e2u(ji  ,jj) * umask(ji  ,jj,jk)
-                  zvwj  = ( wslpj(ji,jj,jk)+wslpj(ji,jj-1,jk) ) * fsaeiv(ji,jj-1,jk) * e1v(ji,jj-1) * vmask(ji,jj-1,jk)
-                  zvwj1 = ( wslpj(ji,jj,jk)+wslpj(ji,jj+1,jk) ) * fsaeiv(ji,jj  ,jk) * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
-  
-                  zw_eiv(ji,jj) = - 0.5 * tmask(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj ) 
-# else
-                  zuwi  = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) ) * e2u(ji-1,jj) * umask(ji-1,jj,jk)
-                  zuwi1 = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) ) * e2u(ji  ,jj) * umask(ji  ,jj,jk)
-                  zvwj  = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) ) * e1v(ji,jj-1) * vmask(ji,jj-1,jk)
-                  zvwj1 = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) ) * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
-
-                  zw_eiv(ji,jj) = - 0.5 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj )
-# endif
-                  pwn(ji,jj,jk) = pwn(ji,jj,jk) + zw_eiv(ji,jj)
-               END DO
-            END DO
-# if defined key_diaeiv 
-            IF( cdtype == 'TRA')  w_eiv(:,:,jk) = zw_eiv(:,:) / ( e1t(:,:) * e2t(:,:) )
-# endif
-         ENDIF
-         !                                          ! =================
-      END DO                                        !    End of slab  
-      !                                             ! =================
-
-# if defined key_diaeiv 
-      IF( cdtype == 'TRA') THEN
-         CALL iom_put( "uoce_eiv", u_eiv )    ! i-eiv current
-         CALL iom_put( "voce_eiv", v_eiv )    ! j-eiv current
-         CALL iom_put( "woce_eiv", w_eiv )    ! vert. eiv current
-         IF( iom_use('ueiv_heattr') ) THEN
-            zztmp = 0.5 * rau0 * rcp 
-            z2d(:,:) = 0.e0 
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     z2d(ji,jj) = z2d(ji,jj) + u_eiv(ji,jj,jk) &
-                       &         * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e2u(ji,jj) * fse3u(ji,jj,jk) 
-                  END DO
-               END DO
-            END DO
-            CALL lbc_lnk( z2d, 'U', -1. )
-            CALL iom_put( "ueiv_heattr", zztmp * z2d )                  ! heat transport in i-direction
-         ENDIF
-            
-         IF( iom_use('veiv_heattr') ) THEN
-            zztmp = 0.5 * rau0 * rcp 
-            z2d(:,:) = 0.e0 
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     z2d(ji,jj) = z2d(ji,jj) + v_eiv(ji,jj,jk) &
-                     &           * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e1v(ji,jj) * fse3v(ji,jj,jk) 
-                  END DO
-               END DO
-            END DO
-            CALL lbc_lnk( z2d, 'V', -1. )
-            CALL iom_put( "veiv_heattr", zztmp * z2d )                  !  heat transport in i-direction
-         ENDIF
-    END IF
-# endif  
-      ! 
-# if defined key_diaeiv 
-      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d )
-# else
-      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv )
-# endif
-      !
-      IF( nn_timing == 1 )  CALL timing_stop( 'tra_adv_eiv')
-      !
-    END SUBROUTINE tra_adv_eiv
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :             No rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE tra_adv_eiv( kt, kit000, pun, pvn, pwn, cdtype )              ! Empty routine
-      INTEGER  ::   kt    
-      INTEGER  ::   kit000    
-      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)
-   END SUBROUTINE tra_adv_eiv
-#endif
-
-   !!==============================================================================
-END MODULE traadv_eiv
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90	(revision 6808)
@@ -0,0 +1,793 @@
+MODULE traadv_fct
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_fct  ***
+   !! Ocean  tracers:  horizontal & vertical advective trend (2nd/4th order Flux Corrected Transport method)
+   !!==============================================================================
+   !! History :  3.7  !  2015-09  (L. Debreu, G. Madec)  original code (inspired from traadv_tvd.F90)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  tra_adv_fct    : update the tracer trend with a 3D advective trends using a 2nd or 4th order FCT scheme
+   !!  tra_adv_fct_zts: update the tracer trend with a 3D advective trends using a 2nd order FCT scheme 
+   !!                   with sub-time-stepping in the vertical direction
+   !!  nonosc         : compute monotonic tracer fluxes by a non-oscillatory algorithm 
+   !!  interp_4th_cpt : 4th order compact scheme for the vertical component of the advection
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! tracers trends
+   USE diaptr         ! poleward transport diagnostics
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_fct        ! routine called by traadv.F90
+   PUBLIC   tra_adv_fct_zts    ! routine called by traadv.F90
+   PUBLIC   interp_4th_cpt     ! routine called by traadv_cen.F90
+
+   LOGICAL  ::   l_trd   ! flag to compute trends
+   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pun, pvn, pwn,       &
+      &                                              ptb, ptn, pta, kjpt, kn_fct_h, kn_fct_v )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_fct  ***
+      !! 
+      !! **  Purpose :   Compute the now trend due to total advection of tracers
+      !!               and add it to the general trend of tracer equations
+      !!
+      !! **  Method  : - 2nd or 4th FCT scheme on the horizontal direction
+      !!               (choice through the value of kn_fct)
+      !!               - on the vertical the 4th order is a compact scheme 
+      !!               - corrected flux (monotonic correction) 
+      !!
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kn_fct_h        ! order of the FCT scheme (=2 or 4)
+      INTEGER                              , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4)
+      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices  
+      REAL(wp) ::   ztra                                     ! local scalar
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u   !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdx, ztrdy, ztrdz
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_fct : FCT advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      l_trd = .FALSE.
+      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
+      !
+      IF( l_trd )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp
+      ENDIF
+      !
+      !                          ! surface & bottom value : flux set to zero one for all
+      zwz(:,:, 1 ) = 0._wp            
+      zwx(:,:,jpk) = 0._wp   ;   zwy(:,:,jpk) = 0._wp    ;    zwz(:,:,jpk) = 0._wp
+      !
+      zwi(:,:,:) = 0._wp        
+      !
+      DO jn = 1, kjpt            !==  loop over the tracers  ==!
+         !
+         !        !==  upstream advection with initial mass fluxes & intermediate update  ==!
+         !                    !* upstream tracer flux in the i and j direction 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream scheme
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) )
+               END DO
+            END DO
+         END DO
+         !                    !* upstream tracer flux in the k direction *!
+         DO jk = 2, jpkm1        ! Interior value ( multiplied by wmask)
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_linssh ) THEN    ! top ocean value (only in linear free surface as zwz has been w-masked)
+            IF( ln_isfcav ) THEN             ! top of the ice-shelf cavities and at the ocean surface
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                  END DO
+               END DO   
+            ELSE                             ! no cavities: only at the ocean surface
+               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+            ENDIF
+         ENDIF
+         !               
+         DO jk = 1, jpkm1     !* trend and after field with monotonic scheme
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! total intermediate advective trends
+                  ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                  ! update and guess with monotonic sheme
+!!gm why tmask added in the two following lines ???    the mask is done in tranxt !
+                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra   * tmask(ji,jj,jk)
+                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + p2dt * ztra ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zwi, 'T', 1. )  ! Lateral boundary conditions on zwi  (unchanged sign)
+         !                
+         IF( l_trd )  THEN             ! trend diagnostics (contribution of upstream fluxes)
+            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
+         ENDIF
+         !
+         !        !==  anti-diffusive flux : high order minus low order  ==!
+         !
+         SELECT CASE( kn_fct_h )    !* horizontal anti-diffusive fluxes
+         !
+         CASE(  2  )                   !- 2nd order centered
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)
+                     zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         CASE(  4  )                   !- 4th order centered
+            zltu(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero
+            zltv(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1                 ! Laplacian
+               DO jj = 1, jpjm1                    ! 1st derivative (gradient)
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+                  END DO
+               END DO
+               DO jj = 2, jpjm1                    ! 2nd derivative * 1/ 6
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zltu(ji,jj,jk) = (  ztu(ji,jj,jk) + ztu(ji-1,jj,jk)  ) * r1_6
+                     zltv(ji,jj,jk) = (  ztv(ji,jj,jk) + ztv(ji,jj-1,jk)  ) * r1_6
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO jk = 1, jpkm1                 ! Horizontal advective fluxes
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points
+                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn)
+                     !                                                  ! C4 minus upstream advective fluxes 
+                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk)
+                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk)
+                  END DO
+               END DO
+            END DO         
+            !
+         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested
+            ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero
+            ztv(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1                 ! 1st derivative (gradient)
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO jk = 1, jpkm1                 ! Horizontal advective fluxes
+               DO jj = 2, jpjm1
+                  DO ji = 2, fs_jpim1   ! vector opt.
+                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points (x2)
+                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn)
+                     !                                                  ! C4 interpolation of T at u- & v-points (x2)
+                     zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj  ,jk) - ztu(ji+1,jj  ,jk) )
+                     zC4t_v =  zC2t_v + r1_6 * ( ztv(ji  ,jj-1,jk) - ztv(ji  ,jj+1,jk) )
+                     !                                                  ! C4 minus upstream advective fluxes 
+                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk)
+                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         END SELECT
+         !                      
+         SELECT CASE( kn_fct_v )    !* vertical anti-diffusive fluxes (w-masked interior values)
+         !
+         CASE(  2  )                   !- 2nd order centered
+            DO jk = 2, jpkm1    
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zwz(ji,jj,jk) =  (  pwn(ji,jj,jk) * 0.5_wp * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )   &
+                        &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         CASE(  4  )                   !- 4th order COMPACT
+            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )   ! zwt = COMPACT interpolation of T at w-point
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zwz(ji,jj,jk) = ( pwn(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         END SELECT
+         IF( ln_linssh ) THEN    ! top ocean value: high order = upstream  ==>>  zwz=0
+            zwz(:,:,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked
+         ENDIF
+         !
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
+         CALL lbc_lnk( zwz, 'W',  1. )
+         !
+         !        !==  monotonicity algorithm  ==!
+         !
+         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
+         !
+         !        !==  final trend with corrected fluxes  ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &                                   + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &                                   + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) &
+                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         IF( l_trd ) THEN     ! trend diagnostics (contribution of upstream fluxes)
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
+            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
+            !
+            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )
+            !
+            CALL wrk_dealloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz )
+         END IF
+         !                    ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )   htr_adv(:) = htr_adv(:) + ptr_sj( zwy(:,:,:) )
+           IF( jn == jp_sal )   str_adv(:) = str_adv(:) + ptr_sj( zwy(:,:,:) )
+         ENDIF
+         !
+      END DO                     ! end of tracer loop
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct')
+      !
+   END SUBROUTINE tra_adv_fct
+
+
+   SUBROUTINE tra_adv_fct_zts( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                                  ptb, ptn, pta, kjpt, kn_fct_zts )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_fct_zts  ***
+      !! 
+      !! **  Purpose :   Compute the now trend due to total advection of 
+      !!       tracers and add it to the general trend of tracer equations
+      !!
+      !! **  Method  :   TVD ZTS scheme, i.e. 2nd order centered scheme with
+      !!       corrected flux (monotonic correction). This version use sub-
+      !!       timestepping for the vertical advection which increases stability
+      !!       when vertical metrics are small.
+      !!       note: - this advection scheme needs a leap-frog time scheme
+      !!
+      !! ** Action : - update (pta) with the now advective tracer trends
+      !!             - save the trends 
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kn_fct_zts      ! number of number of vertical sub-timesteps
+      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      REAL(wp), DIMENSION( jpk )                           ::   zts             ! length of sub-timestep for vertical advection
+      REAL(wp)                                             ::   zr_p2dt         ! reciprocal of tracer timestep
+      INTEGER  ::   ji, jj, jk, jl, jn       ! dummy loop indices  
+      INTEGER  ::   jtb, jtn, jta   ! sub timestep pointers for leap-frog/euler forward steps
+      INTEGER  ::   jtaken          ! toggle for collecting appropriate fluxes from sub timesteps
+      REAL(wp) ::   z_rzts          ! Fractional length of Euler forward sub-timestep for vertical advection
+      REAL(wp) ::   ztra            ! local scalar
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zwx_sav , zwy_sav
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdx, ztrdy, ztrdz
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrs
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct_zts')
+      !
+      CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav )
+      CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav )
+      CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_fct_zts : 2nd order FCT scheme with ', kn_fct_zts, ' vertical sub-timestep on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      l_trd = .FALSE.
+      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
+      !
+      IF( l_trd )  THEN
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz )
+         ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp
+      ENDIF
+      !
+      zwi(:,:,:) = 0._wp
+      z_rzts = 1._wp / REAL( kn_fct_zts, wp )
+      zr_p2dt = 1._wp / p2dt
+      !
+      ! surface & Bottom value : flux set to zero for all tracers
+      zwz(:,:, 1 ) = 0._wp
+      zwx(:,:,jpk) = 0._wp   ;    zwz(:,:,jpk) = 0._wp
+      zwy(:,:,jpk) = 0._wp   ;    zwi(:,:,jpk) = 0._wp
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !
+         ! Upstream advection with initial mass fluxes & intermediate update
+         DO jk = 1, jpkm1        ! upstream tracer flux in the i and j direction
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream scheme
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  zwx(ji,jj,jk) = 0.5_wp * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5_wp * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) )
+               END DO
+            END DO
+         END DO
+         !                       ! upstream tracer flux in the k direction
+         DO jk = 2, jpkm1              ! Interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                  zwz(ji,jj,jk) = 0.5_wp * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_linssh ) THEN          ! top value : linear free surface case only (as zwz is multiplied by wmask)
+            IF( ln_isfcav ) THEN             ! ice-shelf cavities: top value
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) 
+                  END DO
+               END DO   
+            ELSE                             ! no cavities, surface value
+               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+            ENDIF
+         ENDIF
+         !
+         DO jk = 1, jpkm1         ! total advective trend
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !                             ! total intermediate advective trends
+                  ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                  !                             ! update and guess with monotonic sheme
+                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra
+                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + p2dt * ztra ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                           
+         CALL lbc_lnk( zwi, 'T', 1. )     ! Lateral boundary conditions on zwi  (unchanged sign)
+         !                
+         IF( l_trd )  THEN                ! trend diagnostics (contribution of upstream fluxes)
+            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
+         ENDIF
+
+         ! 3. anti-diffusive flux : high order minus low order
+         ! ---------------------------------------------------
+
+         DO jk = 1, jpkm1                    !* horizontal anti-diffusive fluxes
+            !
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx_sav(ji,jj) = zwx(ji,jj,jk)
+                  zwy_sav(ji,jj) = zwy(ji,jj,jk)
+                  !
+                  zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) )
+               END DO
+            END DO
+            !
+            DO jj = 2, jpjm1                    ! partial horizontal divergence
+               DO ji = fs_2, fs_jpim1
+                  zhdiv(ji,jj,jk) = (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
+                     &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
+               END DO
+            END DO
+            !
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = zwx(ji,jj,jk) - zwx_sav(ji,jj)
+                  zwy(ji,jj,jk) = zwy(ji,jj,jk) - zwy_sav(ji,jj)
+               END DO
+            END DO
+         END DO
+         !
+         !                                !* vertical anti-diffusive flux
+         zwz_sav(:,:,:)   = zwz(:,:,:)
+         ztrs   (:,:,:,1) = ptb(:,:,:,jn)
+         zwzts  (:,:,:)   = 0._wp
+         !
+         DO jl = 1, kn_fct_zts                  ! Start of sub timestepping loop
+            !
+            IF( jl == 1 ) THEN                        ! Euler forward to kick things off
+               jtb = 1   ;   jtn = 1   ;   jta = 2
+               zts(:) = p2dt * z_rzts
+               jtaken = MOD( kn_fct_zts + 1 , 2)            ! Toggle to collect every second flux
+               !                                            ! starting at jl =1 if kn_fct_zts is odd; 
+               !                                            ! starting at jl =2 otherwise
+            ELSEIF( jl == 2 ) THEN                    ! First leapfrog step
+               jtb = 1   ;   jtn = 2   ;   jta = 3
+               zts(:) = 2._wp * p2dt * z_rzts
+            ELSE                                      ! Shuffle pointers for subsequent leapfrog steps
+               jtb = MOD(jtb,3) + 1
+               jtn = MOD(jtn,3) + 1
+               jta = MOD(jta,3) + 1
+            ENDIF
+            DO jk = 2, jpkm1                          ! interior value
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zwz(ji,jj,jk) = 0.5_wp * pwn(ji,jj,jk) * ( ztrs(ji,jj,jk,jtn) + ztrs(ji,jj,jk-1,jtn) ) * wmask(ji,jj,jk)
+                     IF( jtaken == 0 )   zwzts(ji,jj,jk) = zwzts(ji,jj,jk) + zwz(ji,jj,jk) * zts(jk)    ! Accumulate time-weighted vertcal flux
+                  END DO
+               END DO
+            END DO
+            IF( ln_linssh ) THEN                    ! top value (only in linear free surface case)
+               IF( ln_isfcav ) THEN                      ! ice-shelf cavities
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                     END DO
+                  END DO   
+               ELSE                                      ! no ocean cavities
+                  zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+               ENDIF
+            ENDIF
+            !
+            jtaken = MOD( jtaken + 1 , 2 )
+            !
+            DO jk = 2, jpkm1                             ! total advective trends
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb)                                                 &
+                        &               - zts(jk) * (  zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   &
+                        &                         * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         END DO
+
+         DO jk = 2, jpkm1          ! Anti-diffusive vertical flux using average flux from the sub-timestepping
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zwz(ji,jj,jk) = ( zwzts(ji,jj,jk) * zr_p2dt - zwz_sav(ji,jj,jk) ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
+         CALL lbc_lnk( zwz, 'W',  1. )
+
+         ! 4. monotonicity algorithm
+         ! -------------------------
+         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
+
+
+         ! 5. final trend with corrected fluxes
+         ! ------------------------------------
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (   zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )       &
+                     &                                    + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   )   &
+                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN 
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
+            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
+            !
+            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )   
+            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )  
+            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
+            !
+            CALL wrk_dealloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz )
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)
+           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)
+         ENDIF
+         !
+      END DO
+      !
+      CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav )
+      CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav )
+      CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct_zts')
+      !
+   END SUBROUTINE tra_adv_fct_zts
+
+
+   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE nonosc  ***
+      !!     
+      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
+      !!       scheme and the before field by a nonoscillatory algorithm 
+      !!
+      !! **  Method  :   ... ???
+      !!       warning : pbef and paft must be masked, but the boundaries
+      !!       conditions on the fluxes are not necessary zalezak (1979)
+      !!       drange (1995) multi-dimensional forward-in-time and upstream-
+      !!       in-space based differencing for fluid
+      !!----------------------------------------------------------------------
+      REAL(wp)                         , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ikm1         ! local integer
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars
+      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('nonosc')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
+      !
+      zbig  = 1.e+40_wp
+      zrtrn = 1.e-15_wp
+      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp
+
+      ! Search local extrema
+      ! --------------------
+      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
+      zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ),   &
+         &        paft * tmask - zbig * ( 1._wp - tmask )  )
+      zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ),   &
+         &        paft * tmask + zbig * ( 1._wp - tmask )  )
+
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+
+               ! search maximum in neighbourhood
+               zup = MAX(  zbup(ji  ,jj  ,jk  ),   &
+                  &        zbup(ji-1,jj  ,jk  ), zbup(ji+1,jj  ,jk  ),   &
+                  &        zbup(ji  ,jj-1,jk  ), zbup(ji  ,jj+1,jk  ),   &
+                  &        zbup(ji  ,jj  ,ikm1), zbup(ji  ,jj  ,jk+1)  )
+
+               ! search minimum in neighbourhood
+               zdo = MIN(  zbdo(ji  ,jj  ,jk  ),   &
+                  &        zbdo(ji-1,jj  ,jk  ), zbdo(ji+1,jj  ,jk  ),   &
+                  &        zbdo(ji  ,jj-1,jk  ), zbdo(ji  ,jj+1,jk  ),   &
+                  &        zbdo(ji  ,jj  ,ikm1), zbdo(ji  ,jj  ,jk+1)  )
+
+               ! positive part of the flux
+               zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
+
+               ! negative part of the flux
+               zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
+
+               ! up & down beta terms
+               zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt
+               zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
+               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zbetup, 'T', 1. )   ;   CALL lbc_lnk( zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
+
+      ! 3. monotonic flux in the i & j direction (paa & pbb)
+      ! ----------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+               zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+               zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) )
+               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu )
+
+               zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+               zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+               zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) )
+               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv )
+
+      ! monotonic flux in the k direction, i.e. pcc
+      ! -------------------------------------------
+               za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
+               zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
+               zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) )
+               pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('nonosc')
+      !
+   END SUBROUTINE nonosc
+
+
+   SUBROUTINE interp_4th_cpt( pt_in, pt_out )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interp_4th_cpt  ***
+      !! 
+      !! **  Purpose :   Compute the interpolation of tracer at w-point
+      !!
+      !! **  Method  :   4th order compact interpolation
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! now tracer fields
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pt_out   ! now tracer field interpolated at w-pts
+      !
+      INTEGER :: ji, jj, jk   ! dummy loop integers
+      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt
+      !!----------------------------------------------------------------------
+      
+      DO jk = 3, jpkm1        !==  build the three diagonal matrix  ==!
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwd (ji,jj,jk) = 4._wp
+               zwi (ji,jj,jk) = 1._wp
+               zws (ji,jj,jk) = 1._wp
+               zwrm(ji,jj,jk) = 3._wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+               !
+               IF( tmask(ji,jj,jk+1) == 0._wp) THEN   ! Switch to second order centered at bottom
+                  zwd (ji,jj,jk) = 1._wp
+                  zwi (ji,jj,jk) = 0._wp
+                  zws (ji,jj,jk) = 0._wp
+                  zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )    
+               ENDIF
+            END DO
+         END DO
+      END DO
+      !
+      jk=2                                            ! Switch to second order centered at top
+      DO jj=1,jpj
+         DO ji=1,jpi
+            zwd (ji,jj,jk) = 1._wp
+            zwi (ji,jj,jk) = 0._wp
+            zws (ji,jj,jk) = 0._wp
+            zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+         END DO
+      END DO   
+      !
+      !                       !==  tridiagonal solve  ==!
+      DO jj = 1, jpj                ! first recurrence
+         DO ji = 1, jpi
+            zwt(ji,jj,2) = zwd(ji,jj,2)
+         END DO
+      END DO
+      DO jk = 3, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 1, jpj                ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         DO ji = 1, jpi
+            pt_out(ji,jj,2) = zwrm(ji,jj,2)
+         END DO
+      END DO
+      DO jk = 3, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)             
+            END DO
+         END DO
+      END DO
+
+      DO jj = 1, jpj                ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
+         DO ji = 1, jpi
+            pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 2, -1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !    
+   END SUBROUTINE interp_4th_cpt
+   
+   !!======================================================================
+END MODULE traadv_fct
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90	(revision 6808)
@@ -28,5 +28,5 @@
    PUBLIC   tra_adv_mle_init   ! routine called in traadv.F90
 
-   !                                               !!* namelist namtra_adv_mle *
+   !                                       !!* namelist namtra_adv_mle *
    LOGICAL, PUBLIC ::   ln_mle              ! flag to activate the Mixed Layer Eddy (MLE) parameterisation
    INTEGER         ::   nn_mle              ! MLE type: =0 standard Fox-Kemper ; =1 new formulation
@@ -34,10 +34,10 @@
    INTEGER         ::   nn_conv             ! =1 no MLE in case of convection ; =0 always MLE
    REAL(wp)        ::   rn_ce               ! MLE coefficient
-   !                                           ! parameters used in nn_mle = 0 case
+   !                                        ! parameters used in nn_mle = 0 case
    REAL(wp)        ::   rn_lf                  ! typical scale of mixed layer front
-   REAL(wp)        ::   rn_time             ! time scale for mixing momentum across the mixed layer
-   !                                             ! parameters used in nn_mle = 1 case
-   REAL(wp)        ::   rn_lat                   ! reference latitude for a 5 km scale of ML front
-   REAL(wp)        ::   rn_rho_c_mle         ! Density criterion for definition of MLD used by FK
+   REAL(wp)        ::   rn_time                ! time scale for mixing momentum across the mixed layer
+   !                                        ! parameters used in nn_mle = 1 case
+   REAL(wp)        ::   rn_lat                 ! reference latitude for a 5 km scale of ML front
+   REAL(wp)        ::   rn_rho_c_mle           ! Density criterion for definition of MLD used by FK
 
    REAL(wp) ::   r5_21 = 5.e0 / 21.e0   ! factor used in mle streamfunction computation
@@ -49,8 +49,7 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
@@ -80,5 +79,4 @@
       !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008
       !!----------------------------------------------------------------------
-      !
       INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
       INTEGER                         , INTENT(in   ) ::   kit000     ! first time step index
@@ -93,5 +91,5 @@
       REAL(wp) ::   zcvw, zmvw   !   -      -
       REAL(wp) ::   zc                                     !   -      -
-
+      !
       INTEGER  ::   ii, ij, ik              ! local integers
       INTEGER, DIMENSION(3) ::   ilocu      !
@@ -101,5 +99,5 @@
       INTEGER, POINTER, DIMENSION(:,:) :: inml_mle
       !!----------------------------------------------------------------------
-
+      !
       IF( nn_timing == 1 )  CALL timing_start('tra_adv_mle')
       CALL wrk_alloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH)
@@ -126,5 +124,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zc = fse3t(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points
+               zc = e3t_n(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points
                zmld(ji,jj) = zmld(ji,jj) + zc
                zbm (ji,jj) = zbm (ji,jj) + zc * (rau0 - rhop(ji,jj,jk) ) * r1_rau0
@@ -158,5 +156,5 @@
       END SELECT
       !                                                ! convert density into buoyancy
-      zbm(:,:) = + grav * zbm(:,:) / MAX( fse3t(:,:,1), zmld(:,:) )
+      zbm(:,:) = + grav * zbm(:,:) / MAX( e3t_n(:,:,1), zmld(:,:) )
       !
       !
@@ -171,11 +169,11 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
-               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2u(ji,jj)                                            &
-                  &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp          , e1u(ji,jj)                 )   &
-                  &           / (         e1u(ji,jj)          * MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   )
+               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            &
+                  &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   &
+                  &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   )
                   !
-               zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1v(ji,jj)                                            &
-                  &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp          , e2v(ji,jj)                 )   &
-                  &           / (         e2v(ji,jj)          * MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   )
+               zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1_e2v(ji,jj)                                            &
+                  &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )   &
+                  &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   )
             END DO
          END DO
@@ -184,8 +182,8 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
-               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj) / e1u(ji,jj)          &
+               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               &
                   &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )
                   !
-               zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1v(ji,jj) / e2v(ji,jj)          &
+               zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1_e2v(ji,jj)               &
                   &                  * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )
             END DO
@@ -216,6 +214,6 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
-               zcuw = 1._wp - ( fsdepw(ji+1,jj,jk) + fsdepw(ji,jj,jk) ) * zhu(ji,jj)
-               zcvw = 1._wp - ( fsdepw(ji,jj+1,jk) + fsdepw(ji,jj,jk) ) * zhv(ji,jj)
+               zcuw = 1._wp - ( gdepw_n(ji+1,jj,jk) + gdepw_n(ji,jj,jk) ) * zhu(ji,jj)
+               zcvw = 1._wp - ( gdepw_n(ji,jj+1,jk) + gdepw_n(ji,jj,jk) ) * zhv(ji,jj)
                zcuw = zcuw * zcuw
                zcvw = zcvw * zcvw
@@ -252,6 +250,6 @@
          ! divide by cross distance to give streamfunction with dimensions m^2/s
          DO jk = 1, ikmax+1
-            zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk)/e2u(:,:)
-            zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk)/e1v(:,:)
+            zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk) * r1_e2u(:,:)
+            zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk) * r1_e1v(:,:)
          END DO
          CALL iom_put( "psiu_mle", zpsi_uw )    ! i-mle streamfunction
@@ -281,5 +279,4 @@
       NAMELIST/namtra_adv_mle/ ln_mle , nn_mle, rn_ce, rn_lf, rn_time, rn_lat, nn_mld_uv, nn_conv, rn_rho_c_mle
       !!----------------------------------------------------------------------
-
 
       REWIND( numnam_ref )              ! Namelist namtra_adv_mle in reference namelist : Tracer advection scheme
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90	(revision 6808)
@@ -0,0 +1,277 @@
+MODULE traadv_mus
+   !!======================================================================
+   !!                       ***  MODULE  traadv_mus  ***
+   !! Ocean  tracers:  horizontal & vertical advective trend
+   !!======================================================================
+   !! History :       !  2000-06  (A.Estublier)  for passive tracers
+   !!                 !  2001-08  (E.Durand, G.Madec)  adapted for T & S
+   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!            3.4  !  2012-06  (P. Oddo, M. Vichi) include the upstream where needed
+   !!            3.7  !  2015-09  (G. Madec) add the ice-shelf cavities boundary condition
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_mus   : update the tracer trend with the horizontal
+   !!                   and vertical advection trends using MUSCL scheme
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE dom_oce        ! ocean space and time domain
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! tracers trends manager
+   USE sbcrnf         ! river runoffs
+   USE diaptr         ! poleward transport diagnostics
+   !
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_mus   ! routine called by traadv.F90
+   
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits
+   !                                                           !  and in closed seas (orca 2 and 4 configurations)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index
+   
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_mus( kt, kit000, cdtype, p2dt, pun, pvn, pwn,             &
+      &                                              ptb, pta, kjpt, ld_msc_ups )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE tra_adv_mus  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to total advection of tracers
+      !!              using a MUSCL scheme (Monotone Upstream-centered Scheme for
+      !!              Conservation Laws) and add it to the general tracer trend.
+      !!
+      !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries
+      !!              ld_msc_ups=T : 
+      !!
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
+      !!
+      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
+      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      LOGICAL                              , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl
+      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
+      INTEGER  ::   ierr                 ! local integer
+      REAL(wp) ::   zu, z0u, zzwx, zw    ! local scalars
+      REAL(wp) ::   zv, z0v, zzwy, z0w   !   -      -
+      REAL(wp) ::   zalpha               !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      - 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_mus')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '        : mixed up-stream           ', ld_msc_ups
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         IF(lwp) WRITE(numout,*)
+         !
+         ! Upstream / MUSCL scheme indicator
+         !
+         ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr )
+         xind(:,:,:) = 1._wp              ! set equal to 1 where up-stream is not needed
+         !
+         IF( ld_msc_ups ) THEN            ! define the upstream indicator (if asked)
+            ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
+            upsmsk(:,:) = 0._wp                             ! not upstream by default
+            !
+            DO jk = 1, jpkm1
+               xind(:,:,jk) = 1._wp                              &                 ! =>1 where up-stream is not needed
+                  &         - MAX ( rnfmsk(:,:) * rnfmsk_z(jk),  &                 ! =>0 near runoff mouths (& closed sea outflows)
+                  &                 upsmsk(:,:)                ) * tmask(:,:,jk)   ! =>0 in some user defined area
+            END DO
+         ENDIF 
+         !
+      ENDIF 
+      !      
+      DO jn = 1, kjpt            !==  loop over the tracers  ==!
+         !
+         !                          !* Horizontal advective fluxes
+         !
+         !                                !-- first guess of the slopes
+         zwx(:,:,jpk) = 0._wp                   ! bottom values
+         zwy(:,:,jpk) = 0._wp  
+         DO jk = 1, jpkm1                       ! interior values
+            DO jj = 1, jpjm1      
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
+                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+           END DO
+         END DO
+         CALL lbc_lnk( zwx, 'U', -1. )          ! lateral boundary conditions   (changed sign)
+         CALL lbc_lnk( zwy, 'V', -1. )
+         !                                !-- Slopes of tracer
+         zslpx(:,:,jpk) = 0._wp                 ! bottom values
+         zslpy(:,:,jpk) = 0._wp
+         DO jk = 1, jpkm1                       ! interior values
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
+                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1                 !-- Slopes limitation
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
+                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
+               END DO
+           END DO
+         END DO
+         !
+         DO jk = 1, jpkm1                 !-- MUSCL horizontal advective fluxes
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! MUSCL fluxes
+                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
+                  zalpha = 0.5 - z0u
+                  zu  = z0u - 0.5 * pun(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+                  zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk)
+                  zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk)
+                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+                  !
+                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
+                  zalpha = 0.5 - z0v
+                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+                  zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk)
+                  zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk)
+                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )   ! lateral boundary conditions   (changed sign)
+         !
+         DO jk = 1, jpkm1                 !-- Tracer advective trend
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       &
+                  &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     &
+                  &                                   * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+           END DO
+         END DO        
+         !                                ! trend diagnostics
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.   &
+            &( cdtype == 'TRC' .AND. l_trdtrc )      )  THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) )
+         END IF
+         !                                ! "Poleward" heat and salt transports
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
+            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
+         ENDIF
+         !
+         !                          !* Vertical advective fluxes
+         !
+         !                                !-- first guess of the slopes
+         zwx(:,:, 1 ) = 0._wp                   ! surface & bottom boundary conditions
+         zwx(:,:,jpk) = 0._wp
+         DO jk = 2, jpkm1                       ! interior values
+            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
+         END DO
+         !                                !-- Slopes of tracer
+         zslpx(:,:,1) = 0._wp                   ! surface values
+         DO jk = 2, jpkm1                       ! interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) =                     ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )  &
+                     &            * (  0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) )  )
+               END DO
+            END DO
+         END DO
+         DO jk = 2, jpkm1                 !-- Slopes limitation
+            DO jj = 1, jpj                      ! interior values
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
+               END DO
+            END DO
+         END DO
+         DO jk = 1, jpk-2                 !-- vertical advective flux
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
+                  zalpha = 0.5 + z0w
+                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w_n(ji,jj,jk+1)
+                  zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1)
+                  zzwy = ptb(ji,jj,jk  ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk  )
+                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) * wmask(ji,jj,jk)
+               END DO 
+            END DO
+         END DO
+         IF( ln_linssh ) THEN                   ! top values, linear free surface only
+            IF( ln_isfcav ) THEN                      ! ice-shelf cavities (top of the ocean)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwx(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)
+                  END DO
+               END DO   
+            ELSE                                      ! no cavities: only at the ocean surface
+               zwx(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+            ENDIF
+         ENDIF
+         !
+         DO jk = 1, jpkm1                 !-- vertical advective trend
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                                ! send trends for diagnostic
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.     &
+            &( cdtype == 'TRC' .AND. l_trdtrc )      )   &
+            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) )
+         !
+      END DO                     ! end of tracer loop
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_mus')
+      !
+   END SUBROUTINE tra_adv_mus
+
+   !!======================================================================
+END MODULE traadv_mus
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 6807)
+++ 	(revision )
@@ -1,300 +1,0 @@
-MODULE traadv_muscl
-   !!======================================================================
-   !!                       ***  MODULE  traadv_muscl  ***
-   !! Ocean  tracers:  horizontal & vertical advective trend
-   !!======================================================================
-   !! History :       !  2000-06  (A.Estublier)  for passive tracers
-   !!                 !  2001-08  (E.Durand, G.Madec)  adapted for T & S
-   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
-   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!            3.4  !  2012-06  (P. Oddo, M. Vichi) include the upstream where needed
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_muscl : update the tracer trend with the horizontal
-   !!                   and vertical advection trends using MUSCL scheme
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE trc_oce        ! share passive tracers/Ocean variables
-   USE dom_oce        ! ocean space and time domain
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! tracers trends manager
-   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient
-   USE sbcrnf         ! river runoffs
-   USE diaptr         ! poleward transport diagnostics
-   !
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! distribued memory computing
-   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_muscl   ! routine called by traadv.F90
-   
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits
-   !                                                           !  and in closed seas (orca 2 and 4 configurations)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index
-   
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_muscl( kt, kit000, cdtype, p2dt, pun, pvn, pwn,   &
-      &                                                ptb, pta, kjpt, ld_msc_ups )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE tra_adv_muscl  ***
-      !!
-      !! ** Purpose :   Compute the now trend due to total advection of T and 
-      !!      S using a MUSCL scheme (Monotone Upstream-centered Scheme for
-      !!      Conservation Laws) and add it to the general tracer trend.
-      !!
-      !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries
-      !!
-      !! ** Action  : - update (ta,sa) with the now advective tracer trends
-      !!              - save trends 
-      !!
-      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
-      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
-      !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      LOGICAL                              , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl
-      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
-      !
-      INTEGER  ::   ji, jj, jk, jn            ! dummy loop indices
-      INTEGER  ::   ierr                      ! local integer
-      REAL(wp) ::   zu, z0u, zzwx, zw         ! local scalars
-      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      -
-      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      - 
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_muscl')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy )
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '        : mixed up-stream           ', ld_msc_ups
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-         IF(lwp) WRITE(numout,*)
-         !
-         !
-         IF( ld_msc_ups ) THEN
-            IF( .NOT. ALLOCATED( upsmsk ) )  THEN
-                ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
-                IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_muscl: unable to allocate upsmsk array')
-            ENDIF
-            upsmsk(:,:) = 0._wp                             ! not upstream by default
-         ENDIF
-
-         IF( .NOT. ALLOCATED( xind ) ) THEN
-             ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr )
-             IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_muscl: unable to allocate zind array')
-         ENDIF
-         !
-
-         !
-         ! Upstream / MUSCL scheme indicator
-         ! ------------------------------------
-!!gm  useless
-         xind(:,:,:) = 1._wp                             ! set equal to 1 where up-stream is not needed
-!!gm
-         !
-         IF( ld_msc_ups )  THEN
-            DO jk = 1, jpkm1
-               xind(:,:,jk) = 1._wp                              &                 ! =>1 where up-stream is not needed
-                  &         - MAX ( rnfmsk(:,:) * rnfmsk_z(jk),  &                 ! =>0 near runoff mouths (& closed sea outflows)
-                  &                 upsmsk(:,:)                ) * tmask(:,:,jk)   ! =>0 near some straits
-            END DO
-         ENDIF 
-         !
-      ENDIF 
-      !      
-      !                                                     ! ===========
-      DO jn = 1, kjpt                                       ! tracer loop
-         !                                                  ! ===========
-         ! I. Horizontal advective fluxes
-         ! ------------------------------
-         ! first guess of the slopes
-         zwx(:,:,jpk) = 0.e0   ;   zwy(:,:,jpk) = 0.e0        ! bottom values
-         ! interior values
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1      
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
-                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
-               END DO
-           END DO
-         END DO
-         !
-         CALL lbc_lnk( zwx, 'U', -1. )                        ! lateral boundary conditions on zwx, zwy   (changed sign)
-         CALL lbc_lnk( zwy, 'V', -1. )
-         !                                             !-- Slopes of tracer
-         zslpx(:,:,jpk) = 0.e0   ;   zslpy(:,:,jpk) = 0.e0    ! bottom values
-         DO jk = 1, jpkm1                                     ! interior values
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
-                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, jpkm1                                     ! Slopes limitation
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
-                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
-                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
-                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
-                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
-                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
-               END DO
-           END DO
-         END DO             ! interior values
-
-         !                                             !-- MUSCL horizontal advective fluxes
-         DO jk = 1, jpkm1                                     ! interior values
-            zdt  = p2dt(jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! MUSCL fluxes
-                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
-                  zalpha = 0.5 - z0u
-                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
-                  zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk)
-                  zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk)
-                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-                  !
-                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
-                  zalpha = 0.5 - z0v
-                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
-                  zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk)
-                  zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk)
-                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-               END DO
-            END DO
-         END DO
-         !                                                    ! lateral boundary conditions on zwx, zwy   (changed sign)
-         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )
-         !
-         ! Tracer flux divergence at t-point added to the general trend
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! horizontal advective trends
-                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-                  &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )
-                  ! add it to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-           END DO
-         END DO        
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.   &
-            &( cdtype == 'TRC' .AND. l_trdtrc )      )  THEN
-            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) )
-            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) )
-         END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
-
-         ! II. Vertical advective fluxes
-         ! -----------------------------
-         !                                             !-- first guess of the slopes
-         zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0    ! surface & bottom boundary conditions
-         DO jk = 2, jpkm1                                     ! interior values
-            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
-         END DO
-
-         !                                             !-- Slopes of tracer
-         zslpx(:,:,1) = 0.e0                                  ! surface values
-         DO jk = 2, jpkm1                                     ! interior value
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )
-               END DO
-            END DO
-         END DO
-         !                                             !-- Slopes limitation
-         DO jk = 2, jpkm1                                     ! interior values
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
-                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
-                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
-               END DO
-            END DO
-         END DO
-         !                                             !-- vertical advective flux
-         !                                                    ! surface values  (bottom already set to zero)
-         IF( lk_vvl ) THEN    ;   zwx(:,:, 1 ) = 0.e0                      !  variable volume
-         ELSE                 ;   zwx(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface
-         ENDIF 
-         !
-         DO jk = 1, jpkm1                                     ! interior values
-            zdt  = p2dt(jk)
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) )
-                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
-                  zalpha = 0.5 + z0w
-                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr 
-                  zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1)
-                  zzwy = ptb(ji,jj,jk  ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk  )
-                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-               END DO 
-            END DO
-         END DO
-
-         DO jk = 1, jpkm1                    ! Compute & add the vertical advective trend
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! vertical advective trends 
-                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
-                  ! add it to the general tracer trends
-                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-         END DO
-         !                                 ! Save the vertical advective trends for diagnostic
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.     &
-            &( cdtype == 'TRC' .AND. l_trdtrc )      )   &
-            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) )
-         !
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_muscl')
-      !
-   END SUBROUTINE tra_adv_muscl
-
-   !!======================================================================
-END MODULE traadv_muscl
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 6807)
+++ 	(revision )
@@ -1,293 +1,0 @@
-MODULE traadv_muscl2
-   !!======================================================================
-   !!                       ***  MODULE  traadv_muscl2  ***
-   !! Ocean  tracers:  horizontal & vertical advective trend
-   !!======================================================================
-   !! History :  1.0  !  2002-06  (G. Madec) from traadv_muscl
-   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_muscl2 : update the tracer trend with the horizontal
-   !!                    and vertical advection trends using MUSCL2 scheme
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE dom_oce         ! ocean space and time domain
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
-   USE in_out_manager  ! I/O manager
-   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
-   USE diaptr          ! poleward transport diagnostics
-   !
-   USE lib_mpp         ! distribued memory computing
-   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_muscl2        ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_muscl2( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
-      &                                         ptb, ptn, pta, kjpt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE tra_adv_muscl2  ***
-      !!
-      !! ** Purpose :   Compute the now trend due to total advection of T and 
-      !!      S using a MUSCL scheme (Monotone Upstream-centered Scheme for
-      !!      Conservation Laws) and add it to the general tracer trend.
-      !!
-      !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries
-      !!
-      !! ** Action  : - update (pta) with the now advective tracer trends
-      !!              - save trends 
-      !!
-      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
-      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
-      !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before & now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
-      !!
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zu, z0u, zzwx, zw         ! local scalars
-      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      -
-      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy , zwx, zwy
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_muscl2')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy )
-      !
-
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
-      ENDIF
-      !
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         ! I. Horizontal advective fluxes
-         ! ------------------------------
-         ! first guess of the slopes
-         zwx(:,:,jpk) = 0.e0   ;   zwy(:,:,jpk) = 0.e0        ! bottom values
-         ! interior values
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1      
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
-                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
-               END DO
-           END DO
-         END DO
-         !
-         CALL lbc_lnk( zwx, 'U', -1. )                        ! lateral boundary conditions on zwx, zwy   (changed sign)
-         CALL lbc_lnk( zwy, 'V', -1. )
-         !                                             !-- Slopes of tracer
-         zslpx(:,:,jpk) = 0.e0   ;   zslpy(:,:,jpk) = 0.e0    ! bottom values
-         DO jk = 1, jpkm1                                     ! interior values
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
-                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, jpkm1                                     ! Slopes limitation
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
-                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
-                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
-                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
-                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
-                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
-               END DO
-           END DO
-         END DO             ! interior values
-
-        !                                             !-- MUSCL horizontal advective fluxes
-         DO jk = 1, jpkm1                                     ! interior values
-            zdt  = p2dt(jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! MUSCL fluxes
-                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
-                  zalpha = 0.5 - z0u
-                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
-                  zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk)
-                  zzwy = ptb(ji  ,jj,jk,jn) + zu * zslpx(ji  ,jj,jk)
-                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-                  !
-                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
-                  zalpha = 0.5 - z0v
-                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
-                  zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk)
-                  zzwy = ptb(ji,jj  ,jk,jn) + zv * zslpy(ji,jj  ,jk)
-                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-               END DO
-            END DO
-         END DO
-
-         !!  centered scheme at lateral b.C. if off-shore velocity
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF( umask(ji,jj,jk) == 0. ) THEN
-                     IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
-                        zwx(ji+1,jj,jk) = 0.5 * pun(ji+1,jj,jk) * ( ptn(ji+1,jj,jk,jn) + ptn(ji+2,jj,jk,jn) )
-                     ENDIF
-                     IF( pun(ji-1,jj,jk) < 0. ) THEN
-                        zwx(ji-1,jj,jk) = 0.5 * pun(ji-1,jj,jk) * ( ptn(ji-1,jj,jk,jn) + ptn(ji,jj,jk,jn) ) 
-                     ENDIF
-                  ENDIF
-                  IF( vmask(ji,jj,jk) == 0. ) THEN
-                     IF( pvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
-                        zwy(ji,jj+1,jk) = 0.5 * pvn(ji,jj+1,jk) * ( ptn(ji,jj+1,jk,jn) + ptn(ji,jj+2,jk,jn) )
-                     ENDIF
-                     IF( pvn(ji,jj-1,jk) < 0. ) THEN
-                        zwy(ji,jj-1,jk) = 0.5 * pvn(ji,jj-1,jk) * ( ptn(ji,jj-1,jk,jn) + ptn(ji,jj,jk,jn) ) 
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )   ! lateral boundary condition (changed sign)
-
-         ! Tracer flux divergence at t-point added to the general trend
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! horizontal advective trends 
-                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-                  &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )
-                  ! added to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-           END DO
-         END DO
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.   &
-            &( cdtype == 'TRC' .AND. l_trdtrc )      ) THEN
-            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) )
-            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) )
-         END IF
-
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
-            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
-
-         ! II. Vertical advective fluxes
-         ! -----------------------------
-         !                                             !-- first guess of the slopes
-         zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0    ! surface & bottom boundary conditions
-         DO jk = 2, jpkm1                                     ! interior values
-            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
-         END DO
-
-         !                                             !-- Slopes of tracer
-         zslpx(:,:,1) = 0.e0                                  ! surface values
-         DO jk = 2, jpkm1                                     ! interior value
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   &
-                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )
-               END DO
-            END DO
-         END DO
-         !                                             !-- Slopes limitation
-         DO jk = 2, jpkm1                                     ! interior values
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
-                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
-                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
-               END DO
-            END DO
-         END DO
-         !                                             !-- vertical advective flux
-         !                                                    ! surface values  (bottom already set to zero)
-         IF( lk_vvl ) THEN    ;   zwx(:,:, 1 ) = 0.e0                      !  variable volume
-         ELSE                 ;   zwx(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface
-         ENDIF
-         !
-         DO jk = 1, jpkm1                                     ! interior values
-            zdt  = p2dt(jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) )
-                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
-                  zalpha = 0.5 + z0w
-                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr
-                  zzwx = ptb(ji,jj,jk+1,jn) + zw * zslpx(ji,jj,jk+1)
-                  zzwy = ptb(ji,jj,jk  ,jn) + zw * zslpx(ji,jj,jk  )
-                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 2, jpkm1        ! centered near the bottom
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF( tmask(ji,jj,jk+1) == 0. ) THEN
-                     IF( pwn(ji,jj,jk) > 0. ) THEN
-                        zwx(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) 
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, jpkm1        ! Compute & add the vertical advective trend
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! vertical advective trends 
-                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
-                  ! added to the general tracer trends
-                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-         END DO
-         !                       ! trend diagnostics (contribution of upstream fluxes)
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.     &
-            &( cdtype == 'TRC' .AND. l_trdtrc )      )   &
-            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) )
-         !
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_muscl2')
-      !
-   END SUBROUTINE tra_adv_muscl2
-
-   !!======================================================================
-END MODULE traadv_muscl2
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 6808)
@@ -20,5 +20,4 @@
    USE trd_oce         ! trends: ocean variables
    USE trdtra          ! trends manager: tracers 
-   USE dynspg_oce      ! surface pressure gradient variables
    USE diaptr          ! poleward transport diagnostics
    !
@@ -39,5 +38,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -79,6 +77,7 @@
       !!            prevent the appearance of spurious numerical oscillations
       !!
-      !! ** Action : - update (pta) with the now advective tracer trends
-      !!             - save the trends 
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
       !!
       !! ** Reference : Leonard (1979, 1991)
@@ -88,5 +87,5 @@
       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
@@ -102,12 +101,13 @@
          IF(lwp) WRITE(numout,*)
       ENDIF
+      !
       l_trd = .FALSE.
       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
       !
-      ! I. The horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme
+      !        ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme
       CALL tra_adv_qck_i( kt, cdtype, p2dt, pun, ptb, ptn, pta, kjpt ) 
       CALL tra_adv_qck_j( kt, cdtype, p2dt, pvn, ptb, ptn, pta, kjpt ) 
 
-      ! II. The vertical fluxes are computed with the 2nd order centered scheme
+      !        ! vertical fluxes are computed with the 2nd order centered scheme
       CALL tra_adv_cen2_k( kt, cdtype, pwn,         ptn, pta, kjpt )
       !
@@ -125,12 +125,12 @@
       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
-      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt       ! vertical profile of tracer time-step
+      REAL(wp)                             , INTENT(in   ) ::   p2dt       ! tracer time-step
       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun        ! i-velocity components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
       !!
-      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zfu, zfc, zfd
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   ztra, zbtr, zdir, zdx, zmsk   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zfu, zfc, zfd
       !----------------------------------------------------------------------
       !
@@ -139,16 +139,13 @@
       DO jn = 1, kjpt                                            ! tracer loop
          !                                                       ! ===========
-         zfu(:,:,:) = 0.0     ;   zfc(:,:,:) = 0.0  
-         zfd(:,:,:) = 0.0     ;   zwx(:,:,:) = 0.0     
-         !                                                  
-         DO jk = 1, jpkm1                                
-            !                                             
-            !--- Computation of the ustream and downstream value of the tracer and the mask
+         zfu(:,:,:) = 0._wp     ;   zfc(:,:,:) = 0._wp 
+         zfd(:,:,:) = 0._wp     ;   zwx(:,:,:) = 0._wp   
+         !
+!!gm why not using a SHIFT instruction...
+         DO jk = 1, jpkm1     !--- Computation of the ustream and downstream value of the tracer and the mask
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! Upstream in the x-direction for the tracer
-                  zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn)
-                  ! Downstream in the x-direction for the tracer
-                  zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn)
+                  zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn)        ! Upstream   in the x-direction for the tracer
+                  zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn)        ! Downstream in the x-direction for the tracer
                END DO
             END DO
@@ -159,5 +156,4 @@
          ! Horizontal advective fluxes
          ! ---------------------------
-         !
          DO jk = 1, jpkm1                             
             DO jj = 2, jpjm1
@@ -170,10 +166,9 @@
          !
          DO jk = 1, jpkm1  
-            zdt =  p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.   
                   zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
-                  zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * fse3u(ji,jj,jk)
-                  zwx(ji,jj,jk)  = ABS( pun(ji,jj,jk) ) * zdt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+                  zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u_n(ji,jj,jk)
+                  zwx(ji,jj,jk)  = ABS( pun(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
                   zfc(ji,jj,jk)  = zdir * ptb(ji  ,jj,jk,jn) + ( 1. - zdir ) * ptb(ji+1,jj,jk,jn)  ! FC in the x-direction for T
                   zfd(ji,jj,jk)  = zdir * ptb(ji+1,jj,jk,jn) + ( 1. - zdir ) * ptb(ji  ,jj,jk,jn)  ! FD in the x-direction for T
@@ -220,5 +215,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.  
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                   ! horizontal advective trends
                   ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) )
@@ -228,5 +223,5 @@
             END DO
          END DO
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         !                                 ! trend diagnostics
          IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )
          !
@@ -246,5 +241,5 @@
       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
-      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt       ! vertical profile of tracer time-step
+      REAL(wp)                             , INTENT(in   ) ::   p2dt       ! tracer time-step
       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn        ! j-velocity components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
@@ -252,5 +247,5 @@
       !!
       INTEGER  :: ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars
+      REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk   ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwy, zfu, zfc, zfd
       !----------------------------------------------------------------------
@@ -293,10 +288,9 @@
          !
          DO jk = 1, jpkm1  
-            zdt =  p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.   
                   zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
-                  zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * fse3v(ji,jj,jk)
-                  zwy(ji,jj,jk)  = ABS( pvn(ji,jj,jk) ) * zdt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+                  zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v_n(ji,jj,jk)
+                  zwy(ji,jj,jk)  = ABS( pvn(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
                   zfc(ji,jj,jk)  = zdir * ptb(ji,jj  ,jk,jn) + ( 1. - zdir ) * ptb(ji,jj+1,jk,jn)  ! FC in the x-direction for T
                   zfd(ji,jj,jk)  = zdir * ptb(ji,jj+1,jk,jn) + ( 1. - zdir ) * ptb(ji,jj  ,jk,jn)  ! FD in the x-direction for T
@@ -344,5 +338,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.  
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                   ! horizontal advective trends
                   ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) )
@@ -352,5 +346,5 @@
             END DO
          END DO
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         !                                 ! trend diagnostics
          IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )
          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
@@ -380,45 +374,49 @@
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zbtr , ztra      ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz
       !!----------------------------------------------------------------------
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zwz )
+      CALL wrk_alloc( jpi,jpj,jpk,   zwz )
+      !
+      zwz(:,:, 1 ) = 0._wp       ! surface & bottom values set to zero for all tracers
+      zwz(:,:,jpk) = 0._wp
+      !
       !                                                          ! ===========
       DO jn = 1, kjpt                                            ! tracer loop
          !                                                       ! ===========
-         ! 1. Bottom value : flux set to zero
-         zwz(:,:,jpk) = 0.e0             ! Bottom value : flux set to zero
-         !
-         !                                 ! Surface value
-         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                      ! Variable volume : flux set to zero
-         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)   ! Constant volume : advective flux through the surface
+         !
+         DO jk = 2, jpkm1                    !* Interior point   (w-masked 2nd order centered flux)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_linssh ) THEN                !* top value   (only in linear free surf. as zwz is multiplied by wmask)
+            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                  END DO
+               END DO   
+            ELSE                                   ! no ocean cavities (only ocean surface)
+               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn)
+            ENDIF
          ENDIF
          !
-         DO jk = 2, jpkm1                  ! Interior point: second order centered tracer flux at w-point
+         DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==!
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) )
-               END DO
-            END DO
-         END DO
-         !
-         DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==!
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! k- vertical advective trends 
-                  ztra = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) 
-                  ! added to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-         END DO
-         !                                 ! Save the vertical advective trends for diagnostic
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   &
+                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                                 ! Send trends for diagnostic
          IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) )
          !
       END DO
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zwz )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwz )
       !
    END SUBROUTINE tra_adv_cen2_k
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 6807)
+++ 	(revision )
@@ -1,684 +1,0 @@
-MODULE traadv_tvd
-   !!==============================================================================
-   !!                       ***  MODULE  traadv_tvd  ***
-   !! Ocean  tracers:  horizontal & vertical advective trend
-   !!==============================================================================
-   !! History :  OPA  !  1995-12  (L. Mortier)  Original code
-   !!                 !  2000-01  (H. Loukos)  adapted to ORCA 
-   !!                 !  2000-10  (MA Foujols E.Kestenare)  include file not routine
-   !!                 !  2000-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes
-   !!                 !  2001-07  (E. Durand G. Madec)  adaptation to ORCA config
-   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
-   !!    NEMO    1.0  !  2004-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl
-   !!            2.0  !  2008-04  (S. Cravatte) add the i-, j- & k- trends computation
-   !!             -   !  2009-11  (V. Garnier) Surface pressure gradient organization
-   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_tvd   : update the tracer trend with the 3D advection trends using a TVD scheme
-   !!   nonosc        : compute monotonic tracer fluxes by a non-oscillatory algorithm 
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE dom_oce        ! ocean space and time domain
-   USE trc_oce        ! share passive tracers/Ocean variables
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! tracers trends
-   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient
-   USE diaptr         ! poleward transport diagnostics
-   !
-   USE lib_mpp        ! MPP library
-   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
-   USE in_out_manager ! I/O manager
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_tvd        ! routine called by traadv.F90
-   PUBLIC   tra_adv_tvd_zts    ! routine called by traadv.F90
-
-   LOGICAL ::   l_trd   ! flag to compute trends
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_tvd ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
-      &                                       ptb, ptn, pta, kjpt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_tvd  ***
-      !! 
-      !! **  Purpose :   Compute the now trend due to total advection of 
-      !!       tracers and add it to the general trend of tracer equations
-      !!
-      !! **  Method  :   TVD scheme, i.e. 2nd order centered scheme with
-      !!       corrected flux (monotonic correction)
-      !!       note: - this advection scheme needs a leap-frog time scheme
-      !!
-      !! ** Action : - update (pta) with the now advective tracer trends
-      !!             - save the trends 
-      !!----------------------------------------------------------------------
-      USE oce     , ONLY:   zwx => ua        , zwy => va          ! (ua,va) used as workspace
-      !
-      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
-      !
-      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices
-      INTEGER  ::   ik  
-      REAL(wp) ::   z2dtt, zbtr, ztra        ! local scalar
-      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
-      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz )
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-         !
-         l_trd = .FALSE.
-         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
-      ENDIF
-      !
-      IF( l_trd )  THEN
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
-         ztrdx(:,:,:) = 0.e0   ;    ztrdy(:,:,:) = 0.e0   ;   ztrdz(:,:,:) = 0.e0
-      ENDIF
-      !
-      zwi(:,:,:) = 0.e0 ; 
-      !
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         ! 1. Bottom and k=1 value : flux set to zero
-         ! ----------------------------------
-         zwx(:,:,jpk) = 0.e0    ;    zwz(:,:,jpk) = 0.e0
-         zwy(:,:,jpk) = 0.e0    ;    zwi(:,:,jpk) = 0.e0
-          
-         zwz(:,:,1  ) = 0._wp
-         ! 2. upstream advection with initial mass fluxes & intermediate update
-         ! --------------------------------------------------------------------
-         ! upstream tracer flux in the i and j direction
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ! upstream scheme
-                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
-                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
-                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
-                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
-                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
-                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) )
-               END DO
-            END DO
-         END DO
-
-         ! upstream tracer flux in the k direction
-         ! Interior value
-         DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
-                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
-                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         ! Surface value
-         IF( lk_vvl ) THEN   
-            IF ( ln_isfcav ) THEN
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zwz(ji,jj, mikt(ji,jj) ) = 0.e0          ! volume variable
-                  END DO
-               END DO
-            ELSE
-               zwz(:,:,1) = 0.e0          ! volume variable
-            END IF
-         ELSE                
-            IF ( ln_isfcav ) THEN
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
-                  END DO
-               END DO   
-            ELSE
-               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface
-            END IF
-         ENDIF
-
-         ! total advective trend
-         DO jk = 1, jpkm1
-            z2dtt = p2dt(jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! total intermediate advective trends
-                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
-                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
-                  ! update and guess with monotonic sheme
-                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra   * tmask(ji,jj,jk)
-                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         !                             ! Lateral boundary conditions on zwi  (unchanged sign)
-         CALL lbc_lnk( zwi, 'T', 1. )  
-
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
-         IF( l_trd )  THEN 
-            ! store intermediate advective trends
-            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
-         END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
-
-         ! 3. antidiffusive flux : high order minus low order
-         ! --------------------------------------------------
-         ! antidiffusive flux on i and j
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)
-                  zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      
-         ! antidiffusive flux on k
-         ! Interior value
-         DO jk = 2, jpkm1                    
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         ! surface value
-         IF ( ln_isfcav ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zwz(ji,jj,mikt(ji,jj)) = 0.e0
-               END DO
-            END DO
-         ELSE
-            zwz(:,:,1) = 0.e0
-         END IF
-         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
-         CALL lbc_lnk( zwz, 'W',  1. )
-
-         ! 4. monotonicity algorithm
-         ! -------------------------
-         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
-
-
-         ! 5. final trend with corrected fluxes
-         ! ------------------------------------
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.  
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! total advective trends
-                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
-                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
-                  ! add them to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
-         IF( l_trd )  THEN 
-            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
-            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
-            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
-            
-            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )   
-            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )  
-            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
-         END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)
-         ENDIF
-         !
-      END DO
-      !
-                   CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz )
-      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd')
-      !
-   END SUBROUTINE tra_adv_tvd
-
-   SUBROUTINE tra_adv_tvd_zts ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
-      &                                       ptb, ptn, pta, kjpt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_tvd_zts  ***
-      !! 
-      !! **  Purpose :   Compute the now trend due to total advection of 
-      !!       tracers and add it to the general trend of tracer equations
-      !!
-      !! **  Method  :   TVD ZTS scheme, i.e. 2nd order centered scheme with
-      !!       corrected flux (monotonic correction). This version use sub-
-      !!       timestepping for the vertical advection which increases stability
-      !!       when vertical metrics are small.
-      !!       note: - this advection scheme needs a leap-frog time scheme
-      !!
-      !! ** Action : - update (pta) with the now advective tracer trends
-      !!             - save the trends 
-      !!----------------------------------------------------------------------
-      USE oce     , ONLY:   zwx => ua        , zwy => va          ! (ua,va) used as workspace
-      !
-      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
-      !
-      REAL(wp), DIMENSION( jpk )                           ::   zts             ! length of sub-timestep for vertical advection
-      REAL(wp), DIMENSION( jpk )                           ::   zr_p2dt         ! reciprocal of tracer timestep
-      INTEGER  ::   ji, jj, jk, jl, jn       ! dummy loop indices  
-      INTEGER  ::   jnzts = 5       ! number of sub-timesteps for vertical advection
-      INTEGER  ::   jtb, jtn, jta   ! sub timestep pointers for leap-frog/euler forward steps
-      INTEGER  ::   jtaken          ! toggle for collecting appropriate fluxes from sub timesteps
-      REAL(wp) ::   z_rzts          ! Fractional length of Euler forward sub-timestep for vertical advection
-      REAL(wp) ::   z2dtt, zbtr, ztra        ! local scalar
-      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
-      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zwx_sav , zwy_sav
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd_zts')
-      !
-      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, 3, ztrs )
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_tvd_zts : TVD ZTS advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-      !
-      l_trd = .FALSE.
-      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
-      !
-      IF( l_trd )  THEN
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
-         ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp
-      ENDIF
-      !
-      zwi(:,:,:) = 0._wp
-      z_rzts = 1._wp / REAL( jnzts, wp )
-      zr_p2dt(:) = 1._wp / p2dt(:)
-      !
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         ! 1. Bottom value : flux set to zero
-         ! ----------------------------------
-         zwx(:,:,jpk) = 0._wp   ;    zwz(:,:,jpk) = 0._wp
-         zwy(:,:,jpk) = 0._wp   ;    zwi(:,:,jpk) = 0._wp
-
-         ! 2. upstream advection with initial mass fluxes & intermediate update
-         ! --------------------------------------------------------------------
-         ! upstream tracer flux in the i and j direction
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ! upstream scheme
-                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
-                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
-                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
-                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
-                  zwx(ji,jj,jk) = 0.5_wp * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
-                  zwy(ji,jj,jk) = 0.5_wp * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) )
-               END DO
-            END DO
-         END DO
-
-         ! upstream tracer flux in the k direction
-         ! Interior value
-         DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
-                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
-                  zwz(ji,jj,jk) = 0.5_wp * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) )
-               END DO
-            END DO
-         END DO
-         ! Surface value
-         IF( lk_vvl ) THEN
-            IF ( ln_isfcav ) THEN
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zwz(ji,jj, mikt(ji,jj) ) = 0.e0          ! volume variable +    isf
-                  END DO
-               END DO
-            ELSE
-               zwz(:,:,1) = 0.e0                              ! volume variable + no isf
-            END IF
-         ELSE
-            IF ( ln_isfcav ) THEN
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface +    isf
-                  END DO
-               END DO
-            ELSE
-               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)                                               ! linear free surface + no isf
-            END IF
-         ENDIF
-
-         ! total advective trend
-         DO jk = 1, jpkm1
-            z2dtt = p2dt(jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! total intermediate advective trends
-                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
-                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
-                  ! update and guess with monotonic sheme
-                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra
-                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         !                             ! Lateral boundary conditions on zwi  (unchanged sign)
-         CALL lbc_lnk( zwi, 'T', 1. )  
-
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
-         IF( l_trd )  THEN 
-            ! store intermediate advective trends
-            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
-         END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
-         ENDIF
-
-         ! 3. antidiffusive flux : high order minus low order
-         ! --------------------------------------------------
-         ! antidiffusive flux on i and j
-
-
-         DO jk = 1, jpkm1
-
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwx_sav(ji,jj) = zwx(ji,jj,jk)
-                  zwy_sav(ji,jj) = zwy(ji,jj,jk)
-
-                  zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) )
-                  zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) )
-               END DO
-            END DO
-
-            DO jj = 2, jpjm1         ! partial horizontal divergence
-               DO ji = fs_2, fs_jpim1
-                  zhdiv(ji,jj,jk) = (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
-                     &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
-               END DO
-            END DO
-
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zwx(ji,jj,jk) = zwx(ji,jj,jk)  - zwx_sav(ji,jj)
-                  zwy(ji,jj,jk) = zwy(ji,jj,jk)  - zwy_sav(ji,jj)
-               END DO
-            END DO
-         END DO
-      
-         ! antidiffusive flux on k
-         zwz(:,:,1) = 0._wp        ! Surface value
-         zwz_sav(:,:,:) = zwz(:,:,:)
-         !
-         ztrs(:,:,:,1) = ptb(:,:,:,jn)
-         zwzts(:,:,:) = 0._wp
-
-         DO jl = 1, jnzts                   ! Start of sub timestepping loop
-
-            IF( jl == 1 ) THEN              ! Euler forward to kick things off
-              jtb = 1   ;   jtn = 1   ;   jta = 2
-              zts(:) = p2dt(:) * z_rzts
-              jtaken = MOD( jnzts + 1 , 2)  ! Toggle to collect every second flux
-                                            ! starting at jl =1 if jnzts is odd; 
-                                            ! starting at jl =2 otherwise
-            ELSEIF( jl == 2 ) THEN          ! First leapfrog step
-              jtb = 1   ;   jtn = 2   ;   jta = 3
-              zts(:) = 2._wp * p2dt(:) * z_rzts
-            ELSE                            ! Shuffle pointers for subsequent leapfrog steps
-              jtb = MOD(jtb,3) + 1
-              jtn = MOD(jtn,3) + 1
-              jta = MOD(jta,3) + 1
-            ENDIF
-            DO jk = 2, jpkm1          ! Interior value
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zwz(ji,jj,jk) = 0.5_wp * pwn(ji,jj,jk) * ( ztrs(ji,jj,jk,jtn) + ztrs(ji,jj,jk-1,jtn) )
-                     IF( jtaken == 0 ) zwzts(ji,jj,jk) = zwzts(ji,jj,jk) + zwz(ji,jj,jk)*zts(jk)           ! Accumulate time-weighted vertcal flux
-                  END DO
-               END DO
-            END DO
-
-            jtaken = MOD( jtaken + 1 , 2 )
-
-            DO jk = 2, jpkm1          ! Interior value
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     ! total advective trends
-                     ztra = - zbtr * (  zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
-                     ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb) + zts(jk) * ztra
-                  END DO
-               END DO
-            END DO
-
-         END DO
-
-         DO jk = 2, jpkm1          ! Anti-diffusive vertical flux using average flux from the sub-timestepping
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zwz(ji,jj,jk) = zwzts(ji,jj,jk) * zr_p2dt(jk) - zwz_sav(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
-         CALL lbc_lnk( zwz, 'W',  1. )
-
-         ! 4. monotonicity algorithm
-         ! -------------------------
-         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
-
-
-         ! 5. final trend with corrected fluxes
-         ! ------------------------------------
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.  
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! total advective trends
-                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
-                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
-                  ! add them to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-         END DO
-
-         !                                 ! trend diagnostics (contribution of upstream fluxes)
-         IF( l_trd )  THEN 
-            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
-            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
-            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
-            
-            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )   
-            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )  
-            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
-         END IF
-         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)
-           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)
-         ENDIF
-         !
-      END DO
-      !
-                   CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz, zhdiv, zwz_sav, zwzts )
-                   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 )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd_zts')
-      !
-   END SUBROUTINE tra_adv_tvd_zts
-
-   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE nonosc  ***
-      !!     
-      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
-      !!       scheme and the before field by a nonoscillatory algorithm 
-      !!
-      !! **  Method  :   ... ???
-      !!       warning : pbef and paft must be masked, but the boundaries
-      !!       conditions on the fluxes are not necessary zalezak (1979)
-      !!       drange (1995) multi-dimensional forward-in-time and upstream-
-      !!       in-space based differencing for fluid
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   ikm1         ! local integer
-      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars
-      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('nonosc')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
-      !
-      zbig  = 1.e+40_wp
-      zrtrn = 1.e-15_wp
-      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp
-
-      ! Search local extrema
-      ! --------------------
-      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
-      zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ),   &
-         &        paft * tmask - zbig * ( 1._wp - tmask )  )
-      zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ),   &
-         &        paft * tmask + zbig * ( 1._wp - tmask )  )
-
-      DO jk = 1, jpkm1
-         ikm1 = MAX(jk-1,1)
-         z2dtt = p2dt(jk)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-
-               ! search maximum in neighbourhood
-               zup = MAX(  zbup(ji  ,jj  ,jk  ),   &
-                  &        zbup(ji-1,jj  ,jk  ), zbup(ji+1,jj  ,jk  ),   &
-                  &        zbup(ji  ,jj-1,jk  ), zbup(ji  ,jj+1,jk  ),   &
-                  &        zbup(ji  ,jj  ,ikm1), zbup(ji  ,jj  ,jk+1)  )
-
-               ! search minimum in neighbourhood
-               zdo = MIN(  zbdo(ji  ,jj  ,jk  ),   &
-                  &        zbdo(ji-1,jj  ,jk  ), zbdo(ji+1,jj  ,jk  ),   &
-                  &        zbdo(ji  ,jj-1,jk  ), zbdo(ji  ,jj+1,jk  ),   &
-                  &        zbdo(ji  ,jj  ,ikm1), zbdo(ji  ,jj  ,jk+1)  )
-
-               ! positive part of the flux
-               zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   &
-                  & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   &
-                  & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
-
-               ! negative part of the flux
-               zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   &
-                  & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   &
-                  & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
-
-               ! up & down beta terms
-               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
-               zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
-               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( zbetup, 'T', 1. )   ;   CALL lbc_lnk( zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
-
-      ! 3. monotonic flux in the i & j direction (paa & pbb)
-      ! ----------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
-               zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
-               zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) )
-               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu )
-
-               zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
-               zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
-               zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) )
-               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv )
-
-      ! monotonic flux in the k direction, i.e. pcc
-      ! -------------------------------------------
-               za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
-               zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
-               zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) )
-               pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb )
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('nonosc')
-      !
-   END SUBROUTINE nonosc
-
-   !!======================================================================
-END MODULE traadv_tvd
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 6808)
@@ -16,6 +16,6 @@
    USE trc_oce        ! share passive tracers/Ocean variables
    USE trd_oce        ! trends: ocean variables
+   USE traadv_fct      ! acces to routine interp_4th_cpt 
    USE trdtra         ! trends manager: tracers 
-   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient
    USE diaptr         ! poleward transport diagnostics
    !
@@ -35,8 +35,7 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -44,6 +43,6 @@
 CONTAINS
 
-   SUBROUTINE tra_adv_ubs ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
-      &                                       ptb, ptn, pta, kjpt )
+   SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, pun, pvn, pwn,          &
+      &                                                ptb, ptn, pta, kjpt, kn_ubs_v )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_ubs  ***
@@ -52,5 +51,5 @@
       !!      and add it to the general trend of passive tracer equations.
       !!
-      !! ** Method  :   The upstream biased scheme (UBS) is based on a 3rd order
+      !! ** Method  :   The 3rd order Upstream Biased Scheme (UBS) is based on an
       !!      upstream-biased parabolic interpolation (Shchepetkin and McWilliams 2005)
       !!      It is only used in the horizontal direction.
@@ -61,16 +60,21 @@
       !!      where zltu is the second derivative of the before temperature field:
       !!          zltu = 1/e3t di[ e2u e3u / e1u di[Tb] ]
-      !!      This results in a dissipatively dominant (i.e. hyper-diffusive) 
+      !!        This results in a dissipatively dominant (i.e. hyper-diffusive) 
       !!      truncation error. The overall performance of the advection scheme 
       !!      is similar to that reported in (Farrow and Stevens, 1995). 
-      !!      For stability reasons, the first term of the fluxes which corresponds
+      !!        For stability reasons, the first term of the fluxes which corresponds
       !!      to a second order centered scheme is evaluated using the now velocity 
       !!      (centered in time) while the second term which is the diffusive part 
       !!      of the scheme, is evaluated using the before velocity (forward in time). 
       !!      Note that UBS is not positive. Do not use it on passive tracers.
-      !!                On the vertical, the advection is evaluated using a TVD scheme,
-      !!      as the UBS have been found to be too diffusive.
+      !!                On the vertical, the advection is evaluated using a FCT scheme,
+      !!      as the UBS have been found to be too diffusive. 
+      !!                kn_ubs_v argument controles whether the FCT is based on 
+      !!      a 2nd order centrered scheme (kn_ubs_v=2) or on a 4th order compact 
+      !!      scheme (kn_ubs_v=4).
       !!
-      !! ** Action : - update (pta) with the now advective tracer trends
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
       !!
       !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404. 
@@ -81,5 +85,6 @@
       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
-      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      INTEGER                              , INTENT(in   ) ::   kn_ubs_v        ! number of tracers
+      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean transport components
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
@@ -87,5 +92,5 @@
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   ztra, zbtr, zcoef, z2dtt                       ! local scalars
+      REAL(wp) ::   ztra, zbtr, zcoef                       ! local scalars
       REAL(wp) ::   zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk   !   -      -
       REAL(wp) ::   zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn    !   -      -
@@ -95,5 +100,5 @@
       IF( nn_timing == 1 )  CALL timing_start('tra_adv_ubs')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, ztu, ztv, zltu, zltv, zti, ztw )
+      CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw )
       !
       IF( kt == kit000 )  THEN
@@ -106,25 +111,24 @@
       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       !
+      ztw (:,:, 1 ) = 0._wp      ! surface & bottom value : set to zero for all tracers
+      zltu(:,:,jpk) = 0._wp   ;   zltv(:,:,jpk) = 0._wp
+      ztw (:,:,jpk) = 0._wp   ;   zti (:,:,jpk) = 0._wp
+      !
       !                                                          ! ===========
       DO jn = 1, kjpt                                            ! tracer loop
          !                                                       ! ===========
-         ! 1. Bottom value : flux set to zero
-         ! ----------------------------------
-         zltu(:,:,jpk) = 0.e0       ;      zltv(:,:,jpk) = 0.e0
          !                                              
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                   
-            !  Laplacian
-            DO jj = 1, jpjm1            ! First derivative (gradient)
+         DO jk = 1, jpkm1        !==  horizontal laplacian of before tracer ==!
+            DO jj = 1, jpjm1              ! First derivative (masked gradient)
                DO ji = 1, fs_jpim1   ! vector opt.
-                  zeeu = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)
-                  zeev = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)
+                  zeeu = e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk)
+                  zeev = e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk)
                   ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
                   ztv(ji,jj,jk) = zeev * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
                END DO
             END DO
-            DO jj = 2, jpjm1            ! Second derivative (divergence)
+            DO jj = 2, jpjm1              ! Second derivative (divergence)
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zcoef = 1. / ( 6. * fse3t(ji,jj,jk) )
+                  zcoef = 1._wp / ( 6._wp * e3t_n(ji,jj,jk) )
                   zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef
                   zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef
@@ -132,43 +136,39 @@
             END DO
             !                                    
-         END DO                                           ! End of slab         
+         END DO         
          CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn)
-
          !    
-         !  Horizontal advective fluxes               
-         DO jk = 1, jpkm1                                 ! Horizontal slab
+         DO jk = 1, jpkm1        !==  Horizontal advective fluxes  ==!     (UBS)
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  ! upstream transport (x2)
-                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )      ! upstream transport (x2)
                   zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
                   zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
                   zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
-                  ! 2nd order centered advective fluxes (x2)
+                  !                                                  ! 2nd order centered advective fluxes (x2)
                   zcenut = pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
                   zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
-                  ! UBS advective fluxes
+                  !                                                  ! UBS advective fluxes
                   ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) )
                   ztv(ji,jj,jk) = 0.5 * ( zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) )
                END DO
             END DO
-         END DO                                           ! End of slab         
-
-         zltu(:,:,:) = pta(:,:,:,jn)      ! store pta trends
-
-         DO jk = 1, jpkm1                 ! Horizontal advective trends
+         END DO         
+         !
+         zltu(:,:,:) = pta(:,:,:,jn)      ! store the initial trends before its update
+         !
+         DO jk = 1, jpkm1        !==  add the horizontal advective trend  ==!
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                        &
                      &             - (  ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk)    &
-                     &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )
+                     &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                END DO
             END DO
             !                                             
-         END DO                                           !   End of slab
-
-         ! Horizontal trend used in tra_adv_ztvd subroutine
-         zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:)
-
+         END DO
+         !
+         zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:)    ! Horizontal advective trend used in vertical 2nd order FCT case
+         !                                            ! and/or in trend diagnostic (l_trd=T) 
          !                
          IF( l_trd ) THEN                  ! trend diagnostics
@@ -181,76 +181,88 @@
             IF( jn == jp_sal )  str_adv(:) = ptr_sj( ztv(:,:,:) )
          ENDIF
-         
-         ! TVD scheme for the vertical direction  
-         ! ----------------------
-         IF( l_trd )   zltv(:,:,:) = pta(:,:,:,jn)          ! store pta if trend diag.
-
-         !  Bottom value : flux set to zero
-         ztw(:,:,jpk) = 0.e0   ;   zti(:,:,jpk) = 0.e0
-
-         ! Surface value
-         IF( lk_vvl ) THEN   ;   ztw(:,:,1) = 0.e0                      ! variable volume : flux set to zero
-         ELSE                ;   ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)   ! free constant surface 
-         ENDIF
-         !  upstream advection with initial mass fluxes & intermediate update
-         ! -------------------------------------------------------------------
-         ! Interior value
-         DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                   zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
-                   zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
-                   ztw(ji,jj,jk) = 0.5 * (  zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn)  )
-               END DO
-            END DO
-         END DO 
-         ! update and guess with monotonic sheme
-         DO jk = 1, jpkm1
-            z2dtt = p2dt(jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr
-                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak 
-                  zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         !
-         CALL lbc_lnk( zti, 'T', 1. )      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
-
-         !  antidiffusive flux : high order minus low order
-         ztw(:,:,1) = 0.e0       ! Surface value
-         DO jk = 2, jpkm1        ! Interior value
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ztw(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - ztw(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         !
-         CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt )      !  monotonicity algorithm
-
-         !  final trend with corrected fluxes
-         DO jk = 1, jpkm1
+         !
+         !                       !== vertical advective trend  ==!
+         !
+         SELECT CASE( kn_ubs_v )       ! select the vertical advection scheme
+         !
+         CASE(  2  )                   ! 2nd order FCT 
+            !         
+            IF( l_trd )   zltv(:,:,:) = pta(:,:,:,jn)          ! store pta if trend diag.
+            !
+            !                          !*  upstream advection with initial mass fluxes & intermediate update  ==!
+            DO jk = 2, jpkm1                 ! Interior value (w-masked)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                     zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                     ztw(ji,jj,jk) = 0.5_wp * (  zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn)  ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO 
+            IF( ln_linssh ) THEN             ! top ocean value (only in linear free surface as ztw has been w-masked)
+               IF( ln_isfcav ) THEN                ! top of the ice-shelf cavities and at the ocean surface
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        ztw(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                     END DO
+                  END DO   
+               ELSE                                ! no cavities: only at the ocean surface
+                  ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+               ENDIF
+            ENDIF
+            !
+            DO jk = 1, jpkm1           !* trend and after field with monotonic scheme
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                     pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak 
+                     zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( zti, 'T', 1. )      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
+            !
+            !                          !*  anti-diffusive flux : high order minus low order
+            DO jk = 2, jpkm1        ! Interior value  (w-masked)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     ztw(ji,jj,jk) = (   0.5_wp * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )   &
+                        &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !                                            ! top ocean value: high order == upstream  ==>>  zwz=0
+            IF( ln_linssh )   ztw(:,:, 1 ) = 0._wp       ! only ocean surface as interior zwz values have been w-masked
+            !
+            CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt )      !  monotonicity algorithm
+            !
+         CASE(  4  )                               ! 4th order COMPACT
+            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )         ! 4th order compact interpolation of T at w-point
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     ztw(ji,jj,jk) = pwn(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            IF( ln_linssh )   ztw(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)     !!gm ISF & 4th COMPACT doesn't work
+            !
+         END SELECT
+         !
+         DO jk = 1, jpkm1        !  final trend with corrected fluxes
             DO jj = 2, jpjm1 
                DO ji = fs_2, fs_jpim1   ! vector opt.   
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ! k- vertical advective trends  
-                  ztra = - zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )
-                  ! added to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-         END DO
-
-         !  Save the final vertical advective trends
-         IF( l_trd )  THEN                        ! vertical advective trend diagnostics
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         IF( l_trd )  THEN       ! vertical advective trend diagnostics
             DO jk = 1, jpkm1                       ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w])
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     z_hdivn = (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  ) * zbtr
-                     zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk) + ptn(ji,jj,jk,jn) * z_hdivn
+                     zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk)                          &
+                        &           + ptn(ji,jj,jk,jn) * (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  )   &
+                        &                              * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                   END DO
                END DO
@@ -261,5 +273,5 @@
       END DO
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, ztu, ztv, zltu, zltv, zti, ztw )
+      CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw )
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_ubs')
@@ -281,5 +293,5 @@
       !!       in-space based differencing for fluid
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   ), DIMENSION(jpk)          ::   p2dt   ! vertical profile of tracer time-step
+      REAL(wp), INTENT(in   )                          ::   p2dt   ! tracer time-step
       REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field
       REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field
@@ -288,5 +300,5 @@
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       INTEGER  ::   ikm1         ! local integer
-      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn   ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo
       !!----------------------------------------------------------------------
@@ -294,17 +306,17 @@
       IF( nn_timing == 1 )  CALL timing_start('nonosc_z')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo )
+      CALL wrk_alloc( jpi,jpj,jpk,   zbetup, zbetdo )
       !
       zbig  = 1.e+40_wp
       zrtrn = 1.e-15_wp
       zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp
-
+      !
       ! Search local extrema
       ! --------------------
-      ! large negative value (-zbig) inside land
+      !                    ! large negative value (-zbig) inside land
       pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
       paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
-      ! search maximum in neighbourhood
-      DO jk = 1, jpkm1
+      !
+      DO jk = 1, jpkm1     ! search maximum in neighbourhood
          ikm1 = MAX(jk-1,1)
          DO jj = 2, jpjm1
@@ -316,9 +328,9 @@
          END DO
       END DO
-      ! large positive value (+zbig) inside land
+      !                    ! large positive value (+zbig) inside land
       pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
       paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
-      ! search minimum in neighbourhood
-      DO jk = 1, jpkm1
+      !
+      DO jk = 1, jpkm1     ! search minimum in neighbourhood
          ikm1 = MAX(jk-1,1)
          DO jj = 2, jpjm1
@@ -330,15 +342,11 @@
          END DO
       END DO
-
-      ! restore masked values to zero
+      !                    ! restore masked values to zero
       pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:)
       paft(:,:,:) = paft(:,:,:) * tmask(:,:,:)
-
-
-      ! 2. Positive and negative part of fluxes and beta terms
-      ! ------------------------------------------------------
-
+      !
+      ! Positive and negative part of fluxes and beta terms
+      ! ---------------------------------------------------
       DO jk = 1, jpkm1
-         z2dtt = p2dt(jk)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -347,5 +355,5 @@
                zneg = MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
                ! up & down beta terms
-               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
+               zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt
                zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt
                zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt
@@ -353,4 +361,5 @@
          END DO
       END DO
+      !
       ! monotonic flux in the k direction, i.e. pcc
       ! -------------------------------------------
@@ -366,5 +375,5 @@
       END DO
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zbetup, zbetdo )
       !
       IF( nn_timing == 1 )  CALL timing_stop('nonosc_z')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 6808)
@@ -12,20 +12,21 @@
 
    !!----------------------------------------------------------------------
-   !!   tra_bbc      : update the tracer trend at ocean bottom 
-   !!   tra_bbc_init : initialization of geothermal heat flux trend
+   !!   tra_bbc       : update the tracer trend at ocean bottom 
+   !!   tra_bbc_init  : initialization of geothermal heat flux trend
    !!----------------------------------------------------------------------
-   USE oce             ! ocean variables
-   USE dom_oce         ! domain: ocean
-   USE phycst          ! physical constants
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O manager
-   USE fldread         ! read input fields
-   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp           ! distributed memory computing library
-   USE prtctl          ! Print control
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   USE oce            ! ocean variables
+   USE dom_oce        ! domain: ocean
+   USE phycst         ! physical constants
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends manager: tracers 
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! xIOS 
+   USE fldread        ! read input fields
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! distributed memory computing library
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -40,9 +41,8 @@
    REAL(wp)        ::   rn_geoflx_cst !  Constant value of geothermal heat flux
 
-   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh              ! structure of input qgh (file informations, fields read)
+   REAL(wp), PUBLIC , ALLOCATABLE, DIMENSION(:,:) ::   qgh_trd0   ! geothermal heating trend
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh   ! structure of input qgh (file informations, fields read)
  
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -68,6 +68,6 @@
       !!       Where Qsf is the geothermal heat flux.
       !!
-      !! ** Action  : - update the temperature trends (ta) with the trend of
-      !!                the ocean bottom boundary condition
+      !! ** Action  : - update the temperature trends with geothermal heating trend
+      !!              - send the trend for further diagnostics (ln_trdtra=T)
       !!
       !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
@@ -75,7 +75,6 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, ik    ! dummy loop indices
-      REAL(wp) ::   zqgh_trd      ! geothermal heat flux trend
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt
       !!----------------------------------------------------------------------
@@ -83,15 +82,12 @@
       IF( nn_timing == 1 )  CALL timing_start('tra_bbc')
       !
-      IF( l_trdtra )   THEN         ! Save ta and sa trends
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdt )
+      IF( l_trdtra )   THEN         ! Save the input temperature trend
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt )
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
       ENDIF
-      !
-      !                             !  Add the geothermal heat flux trend on temperature
+      !                             !  Add the geothermal trend on temperature
       DO jj = 2, jpjm1
          DO ji = 2, jpim1
-            ik = mbkt(ji,jj)
-            zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik)
-            tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd
+            tsa(ji,jj,mbkt(ji,jj),jp_tem) = tsa(ji,jj,mbkt(ji,jj),jp_tem) + qgh_trd0(ji,jj) / e3t_n(ji,jj,mbkt(ji,jj))
          END DO
       END DO
@@ -99,8 +95,8 @@
       CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. )
       !
-      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics
+      IF( l_trdtra ) THEN        ! Send the trend for diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
          CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt )
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt )
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt )
       ENDIF
       !
@@ -127,6 +123,4 @@
       !! ** Action  : - read/fix the geothermal heat qgh_trd0
       !!----------------------------------------------------------------------
-      USE iom
-      !!
       INTEGER  ::   ji, jj              ! dummy loop indices
       INTEGER  ::   inum                ! temporary logical unit
@@ -139,14 +133,14 @@
       NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
       !!----------------------------------------------------------------------
-
+      !
       REWIND( numnam_ref )              ! Namelist nambbc in reference namelist : Bottom momentum boundary condition
       READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp )
-
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp )
+      !
       REWIND( numnam_cfg )              ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition
       READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, nambbc )
-
+      !
       IF(lwp) THEN                     ! Control print
          WRITE(numout,*)
@@ -159,5 +153,5 @@
          WRITE(numout,*)
       ENDIF
-
+      !
       IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
          !
@@ -190,5 +184,4 @@
             WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
             CALL ctl_stop( ctmp1 )
-            !
          END SELECT
          !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 6808)
@@ -14,5 +14,5 @@
    !!             -   ! 2013-04  (F. Roquet, G. Madec)  use of eosbn2 instead of local hard coded alpha and beta
    !!----------------------------------------------------------------------
-#if   defined key_trabbl   ||   defined key_esopa
+#if   defined key_trabbl
    !!----------------------------------------------------------------------
    !!   'key_trabbl'   or                             bottom boundary layer
@@ -29,5 +29,5 @@
    USE phycst         ! physical constant
    USE eosbn2         ! equation of state
-   USE trd_oce     ! trends: ocean variables
+   USE trd_oce        ! trends: ocean variables
    USE trdtra         ! trends: active tracers
    !
@@ -70,5 +70,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -112,5 +111,5 @@
       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl')
       !
-      IF( l_trdtra )   THEN                         !* Save ta and sa trends
+      IF( l_trdtra )   THEN                         !* Save the input trends
          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
@@ -132,5 +131,5 @@
          !
       END IF
-
+      !
       IF( nn_bbl_adv /= 0 ) THEN                    !* Advective bbl
          !
@@ -146,5 +145,5 @@
       END IF
 
-      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+      IF( l_trdtra )   THEN                      ! send the trends for further diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
@@ -198,6 +197,6 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               ik = mbkt(ji,jj)                              ! bottom T-level index
-               zptb(ji,jj) = ptb(ji,jj,ik,jn)       ! bottom before T and S
+               ik = mbkt(ji,jj)                             ! bottom T-level index
+               zptb(ji,jj) = ptb(ji,jj,ik,jn)               ! bottom before T and S
             END DO
          END DO
@@ -205,11 +204,11 @@
          DO jj = 2, jpjm1                                    ! Compute the trend
             DO ji = 2, jpim1
-               ik = mbkt(ji,jj)                              ! bottom T-level index
-               zbtr = r1_e12t(ji,jj)  / fse3t(ji,jj,ik)
-               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         &
-                  &               + (   ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   &
-                  &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   &
-                  &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   &
-                  &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr
+               ik = mbkt(ji,jj)                            ! bottom T-level index
+               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                  &
+                  &             + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     &
+                  &                - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     &
+                  &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     &
+                  &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  &
+                  &             * r1_e1e2t(ji,jj) / e3t_n(ji,jj,ik)
             END DO
          END DO
@@ -263,15 +262,15 @@
                   !
                   !                                               ! up  -slope T-point (shelf bottom point)
-                  zbtr = r1_e12t(iis,jj) / fse3t(iis,jj,ikus)
+                  zbtr = r1_e1e2t(iis,jj) / e3t_n(iis,jj,ikus)
                   ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr
                   pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra
                   !
                   DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column)
-                     zbtr = r1_e12t(iid,jj) / fse3t(iid,jj,jk)
+                     zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,jk)
                      ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr
                      pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra
                   END DO
                   !
-                  zbtr = r1_e12t(iid,jj) / fse3t(iid,jj,ikud)
+                  zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,ikud)
                   ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr
                   pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra
@@ -285,15 +284,15 @@
                   !
                   ! up  -slope T-point (shelf bottom point)
-                  zbtr = r1_e12t(ji,ijs) / fse3t(ji,ijs,ikvs)
+                  zbtr = r1_e1e2t(ji,ijs) / e3t_n(ji,ijs,ikvs)
                   ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr
                   pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra
                   !
                   DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column)
-                     zbtr = r1_e12t(ji,ijd) / fse3t(ji,ijd,jk)
+                     zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,jk)
                      ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr
                      pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra
                   END DO
                   !                                               ! down-slope T-point (deep bottom point)
-                  zbtr = r1_e12t(ji,ijd) / fse3t(ji,ijd,ikvd)
+                  zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,ikvd)
                   ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr
                   pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra
@@ -302,8 +301,7 @@
             !
          END DO
-         !                                                  ! ===========
-      END DO                                                ! end tracer
-      !                                                     ! ===========
-      !
+         !                                                       ! ===========
+      END DO                                                     ! end tracer
+      !                                                          ! ===========
       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_adv')
       !
@@ -340,5 +338,5 @@
       INTEGER         , INTENT(in   ) ::   kit000   ! first time step index
       CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
-      !!
+      !
       INTEGER  ::   ji, jj                    ! dummy loop indices
       INTEGER  ::   ik                        ! local integers
@@ -365,5 +363,5 @@
             zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal)
             !
-            zdep(ji,jj) = fsdept(ji,jj,ik)               ! bottom T-level reference depth
+            zdep(ji,jj) = gdept_n(ji,jj,ik)              ! bottom T-level reference depth
             zub (ji,jj) = un(ji,jj,mbku(ji,jj))          ! bottom velocity
             zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj))
@@ -401,5 +399,5 @@
          !
       ENDIF
-
+      !
       !                                   !-------------------!
       IF( nn_bbl_adv /= 0 ) THEN          !   advective bbl   !
@@ -500,5 +498,5 @@
       INTEGER ::   ios                  !   -      -
       REAL(wp), POINTER, DIMENSION(:,:) :: zmbk
-      !!
+      !
       NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
       !!----------------------------------------------------------------------
@@ -506,14 +504,11 @@
       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_init')
       !
-      CALL wrk_alloc( jpi, jpj, zmbk )
-      !
-
       REWIND( numnam_ref )              ! Namelist nambbl in reference namelist : Bottom boundary layer scheme
       READ  ( numnam_ref, nambbl, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in reference namelist', lwp )
-
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in reference namelist', lwp )
+      !
       REWIND( numnam_cfg )              ! Namelist nambbl in configuration namelist : Bottom boundary layer scheme
       READ  ( numnam_cfg, nambbl, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, nambbl )
       !
@@ -545,6 +540,8 @@
       END DO
       ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
+      CALL wrk_alloc( jpi, jpj, zmbk )
       zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
       zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      CALL wrk_dealloc( jpi, jpj, zmbk )
 
                                         !* sign of grad(H) at u- and v-points
@@ -566,6 +563,6 @@
 
       !                             !* masked diffusive flux coefficients
-      ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)  * umask(:,:,1)
-      ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)  * vmask(:,:,1)
+      ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1)
+      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1)
 
 
@@ -593,6 +590,4 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, zmbk )
-      !
       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_init')
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 6808)
@@ -6,8 +6,6 @@
    !! History :  OPA  ! 1991-03  (O. Marti, G. Madec)  Original code
    !!                 ! 1992-06  (M. Imbard)  doctor norme
-   !!                 ! 1996-01  (G. Madec)  statement function for e3
-   !!                 ! 1997-05  (G. Madec)  macro-tasked on jk-slab
    !!                 ! 1998-07  (M. Imbard, G. Madec) ORCA version
-   !!            7.0  ! 2001-02  (M. Imbard)  cofdis, Original code
+   !!            7.0  ! 2001-02  (M. Imbard)  add distance to coast, Original code
    !!            8.1  ! 2001-02  (G. Madec, E. Durand)  cleaning
    !!  NEMO      1.0  ! 2002-08  (G. Madec, E. Durand)  free form + modules
@@ -15,4 +13,6 @@
    !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC 
    !!            3.4  ! 2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys
+   !!            3.6  ! 2015-06  (T. Graham)  read restoring coefficient in a file
+   !!            3.7  ! 2015-10  (G. Madec)  remove useless trends arrays
    !!----------------------------------------------------------------------
 
@@ -31,4 +31,5 @@
    USE dtatsd         ! data: temperature & salinity
    USE zdfmxl         ! vertical physics: mixed layer depth
+   !
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
@@ -41,21 +42,15 @@
    PRIVATE
 
-   PUBLIC   tra_dmp      ! routine called by step.F90
-   PUBLIC   tra_dmp_init ! routine called by opa.F90
-
-   !                               !!* Namelist namtra_dmp : T & S newtonian damping *
-   ! nn_zdmp and cn_resto are public as they are used by C1D/dyndmp.F90
-   LOGICAL , PUBLIC ::   ln_tradmp   !: internal damping flag
-   INTEGER , PUBLIC ::   nn_zdmp     ! = 0/1/2 flag for damping in the mixed layer
-   CHARACTER(LEN=200) , PUBLIC :: cn_resto      ! name of netcdf file containing restoration coefficient field
+   PUBLIC   tra_dmp        ! called by step.F90
+   PUBLIC   tra_dmp_init   ! called by nemogcm.F90
+
+   !                                           !!* Namelist namtra_dmp : T & S newtonian damping *
+   LOGICAL            , PUBLIC ::   ln_tradmp   !: internal damping flag
+   INTEGER            , PUBLIC ::   nn_zdmp     !: = 0/1/2 flag for damping in the mixed layer
+   CHARACTER(LEN=200) , PUBLIC ::   cn_resto    !: name of netcdf file containing restoration coefficient field
    !
-
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   strdmp   !: damping salinity trend (psu/s)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ttrdmp   !: damping temperature trend (Celcius/s)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1)
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -70,5 +65,5 @@
       !!                ***  FUNCTION tra_dmp_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk), resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
+      ALLOCATE( resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
       !
       IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc )
@@ -94,71 +89,59 @@
       !!      below the well mixed layer (nlmdmp=2)
       !!
-      !! ** Action  : - (ta,sa)   tracer trends updated with the damping trend
-      !!----------------------------------------------------------------------
-      !
+      !! ** Action  : - tsa: tracer trends updated with the damping trend
+      !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zta, zsa             ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta 
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'tra_dmp')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, jpts,  zts_dta )
-      !
-      !                           !==   input T-S data at kt   ==!
+      !
+      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta, ztrdts
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('tra_dmp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,jpts,   zts_dta )
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         CALL wrk_alloc( jpi,jpj,jpk,jpts,   ztrdts ) 
+         ztrdts(:,:,:,:) = tsa(:,:,:,:) 
+      ENDIF
+      !                           !==  input T-S data at kt  ==!
       CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt
       !
-      SELECT CASE ( nn_zdmp )     !==    type of damping   ==!
-      !
-      CASE( 0 )                   !==  newtonian damping throughout the water column  ==!
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
-                  zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
-                  strdmp(ji,jj,jk) = zsa           ! save the trend (used in asmtrj)
-                  ttrdmp(ji,jj,jk) = zta      
+      SELECT CASE ( nn_zdmp )     !==  type of damping  ==!
+      !
+      CASE( 0 )                        !*  newtonian damping throughout the water column  *!
+         DO jn = 1, jpts
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - tsb(ji,jj,jk,jn) )
+                  END DO
                END DO
             END DO
          END DO
          !
-      CASE ( 1 )                  !==  no damping in the turbocline (avt > 5 cm2/s)  ==!
+      CASE ( 1 )                       !*  no damping in the turbocline (avt > 5 cm2/s)  *!
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
-                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
-                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
-                  ELSE
-                     zta = 0._wp
-                     zsa = 0._wp  
+                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
+                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
+                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
+                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
                   ENDIF
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
-                  strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj)
-                  ttrdmp(ji,jj,jk) = zta
                END DO
             END DO
          END DO
          !
-      CASE ( 2 )                  !==  no damping in the mixed layer   ==!
+      CASE ( 2 )                       !*  no damping in the mixed layer   *!
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
-                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
-                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
-                  ELSE
-                     zta = 0._wp
-                     zsa = 0._wp  
+                  IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
+                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
+                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
+                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
+                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
                   ENDIF
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
-                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
-                  strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj)
-                  ttrdmp(ji,jj,jk) = zta
                END DO
             END DO
@@ -168,6 +151,8 @@
       !
       IF( l_trdtra )   THEN       ! trend diagnostic
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ttrdmp )
-         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, strdmp )
+         ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) )
+         CALL wrk_dealloc( jpi,jpj,jpk,jpts,   ztrdts ) 
       ENDIF
       !                           ! Control print
@@ -175,7 +160,7 @@
          &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, jpts,  zts_dta )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop( 'tra_dmp')
+      CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zts_dta )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('tra_dmp')
       !
    END SUBROUTINE tra_dmp
@@ -190,8 +175,7 @@
       !! ** Method  :   read the namtra_dmp namelist and check the parameters
       !!----------------------------------------------------------------------
+      INTEGER ::   ios, imask   ! local integers 
+      !
       NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
-      INTEGER ::  ios         ! Local integer for output status of namelist read
-      INTEGER :: imask        ! File handle 
-      !!
       !!----------------------------------------------------------------------
       !
@@ -204,9 +188,9 @@
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namtra_dmp )
-
-      IF(lwp) THEN                 !Namelist print
+      !
+      IF(lwp) THEN                  ! Namelist print
          WRITE(numout,*)
          WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
-         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters'
          WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp
@@ -215,35 +199,33 @@
          WRITE(numout,*)
       ENDIF
-
+      !
       IF( ln_tradmp) THEN
-         !
-         !Allocate arrays
+         !                          ! Allocate arrays
          IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
-
-         !Check values of nn_zdmp
-         SELECT CASE (nn_zdmp)
-         CASE ( 0 )  ; IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
-         CASE ( 1 )  ; IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline'
-         CASE ( 2 )  ; IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
+         !
+         SELECT CASE (nn_zdmp)      ! Check values of nn_zdmp
+         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
+         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixing layer (kz > 5 cm2/s)'
+         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed  layer'
+         CASE DEFAULT
+            CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp')
          END SELECT
-
-         !TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
-         !so can damp to something other than intitial conditions files?
+         !
+         !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
+         !    so can damp to something other than intitial conditions files?
+         !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated.
          IF( .NOT.ln_tsd_tradmp ) THEN
-            CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' )
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout, *)  '   read T-S data not initialized, we force ln_tsd_tradmp=T'
             CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
          ENDIF
-
-         !initialise arrays - Are these actually used anywhere else?
-         strdmp(:,:,:) = 0._wp
-         ttrdmp(:,:,:) = 0._wp
-
-         !Read in mask from file
+         !                          ! Read in mask from file
          CALL iom_open ( cn_resto, imask)
-         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto)
+         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto )
          CALL iom_close( imask )
-       ENDIF
-
+      ENDIF
+      !
    END SUBROUTINE tra_dmp_init
 
+   !!======================================================================
 END MODULE tradmp
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 6808)
@@ -4,32 +4,32 @@
    !! Ocean Active tracers : lateral diffusive trends 
    !!=====================================================================
-   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
-   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_ldf      : update the tracer trend with the lateral diffusion
-   !!   tra_ldf_init : initialization, namelist read, and parameters control
-   !!       ldf_ano  : compute lateral diffusion for constant T-S profiles
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE ldftra_oce      ! ocean tracer   lateral physics
-   USE ldfslp          ! ???
-   USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine)
-   USE traldf_bilap    ! lateral mixing             (tra_ldf_bilap routine)
-   USE traldf_iso      ! lateral mixing               (tra_ldf_iso routine)
-   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
-   USE traldf_lap      ! lateral mixing               (tra_ldf_lap routine)
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
+   !! History :  9.0  ! 2005-11  (G. Madec)  Original code
+   !!  NEMO      3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!            3.7  ! 2013-12  (G. Madec) remove the optional computation from T & S anomaly profiles and traldf_bilapg
+   !!             -   ! 2013-12  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction
+   !!             -   ! 2014-01  (G. Madec, S. Masson)  restructuration/simplification of lateral diffusive operators
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf       : update the tracer trend with the lateral diffusion trend
+   !!   tra_ldf_init  : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
+   USE ldfslp         ! lateral diffusion: iso-neutral slope
+   USE traldf_lap_blp ! lateral diffusion: laplacian iso-level            operator  (tra_ldf_lap/_blp   routines)
+   USE traldf_iso     ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso        routine )
+   USE traldf_triad   ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_triad      routine )
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! ocean active tracers trends
    !
-   USE prtctl          ! Print control
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distribued memory computing library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -37,16 +37,12 @@
 
    PUBLIC   tra_ldf        ! called by step.F90 
-   PUBLIC   tra_ldf_init   ! called by opa.F90 
+   PUBLIC   tra_ldf_init   ! called by nemogcm.F90 
    !
-   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals)
-
-   REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   t0_ldf, s0_ldf   !: lateral diffusion trends of T & S for a cst profile
-   !                                                               !  (key_traldf_ano only)
-
+   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... (namlist logicals)
+   
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -65,67 +61,35 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('tra_ldf')
-      !
-      rldf = 1     ! For active tracers the 
-
+      IF( nn_timing == 1 )   CALL timing_start('tra_ldf')
+      !
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt, ztrds ) 
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
          ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
-
-      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
-      CASE ( 0 )   ;   CALL tra_ldf_lap     ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        &
-                               &                                   tsb, tsa, jpts        )  ! iso-level laplacian
-      CASE ( 1 )                                                                              ! rotated laplacian
-         IF( ln_traldf_grif ) THEN                                                          
-                       CALL tra_ldf_iso_grif( kt, nit000,'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Griffies operator
-         ELSE                                                                                
-                       CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        &
-                               &                                  tsb, tsa, jpts, ahtb0 )      ! Madec operator
-         ENDIF
-      CASE ( 2 )   ;   CALL tra_ldf_bilap   ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        &
-                               &                                   tsb, tsa, jpts        )  ! iso-level bilaplacian
-      CASE ( 3 )   ;   CALL tra_ldf_bilapg  ( kt, nit000, 'TRA',             tsb, tsa, jpts        )  ! s-coord. geopot. bilap.
-         !
-      CASE ( -1 )                                ! esopa: test all possibility with control print
-         CALL tra_ldf_lap   ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        &
-         &                                       tsb, tsa, jpts        ) 
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask,               &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         IF( ln_traldf_grif ) THEN
-            CALL tra_ldf_iso_grif( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )
-         ELSE
-            CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        &
-            &                                               tsb, tsa, jpts, ahtb0 )  
-         ENDIF
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask,               &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_ldf_bilap ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi,        &
-         &                                       tsb, tsa, jpts        ) 
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask,               &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_ldf_bilapg( kt, nit000, 'TRA',             tsb, tsa, jpts        ) 
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask,               &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      !
+      SELECT CASE ( nldf )                     !* compute lateral mixing trend and add it to the general trend
+      CASE ( np_lap   )                                  ! laplacian: iso-level operator
+         CALL tra_ldf_lap  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb,      tsa, jpts,  1   )
+      CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec)
+         CALL tra_ldf_iso  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   )
+      CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies)
+         CALL tra_ldf_triad( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   )
+      CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators
+         CALL tra_ldf_blp  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb      , tsa, jpts, nldf )
       END SELECT
-
-#if defined key_traldf_ano
-      tsa(:,:,:,jp_tem) = tsa(:,:,:,jp_tem) - t0_ldf(:,:,:)      ! anomaly: substract the reference diffusivity
-      tsa(:,:,:,jp_sal) = tsa(:,:,:,jp_sal) - s0_ldf(:,:,:)
-#endif
-
-      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+      !
+      IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
          CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt )
          CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds )
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
-      ENDIF
-      !                                          ! print mean trends (used for debugging)
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt, ztrds ) 
+      ENDIF
+      !                                        !* print mean trends (used for debugging)
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf  - Ta: ', mask1=tmask,               &
          &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf')
+      IF( nn_timing == 1 )   CALL timing_stop('tra_ldf')
       !
    END SUBROUTINE tra_ldf
@@ -139,224 +103,97 @@
       !!
       !! ** Method  :   set nldf from the namtra_ldf logicals
-      !!      nldf == -1   ESOPA test: ALL operators are used
-      !!      nldf ==  0   laplacian operator
-      !!      nldf ==  1   Rotated laplacian operator
-      !!      nldf ==  2   bilaplacian operator
-      !!      nldf ==  3   Rotated bilaplacian
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio, ierr         ! temporary integers 
-      !!----------------------------------------------------------------------
-
-      !  Define the lateral mixing oparator for tracers
-      ! ===============================================
-    
-      IF(lwp) THEN                    ! Namelist print
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ierr   ! temporary integers 
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                     ! Namelist print
          WRITE(numout,*)
          WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator'
          WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namtra_ldf already read in ldftra module'
-         WRITE(numout,*) '   see ldf_tra_init report for lateral mixing parameters'
+         WRITE(numout,*) '   Namelist namtra_ldf: already read in ldftra module'
+         WRITE(numout,*) '      see ldf_tra_init report for lateral mixing parameters'
          WRITE(numout,*)
       ENDIF
-
-      !                               ! control the input
+      !                                   ! use of lateral operator or not
+      nldf   = np_ERROR
       ioptio = 0
-      IF( ln_traldf_lap   )   ioptio = ioptio + 1
-      IF( ln_traldf_bilap )   ioptio = ioptio + 1
-      IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' )
-      IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion
-      ioptio = 0
-      IF( ln_traldf_level )   ioptio = ioptio + 1
-      IF( ln_traldf_hor   )   ioptio = ioptio + 1
-      IF( ln_traldf_iso   )   ioptio = ioptio + 1
-      IF( ioptio >  1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
-
-      ! defined the type of lateral diffusion from ln_traldf_... logicals
-      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully
-      ierr = 0
-      IF( ln_traldf_lap ) THEN       ! laplacian operator
-         IF ( ln_zco ) THEN                ! z-coordinate
-            IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation)
-            IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation)
-            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+      IF( ln_traldf_lap )   ioptio = ioptio + 1
+      IF( ln_traldf_blp )   ioptio = ioptio + 1
+      IF( ioptio >  1   )   CALL ctl_stop( 'tra_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on tracer' )
+      IF( ioptio == 0   )   nldf = np_no_ldf     ! No lateral diffusion
+      !
+      IF( nldf /= np_no_ldf ) THEN        ! direction ==>> type of operator  
+         ioptio = 0
+         IF( ln_traldf_lev )   ioptio = ioptio + 1
+         IF( ln_traldf_hor )   ioptio = ioptio + 1
+         IF( ln_traldf_iso )   ioptio = ioptio + 1
+         IF( ioptio >  1 )   CALL ctl_stop( 'tra_ldf_init: use only ONE direction (level/hor/iso)' )
+         !
+         !                                ! defined the type of lateral diffusion from ln_traldf_... logicals
+         ierr = 0
+         IF( ln_traldf_lap ) THEN         ! laplacian operator
+            IF ( ln_zco ) THEN               ! z-coordinate
+               IF ( ln_traldf_lev   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_traldf_hor   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_traldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
+            IF ( ln_zps ) THEN               ! z-coordinate with partial step
+               IF ( ln_traldf_lev   )   ierr = 1          ! iso-level not allowed 
+               IF ( ln_traldf_hor   )   nldf = np_lap     ! horizontal             (no rotation)
+               IF ( ln_traldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard     (rotation)
+               IF ( ln_traldf_triad )   nldf = np_lap_it  ! iso-neutral: triad        (rotation)
+            ENDIF
+            IF ( ln_sco ) THEN               ! s-coordinate
+               IF ( ln_traldf_lev   )   nldf = np_lap     ! iso-level              (no rotation)
+               IF ( ln_traldf_hor   )   nldf = np_lap_i   ! horizontal             (   rotation)
+               IF ( ln_traldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
          ENDIF
-         IF ( ln_zps ) THEN             ! zps-coordinate
-            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed
-            IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation)
-            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         !
+         IF( ln_traldf_blp ) THEN         ! bilaplacian operator
+            IF ( ln_zco ) THEN               ! z-coordinate
+               IF ( ln_traldf_lev   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+               IF ( ln_traldf_hor   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+               IF ( ln_traldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_blp_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
+            IF ( ln_zps ) THEN               ! z-coordinate with partial step
+               IF ( ln_traldf_lev   )   ierr = 1          ! iso-level not allowed 
+               IF ( ln_traldf_hor   )   nldf = np_blp     ! horizontal             (no rotation)
+               IF ( ln_traldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_blp_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
+            IF ( ln_sco ) THEN               ! s-coordinate
+               IF ( ln_traldf_lev   )   nldf = np_blp     ! iso-level              (no rotation)
+               IF ( ln_traldf_hor   )   nldf = np_blp_it  ! horizontal             (   rotation)
+               IF ( ln_traldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_blp_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
          ENDIF
-         IF ( ln_sco ) THEN             ! s-coordinate
-            IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation)
-            IF ( ln_traldf_hor   )   nldf = 1      ! horizontal (   rotation)
-            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
-         ENDIF
-      ENDIF
-
-      IF( ln_traldf_bilap ) THEN      ! bilaplacian operator
-         IF ( ln_zco ) THEN                ! z-coordinate
-            IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation)
-            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation)
-            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_zps ) THEN             ! zps-coordinate
-            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed 
-            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation)
-            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_sco ) THEN             ! s-coordinate
-            IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation)
-            IF ( ln_traldf_hor   )   nldf = 3      ! horizontal (   rotation)
-            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-      ENDIF
-
-      IF( nldf == 3 )   CALL ctl_warn( 'geopotential bilaplacian tracer diffusion in s-coords not thoroughly tested' )
-      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' )
-      IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' )
-      IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso )   &
-           CALL ctl_stop( '          eddy induced velocity on tracers',   &
-           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' )
-      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
-         IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' )
-         l_traldf_rot = .TRUE.                 ! needed for trazdf_imp
-      ENDIF
-
-      IF( lk_esopa ) THEN
-         IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options'
-         nldf = -1
-      ENDIF
-
+      ENDIF
+      !
+      IF( ierr == 1 )   CALL ctl_stop( 'iso-level in z-partial step, not allowed' )
+      IF( ln_ldfeiv .AND. .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) )                                    &
+           &            CALL ctl_stop( 'eddy induced velocity on tracers requires iso-neutral laplacian diffusion' )
+           !
+      IF(  nldf == np_lap_i .OR. nldf == np_lap_it .OR. &
+         & nldf == np_blp_i .OR. nldf == np_blp_it  )   l_ldfslp = .TRUE.    ! slope of neutral surfaces required 
+      !
       IF(lwp) THEN
          WRITE(numout,*)
-         IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion'
-         IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used'
-         IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator'
-         IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator'
-         IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator'
-         IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian'
-      ENDIF
-
-      ! Reference T & S diffusivity (if necessary)
-      ! ===========================
-      CALL ldf_ano
+         SELECT CASE( nldf )
+         CASE( np_no_ldf )   ;   WRITE(numout,*) '   NO lateral diffusion'
+         CASE( np_lap    )   ;   WRITE(numout,*) '   laplacian iso-level operator'
+         CASE( np_lap_i  )   ;   WRITE(numout,*) '   Rotated laplacian operator (standard)'
+         CASE( np_lap_it )   ;   WRITE(numout,*) '   Rotated laplacian operator (triad)'
+         CASE( np_blp    )   ;   WRITE(numout,*) '   bilaplacian iso-level operator'
+         CASE( np_blp_i  )   ;   WRITE(numout,*) '   Rotated bilaplacian operator (standard)'
+         CASE( np_blp_it )   ;   WRITE(numout,*) '   Rotated bilaplacian operator (triad)'
+         END SELECT
+      ENDIF
       !
    END SUBROUTINE tra_ldf_init
-
-#if defined key_traldf_ano
-   !!----------------------------------------------------------------------
-   !!   'key_traldf_ano'               T & S lateral diffusion on anomalies
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE ldf_ano
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_ano  ***
-      !!
-      !! ** Purpose :   initializations of 
-      !!----------------------------------------------------------------------
-      !
-      USE zdf_oce         ! vertical mixing
-      USE trazdf          ! vertical mixing: double diffusion
-      USE zdfddm          ! vertical mixing: double diffusion
-      !
-      INTEGER  ::   jk              ! Dummy loop indice
-      INTEGER  ::   ierr            ! local integer
-      LOGICAL  ::   llsave          ! local logical
-      REAL(wp) ::   zt0, zs0, z12   ! local scalar
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_ref, zs_ref, ztb, zsb, zavt     
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ldf_ano')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt ) 
-      !
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on anomalies'
-         WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-
-      !                              ! allocate trabbl arrays
-      ALLOCATE( t0_ldf(jpi,jpj,jpk) , s0_ldf(jpi,jpj,jpk) , STAT=ierr )
-      IF( lk_mpp    )   CALL mpp_sum( ierr )
-      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_ano: unable to allocate arrays' )
-
-      ! defined the T & S reference profiles
-      ! ------------------------------------
-      zt0 =10.e0                               ! homogeneous ocean
-      zs0 =35.e0
-      zt_ref(:,:,:) = 10.0 * tmask(:,:,:)
-      zs_ref(:,:,:) = 35.0 * tmask(:,:,:)
-      IF(lwp) WRITE(numout,*) '              homogeneous ocean T = ', zt0, ' S = ',zs0
-
-      ! Initialisation of gtui/gtvi in case of no cavity
-      IF ( .NOT. ln_isfcav ) THEN
-         gtui(:,:,:) = 0.0_wp
-         gtvi(:,:,:) = 0.0_wp
-      END IF
-      !                                        ! T & S profile (to be coded +namelist parameter
-
-      ! prepare the ldf computation
-      ! ---------------------------
-      llsave = l_trdtra
-      l_trdtra = .false.      ! desactivate trend computation
-      t0_ldf(:,:,:) = 0.e0
-      s0_ldf(:,:,:) = 0.e0
-      ztb   (:,:,:) = tsb (:,:,:,jp_tem)
-      zsb   (:,:,:) = tsb (:,:,:,jp_sal)
-      ua    (:,:,:) = tsa (:,:,:,jp_tem)
-      va    (:,:,:) = tsa (:,:,:,jp_sal)
-      zavt  (:,:,:) = avt(:,:,:)
-      IF( lk_zdfddm ) THEN CALL ctl_stop( ' key_traldf_ano with key_zdfddm not implemented' )
-      ! set tb, sb to reference values and avr to zero
-      tsb (:,:,:,jp_tem) = zt_ref(:,:,:)
-      tsb (:,:,:,jp_sal) = zs_ref(:,:,:)
-      tsa (:,:,:,jp_tem) = 0.e0
-      tsa (:,:,:,jp_sal) = 0.e0
-      avt(:,:,:)         = 0.e0
-
-      ! Compute the ldf trends
-      ! ----------------------
-      CALL tra_ldf( nit000 + 1 )      ! horizontal components (+1: no more init)
-      CALL tra_zdf( nit000     )      ! vertical component (if necessary nit000 to performed the init)
-
-      ! finalise the computation and recover all arrays
-      ! -----------------------------------------------
-      l_trdtra = llsave
-      z12 = 2.e0
-      IF( neuler == 1)   z12 = 1.e0
-      IF( ln_zdfexp ) THEN      ! ta,sa are the trends
-         t0_ldf(:,:,:) = tsa(:,:,:,jp_tem)
-         s0_ldf(:,:,:) = tsa(:,:,:,jp_sal)
-      ELSE
-         DO jk = 1, jpkm1
-            t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdttra(jk) )
-            s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdttra(jk) )
-         END DO
-      ENDIF
-      tsb(:,:,:,jp_tem) = ztb (:,:,:)
-      tsb(:,:,:,jp_sal) = zsb (:,:,:)
-      tsa(:,:,:,jp_tem) = ua  (:,:,:)
-      tsa(:,:,:,jp_sal) = va  (:,:,:)
-      avt(:,:,:)        = zavt(:,:,:)
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('ldf_ano')
-      !
-   END SUBROUTINE ldf_ano
-
-#else
-   !!----------------------------------------------------------------------
-   !!   default option :   Dummy code   NO T & S background profiles
-   !!----------------------------------------------------------------------
-   SUBROUTINE ldf_ano
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on the full fields'
-         WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-   END SUBROUTINE ldf_ano
-#endif
 
    !!======================================================================
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 6807)
+++ 	(revision )
@@ -1,189 +1,0 @@
-MODULE traldf_bilap
-   !!==============================================================================
-   !!                   ***  MODULE  traldf_bilap  ***
-   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
-   !!==============================================================================
-   !! History :  OPA  !  1991-11  (G. Madec)  Original code
-   !!                 !  1993-03  (M. Guyon)  symetrical conditions
-   !!                 !  1995-11  (G. Madec)  suppress volumetric scale factors
-   !!                 !  1996-01  (G. Madec)  statement function for e3
-   !!                 !  1996-01  (M. Imbard)  mpp exchange
-   !!                 !  1997-07  (G. Madec)  optimization, and ahtt
-   !!            8.5  !  2002-08  (G. Madec)  F90: Free form and module
-   !!   NEMO     1.0  !  2004-08  (C. Talandier) New trends organization
-   !!             -   !  2005-11  (G. Madec)  zps or sco as default option
-   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
-   !!==============================================================================
-
-   !!----------------------------------------------------------------------
-   !!   tra_ldf_bilap : update the tracer trend with the horizontal diffusion
-   !!                   using a iso-level biharmonic operator
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE ldftra_oce      ! ocean tracer   lateral physics
-   USE in_out_manager  ! I/O manager
-   USE ldfslp          ! iso-neutral slopes 
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE diaptr          ! poleward transport diagnostics
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo       ! Memory Allocation
-   USE timing         ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_ldf_bilap   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
-#  include "ldfeiv_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
- 
-   SUBROUTINE tra_ldf_bilap( kt, kit000, cdtype, pgu, pgv,            &
-      &                                          pgui, pgvi,          &
-      &                                  ptb, pta, kjpt )  
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_ldf_bilap  ***
-      !!
-      !! ** Purpose :   Compute the before horizontal tracer diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   4th order diffusive operator along model level surfaces 
-      !!      evaluated using before fields (forward time scheme). The hor.
-      !!      diffusive trends  is given by:
-      !!      Laplacian of tb:
-      !!         zlt   = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(tb) ]
-      !!                                  + dj-1[ e1v*e3v/e2v dj(tb) ]  }
-      !!      Multiply by the eddy diffusivity coef. and insure lateral bc:
-      !!        zlt   = ahtt * zlt
-      !!        call to lbc_lnk
-      !!      Bilaplacian (laplacian of zlt):
-      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(zlt) ]
-      !!                                  + dj-1[ e1v*e3v/e2v dj(zlt) ]  }
-      !!
-      !!      Add this trend to the general trend
-      !!         (pta) = (pta) + ( difft )
-      !!
-      !! ** Action : - Update pta arrays with the before iso-level
-      !!               biharmonic mixing trend.
-      !!----------------------------------------------------------------------
-      USE oce     , ONLY:   ztu  => ua       , ztv  => va                           ! (ua,va) used as workspace
-      !!
-      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgu , pgv  ! tracer gradient at pstep levels
-      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at pstep levels
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
-      !!
-      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::  zbtr, ztra       ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:) ::  zeeu, zeev, zlt
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'tra_ldf_bilap')
-      !
-      CALL wrk_alloc( jpi, jpj, zeeu, zeev, zlt ) 
-      !
-
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
-      ENDIF
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         !                                               
-         DO jk = 1, jpkm1                                        ! Horizontal slab
-            !                                             
-            !                          !==  Initialization of metric arrays (for z- or s-coordinates)  ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zeeu(ji,jj) = re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) * umask(ji,jj,jk)
-                  zeev(ji,jj) = re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) * vmask(ji,jj,jk)
-               END DO
-            END DO
-            !                          !==  Laplacian  ==!
-            !
-            DO jj = 1, jpjm1                 ! First derivative (gradient)
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
-                  ztv(ji,jj,jk) = zeev(ji,jj) * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
-               END DO
-            END DO
-            !
-            IF( ln_zps ) THEN                ! set gradient at partial step level (last ocean level)
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     IF( mbku(ji,jj) == jk )  ztu(ji,jj,jk) = zeeu(ji,jj) * pgu(ji,jj,jn)
-                     IF( mbkv(ji,jj) == jk )  ztv(ji,jj,jk) = zeev(ji,jj) * pgv(ji,jj,jn)
-                  END DO
-               END DO
-            ENDIF
-            ! (ISH)
-            IF( ln_zps .AND. ln_isfcav ) THEN ! set gradient at partial step level (first ocean level in a cavity)
-               DO jj = 1, jpjm1
-                  DO ji = 1, jpim1
-                     IF( miku(ji,jj) == MAX(jk,2) )  ztu(ji,jj,jk) = zeeu(ji,jj) * pgui(ji,jj,jn)
-                     IF( mikv(ji,jj) == MAX(jk,2) )  ztu(ji,jj,jk) = zeev(ji,jj) * pgvi(ji,jj,jn)
-                  END DO
-               END DO
-            ENDIF
-            !
-            DO jj = 2, jpjm1                 ! Second derivative (divergence) time the eddy diffusivity coefficient
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
-                  zlt(ji,jj) = fsahtt(ji,jj,jk) * zbtr * (   ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
-                     &                                     + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)   )
-               END DO
-            END DO
-            CALL lbc_lnk( zlt, 'T', 1. )     ! Lateral boundary conditions (unchanged sgn)
-
-            !                          !==  Bilaplacian  ==!
-            !
-            DO jj = 1, jpjm1                 ! third derivative (gradient)
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj  ) - zlt(ji,jj) )
-                  ztv(ji,jj,jk) = zeev(ji,jj) * ( zlt(ji  ,jj+1) - zlt(ji,jj) )
-               END DO
-            END DO
-            DO jj = 2, jpjm1                 ! fourth derivative (divergence) and add to the general tracer trend
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! horizontal diffusive trends
-                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
-                  ztra = 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
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-            !                                             
-         END DO                                           ! Horizontal slab
-         !                                                
-         ! "zonal" mean lateral diffusive heat and salt transport
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-           IF( jn == jp_tem )  htr_ldf(:) = ptr_sj( ztv(:,:,:) )
-           IF( jn == jp_sal )  str_ldf(:) = ptr_sj( ztv(:,:,:) )
-         ENDIF
-         !                                                ! ===========
-      END DO                                              ! tracer loop
-      !                                                   ! ===========
-      IF( nn_timing == 1 )  CALL timing_stop( 'tra_ldf_bilap')
-      !
-      CALL wrk_dealloc( jpi, jpj, zeeu, zeev, zlt ) 
-      !
-   END SUBROUTINE tra_ldf_bilap
-
-   !!==============================================================================
-END MODULE traldf_bilap
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 6807)
+++ 	(revision )
@@ -1,363 +1,0 @@
-MODULE traldf_bilapg
-   !!==============================================================================
-   !!                       ***  MODULE  traldf_bilapg  ***
-   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
-   !!==============================================================================
-   !! History : 8.0   ! 1997-07  (G. Madec)  Original code
-   !!   NEMO    1.0   ! 2002-08  (G. Madec)  F90: Free form and module
-   !!           3.3   ! 2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
-   !!==============================================================================
-#if defined key_ldfslp   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-   !!   tra_ldf_bilapg : update the tracer trend with the horizontal diffusion
-   !!                    using an horizontal biharmonic operator in s-coordinate 
-   !!   ldfght         :  ???
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE in_out_manager  ! I/O manager
-   USE ldfslp          ! iso-neutral slopes available
-   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
-   USE diaptr          ! poleward transport diagnostics 
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_ldf_bilapg   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
-#  include "ldfeiv_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_ldf_bilapg( kt, kit000, cdtype, ptb, pta, kjpt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE tra_ldf_bilapg  ***
-      !!                    
-      !! ** Purpose :   Compute the before horizontal tracer diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   The lateral diffusive trends is provided by a 4th order
-      !!      operator rotated along geopotential surfaces. It is computed
-      !!      using before fields (forward in time) and geopotential slopes
-      !!      computed in routine inildf.
-      !!         -1- compute the geopotential harmonic operator applied to
-      !!        ptb and multiply it by the eddy diffusivity coefficient
-      !!       (done by a call to ldfght routine, result in wk1 arrays).
-      !!      Applied the domain lateral boundary conditions by call to lbc_lnk
-      !!         -2- compute the geopotential harmonic operator applied to
-      !!      wk1 by a second call to ldfght routine (result in wk2)
-      !!      arrays).
-      !!         -3- Add this trend to the general trend 
-      !!            pta = pta + wk2
-      !!
-      !! ** Action : - Update pta arrays with the before geopotential 
-      !!               biharmonic mixing trend.
-      !!----------------------------------------------------------------------
-      !
-      INTEGER         , INTENT(in   )                      ::   kt       ! ocean time-step index
-      INTEGER         , INTENT(in   )                      ::   kit000   ! first time step index
-      CHARACTER(len=3), INTENT(in   )                      ::   cdtype   ! =TRA or TRC (tracer indicator)
-      INTEGER         , INTENT(in   )                      ::   kjpt     ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
-      !
-      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zwk1, zwk2 
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_bilapg')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, kjpt, zwk1, zwk2 ) 
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_ldf_bilapg : horizontal biharmonic operator in s-coordinate on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
-      ENDIF
-
-      ! 1. Laplacian of ptb * aht
-      ! ----------------------------- 
-      CALL ldfght( kt, cdtype, ptb, zwk1, kjpt, 1 )      ! rotated harmonic operator applied to ptb and multiply by aht 
-      !                                                 ! output in wk1 
-      !
-      DO jn = 1, kjpt
-         CALL lbc_lnk( zwk1(:,:,:,jn) , 'T', 1. )        ! Lateral boundary conditions on wk1   (unchanged sign)
-      END DO
-
-      ! 2. Bilaplacian of ptb
-      ! -------------------------
-      CALL ldfght( kt, cdtype, zwk1, zwk2, kjpt, 2 )      ! rotated harmonic operator applied to wk1 ; output in wk2
-
-
-      ! 3. Update the tracer trends                    (j-slab :   2, jpj-1)
-      ! ---------------------------
-      DO jn = 1, kjpt
-         DO jj = 2, jpjm1
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  ! add it to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zwk2(ji,jj,jk,jn)
-               END DO
-            END DO
-         END DO
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, kjpt, zwk1, zwk2 ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_bilapg')
-      !
-   END SUBROUTINE tra_ldf_bilapg
-
-
-   SUBROUTINE ldfght ( kt, cdtype, pt, plt, kjpt, kaht )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldfght  ***
-      !!          
-      !! ** Purpose :   Apply a geopotential harmonic operator to (pt) and 
-      !!      multiply it by the eddy diffusivity coefficient (if kaht=1).
-      !!      Routine only used in s-coordinates (l_sco=T) with bilaplacian
-      !!      operator (ln_traldf_bilap=T) acting along geopotential surfaces
-      !!      (ln_traldf_hor).
-      !!
-      !! ** Method  :   The harmonic operator rotated along geopotential 
-      !!      surfaces is applied to (pt) using the slopes of geopotential
-      !!      surfaces computed in inildf routine. The result is provided in
-      !!      (plt,pls) arrays. It is computed in 2 steps:
-      !!
-      !!      First step: horizontal part of the operator. It is computed on
-      !!      ==========  pt as follows (idem on ps)
-      !!      horizontal fluxes :
-      !!         zftu = e2u*e3u/e1u di[ pt ] - e2u*uslp dk[ mi(mk(pt)) ]
-      !!         zftv = e1v*e3v/e2v dj[ pt ] - e1v*vslp dk[ mj(mk(pt)) ]
-      !!      take the horizontal divergence of the fluxes (no divided by
-      !!      the volume element :
-      !!         plt  = di-1[ zftu ] +  dj-1[ zftv ]
-      !!
-      !!      Second step: vertical part of the operator. It is computed on
-      !!      ===========  pt as follows (idem on ps)
-      !!      vertical fluxes :
-      !!         zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2)  dk-1[ pt ]
-      !!              -     e2t     *       wslpi        di[ mi(mk(pt)) ]
-      !!              -     e1t     *       wslpj        dj[ mj(mk(pt)) ]
-      !!      take the vertical divergence of the fluxes add it to the hori-
-      !!      zontal component, divide the result by the volume element and
-      !!      if kaht=1, multiply by the eddy diffusivity coefficient:
-      !!         plt  = aht / (e1t*e2t*e3t) { plt + dk[ zftw ] }
-      !!      else:
-      !!         plt  =  1  / (e1t*e2t*e3t) { plt + dk[ zftw ] }
-      !!
-      !!----------------------------------------------------------------------
-      USE oce     , ONLY:   zftv => ua       ! ua used as workspace
-      !
-      INTEGER         , INTENT(in )                              ::  kt      ! ocean time-step index
-      CHARACTER(len=3), INTENT(in )                              ::  cdtype  ! =TRA or TRC (tracer indicator) 
-      INTEGER         , INTENT(in )                              ::  kjpt    !: dimension of 
-      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) ::  pt      ! tracer fields ( before for 1st call
-      !                                                         ! and laplacian of these fields for 2nd call. 
-      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk,kjpt) ::  plt     !: partial harmonic operator applied to  pt  components except
-      !                                                             !: second order vertical derivative term  
-      INTEGER         , INTENT(in )                              ::  kaht    !: =1 multiply the laplacian by the eddy diffusivity coeff.
-      !                                                             !: =2 no multiplication 
-      !!
-      INTEGER ::   ji, jj, jk,jn          ! dummy loop indices
-      !                                   ! temporary scalars
-      REAL(wp) ::  zabe1, zabe2, zmku, zmkv 
-      REAL(wp) ::  zbtr, ztah, ztav
-      REAL(wp) ::  zcof0, zcof1, zcof2, zcof3, zcof4
-      REAL(wp), POINTER, DIMENSION(:,:) ::  zftu, zdkt, zdk1t
-      REAL(wp), POINTER, DIMENSION(:,:) ::  zftw, zdit, zdjt, zdj1t
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('ldfght')
-      !
-      CALL wrk_alloc( jpi, jpj, zftu, zdkt, zdk1t ) 
-      CALL wrk_alloc( jpi, jpk, zftw, zdit, zdjt, zdj1t ) 
-      !
-      DO jn = 1, kjpt
-         !                               ! ********** !   ! ===============
-         DO jk = 1, jpkm1                ! First step !   ! Horizontal slab
-            !                            ! ********** !   ! ===============
-            
-            ! I.1 Vertical gradient of pt and ps at level jk and jk+1
-            ! -------------------------------------------------------
-            !     surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
-            
-            zdk1t(:,:) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
-            IF( jk == 1 ) THEN
-               zdkt(:,:) = zdk1t(:,:)
-            ELSE
-               zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * tmask(:,:,jk)
-            ENDIF
-
-
-            ! I.2 Horizontal fluxes
-            ! ---------------------
-            
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zabe1 = re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
-                  zabe2 = re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
-                  
-                  zmku = 1./MAX( tmask(ji+1,jj,jk  )+tmask(ji,jj,jk+1)   &
-                     &          +tmask(ji+1,jj,jk+1)+tmask(ji,jj,jk  ),1. )
-                  zmkv = 1./MAX( tmask(ji,jj+1,jk  )+tmask(ji,jj,jk+1)   &
-                     &          +tmask(ji,jj+1,jk+1)+tmask(ji,jj,jk  ),1. )
-                  
-                  zcof1 = -e2u(ji,jj) * uslp(ji,jj,jk) * zmku
-                  zcof2 = -e1v(ji,jj) * vslp(ji,jj,jk) * zmkv
-                  
-                  zftu(ji,jj)= umask(ji,jj,jk) *   &
-                     &         (  zabe1 *( pt   (ji+1,jj,jk,jn) - pt(ji,jj,jk,jn) )   &
-                     &          + zcof1 *( zdkt (ji+1,jj) + zdk1t(ji,jj)     &
-                     &                    +zdk1t(ji+1,jj) + zdkt (ji,jj) )  )
-                  
-                  zftv(ji,jj,jk)= vmask(ji,jj,jk) *   &
-                     &         (  zabe2 *( pt(ji,jj+1,jk,jn) - pt(ji,jj,jk,jn) )   &
-                     &          + zcof2 *( zdkt (ji,jj+1) + zdk1t(ji,jj)     &
-                     &                    +zdk1t(ji,jj+1) + zdkt (ji,jj) )  )                  
-               END DO
-            END DO
-
-
-            ! I.3 Second derivative (divergence) (not divided by the volume)
-            ! ---------------------
-            
-            DO jj = 2 , jpjm1
-               DO ji = 2 , jpim1
-                  ztah = zftu(ji,jj) - zftu(ji-1,jj) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)
-                  plt(ji,jj,jk,jn) = ztah
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         ! "Poleward" diffusive heat or salt transport
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) THEN
-            ! note sign is reversed to give down-gradient diffusive transports (#1043)
-            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) )
-            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) )
-         ENDIF
-
-         !                             ! ************ !   ! ===============
-         DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
-            !                          ! ************ !   ! ===============
-            
-            ! II.1 horizontal tracer gradient
-            ! -------------------------------
-            
-            DO jk = 1, jpk
-               DO ji = 1, jpim1
-                  zdit (ji,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj  ,jk,jn) ) * umask(ji,jj  ,jk)
-                  zdjt (ji,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj  ,jk,jn) ) * vmask(ji,jj  ,jk)
-                  zdj1t(ji,jk) = ( pt(ji  ,jj  ,jk,jn) - pt(ji,jj-1,jk,jn) ) * vmask(ji,jj-1,jk)
-               END DO
-            END DO
-
-
-            ! II.2 Vertical fluxes
-            ! --------------------
-            
-            ! Surface and bottom vertical fluxes set to zero
-            zftw(:, 1 ) = 0.e0
-            zftw(:,jpk) = 0.e0
-            
-            ! interior (2=<jk=<jpk-1)
-            DO jk = 2, jpkm1
-               DO ji = 2, jpim1
-                  zcof0 = e12t(ji,jj) / fse3w_n(ji,jj,jk)   &
-                     &     * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)        &
-                     &        + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
-                  
-                  zmku = 1./MAX(  umask(ji  ,jj,jk-1)+umask(ji-1,jj,jk)   &
-                     &           +umask(ji-1,jj,jk-1)+umask(ji  ,jj,jk), 1. )
-                  
-                  zmkv = 1./MAX(  vmask(ji,jj  ,jk-1)+vmask(ji,jj-1,jk)   &
-                     &           +vmask(ji,jj-1,jk-1)+vmask(ji,jj  ,jk), 1. )
-                  
-                  zcof3 = - e2t(ji,jj) * wslpi (ji,jj,jk) * zmku
-                  zcof4 = - e1t(ji,jj) * wslpj (ji,jj,jk) * zmkv
-                  
-                  zftw(ji,jk) = tmask(ji,jj,jk) *   &
-                     &    (  zcof0 * ( pt   (ji,jj,jk-1,jn) - pt   (ji  ,jj,jk,jn) )   &
-                     &     + zcof3 * ( zdit (ji   ,jk-1   ) + zdit (ji-1,jk      )     &
-                     &                +zdit (ji-1 ,jk-1   ) + zdit (ji  ,jk      ) )   &
-                     &     + zcof4 * ( zdjt (ji   ,jk-1   ) + zdj1t(ji  ,jk)     &
-                     &                +zdj1t(ji   ,jk-1   ) + zdjt (ji  ,jk      ) )  )                 
-               END DO
-            END DO
-
-
-            ! II.3 Divergence of vertical fluxes added to the horizontal divergence
-            ! ---------------------------------------------------------------------
-            
-            IF( kaht == 1 ) THEN
-               ! multiply the laplacian by the eddy diffusivity coefficient
-               DO jk = 1, jpkm1
-                  DO ji = 2, jpim1
-                     ! eddy coef. divided by the volume element
-                     zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
-                     ! vertical divergence
-                     ztav = fsahtt(ji,jj,jk) * ( zftw(ji,jk) - zftw(ji,jk+1) )
-                     ! harmonic operator applied to (pt,ps) and multiply by aht
-                     plt(ji,jj,jk,jn) = ( plt(ji,jj,jk,jn) + ztav ) * zbtr
-                  END DO
-               END DO
-            ELSEIF( kaht == 2 ) THEN
-               ! second call, no multiplication
-               DO jk = 1, jpkm1
-                  DO ji = 2, jpim1
-                     ! inverse of the volume element
-                     zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
-                     ! vertical divergence
-                     ztav = zftw(ji,jk) - zftw(ji,jk+1)
-                     ! harmonic operator applied to (pt,ps) 
-                     plt(ji,jj,jk,jn) = ( plt(ji,jj,jk,jn) + ztav ) * zbtr
-                  END DO
-               END DO
-            ELSE
-               IF(lwp) WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht
-               IF(lwp) WRITE(numout,*) '         We stop'
-               STOP 'ldfght'
-            ENDIF
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, zftu, zdkt, zdk1t ) 
-      CALL wrk_dealloc( jpi, jpk, zftw, zdit, zdjt, zdj1t ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('ldfght')
-      !
-   END SUBROUTINE ldfght
-
-#else  
-   !!----------------------------------------------------------------------
-   !!   Dummy module :             NO rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE tra_ldf_bilapg( kt, kit000, cdtype, ptb, pta, kjpt )      ! Empty routine
-      INTEGER :: kt, kit000
-      CHARACTER(len=3) ::   cdtype
-      REAL, DIMENSION(:,:,:,:) ::   ptb, pta
-      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', &
-        &         kt, kit000, cdtype, ptb(1,1,1,1), pta(1,1,1,1), kjpt
-   END SUBROUTINE tra_ldf_bilapg
-#endif
-
-   !!==============================================================================
-END MODULE traldf_bilapg
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 6808)
@@ -4,32 +4,31 @@
    !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
    !!======================================================================
-   !! History :  OPA  !  1994-08  (G. Madec, M. Imbard)
-   !!            8.0  !  1997-05  (G. Madec)  split into traldf and trazdf
-   !!            NEMO !  2002-08  (G. Madec)  Free form, F90
-   !!            1.0  !  2005-11  (G. Madec)  merge traldf and trazdf :-)
-   !!            3.3  !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
+   !! History :  OPA  ! 1994-08  (G. Madec, M. Imbard)
+   !!            8.0  ! 1997-05  (G. Madec)  split into traldf and trazdf
+   !!            NEMO ! 2002-08  (G. Madec)  Free form, F90
+   !!            1.0  ! 2005-11  (G. Madec)  merge traldf and trazdf :-)
+   !!            3.3  ! 2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!            3.7  ! 2014-01  (G. Madec, S. Masson)  restructuration/simplification of aht/aeiv specification
+   !!             -   ! 2014-02  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction
    !!----------------------------------------------------------------------
-#if   defined key_ldfslp   ||   defined key_esopa
+
    !!----------------------------------------------------------------------
-   !!   'key_ldfslp'               slope of the lateral diffusive direction
+   !!   tra_ldf_iso   : update the tracer trend with the horizontal component of a iso-neutral laplacian operator
+   !!                   and with the vertical part of the isopycnal or geopotential s-coord. operator 
    !!----------------------------------------------------------------------
-   !!   tra_ldf_iso  : update the tracer trend with the horizontal 
-   !!                  component of a iso-neutral laplacian operator
-   !!                  and with the vertical part of
-   !!                  the isopycnal or geopotential s-coord. operator 
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE zdf_oce         ! ocean vertical physics
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE ldfslp          ! iso-neutral slopes
-   USE diaptr          ! poleward transport diagnostics
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O library
-   USE phycst          ! physical constants
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE zdf_oce        ! ocean vertical physics
+   USE ldftra         ! lateral diffusion: tracer eddy coefficients
+   USE ldfslp         ! iso-neutral slopes
+   USE diaptr         ! poleward transport diagnostics
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   USE phycst         ! physical constants
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -39,9 +38,7 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -49,7 +46,7 @@
 CONTAINS
 
-   SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pgu, pgv,              &
-      &                                pgui, pgvi,                    &
-      &                                ptb, pta, kjpt, pahtb0 )
+  SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
+      &                                                   pgui, pgvi,   &
+      &                                       ptb , ptbb, pta , kjpt, kpass )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf_iso  ***
@@ -66,14 +63,15 @@
       !!
       !!      1st part :  masked horizontal derivative of T  ( di[ t ] )
-      !!      ========    with partial cell update if ln_zps=T.
+      !!      ========    with partial cell update if ln_zps=T
+      !!                  with top     cell update if ln_isfcav
       !!
       !!      2nd part :  horizontal fluxes of the lateral mixing operator
       !!      ========    
-      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
-      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ]
-      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
-      !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ]
+      !!         zftu =  pahu e2u*e3u/e1u di[ tb ]
+      !!               - pahu e2u*uslp    dk[ mi(mk(tb)) ]
+      !!         zftv =  pahv e1v*e3v/e2v dj[ tb ]
+      !!               - pahv e2u*vslp    dk[ mj(mk(tb)) ]
       !!      take the horizontal divergence of the fluxes:
-      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
+      !!         difft = 1/(e1e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
       !!      Add this trend to the general trend (ta,sa):
       !!         ta = ta + difft
@@ -82,8 +80,8 @@
       !!      ========  (excluding the vertical flux proportional to dk[t] )
       !!      vertical fluxes associated with the rotated lateral mixing:
-      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(tb)) ]
-      !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  }
+      !!         zftw = - {  mi(mk(pahu)) * e2t*wslpi di[ mi(mk(tb)) ]
+      !!                   + mj(mk(pahv)) * e1t*wslpj dj[ mj(mk(tb)) ]  }
       !!      take the horizontal divergence of the fluxes:
-      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ]
+      !!         difft = 1/(e1e2t*e3t) dk[ zftw ]
       !!      Add this trend to the general trend (ta,sa):
       !!         pta = pta + difft
@@ -91,35 +89,115 @@
       !! ** Action :   Update pta arrays with the before rotated diffusion
       !!----------------------------------------------------------------------
-      USE oce     , ONLY:   zftu => ua       , zftv  => va         ! (ua,va) used as workspace
-      !
       INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index
       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
       INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu , pgv    ! tracer gradient at pstep levels
-      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgui, pgvi   ! tracer gradient at pstep levels
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
-      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef
+      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
       !
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
       INTEGER  ::  ikt
-      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars
-      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
-      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdkt, zdk1t, zdit, zdjt, ztfw 
+      INTEGER  ::  ierr             ! local integer
+      REAL(wp) ::  zmsku, zahu_w, zabe1, zcof1, zcoef3   ! local scalars
+      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      -
+      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt   !   -      -
+#if defined key_diaar5
+      REAL(wp) ::   zztmp   ! local scalar
+#endif
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdkt, zdk1t, z2d
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdit, zdjt, zftu, zftv, ztfw 
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso')
       !
-      CALL wrk_alloc( jpi, jpj,      z2d ) 
-      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 
-      !
-
+      CALL wrk_alloc( jpi,jpj,       zdkt, zdk1t, z2d ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt , zftu, zftv, ztfw  ) 
+      !
       IF( kt == kit000 )  THEN
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         !
+         akz     (:,:,:) = 0._wp      
+         ah_wslp2(:,:,:) = 0._wp
+      ENDIF
+      !                                               ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   z2dt =     rdt      ! at nit000   (Euler)
+      ELSE                                        ;   z2dt = 2.* rdt      !             (Leapfrog)
+      ENDIF
+      z1_2dt = 1._wp / z2dt
+      !
+      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
+      ELSE                    ;   zsign = -1._wp
+      ENDIF
+         
+      !!----------------------------------------------------------------------
+      !!   0 - calculate  ah_wslp2 and akz
+      !!----------------------------------------------------------------------
+      !
+      IF( kpass == 1 ) THEN                  !==  first pass only  ==!
+         !
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !
+                  zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
+                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  )
+                  zmskv = wmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          &
+                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
+                     !
+                  zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
+                     &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
+                  zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
+                     &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
+                     !
+                  ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                     &               + zahv_w * wslpj(ji,jj,jk) * wslpj(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     akz(ji,jj,jk) = 0.25_wp * (                                                                     &
+                        &              ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   &
+                        &            + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) )   &
+                        &            + ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) )   &
+                        &            + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) )   )
+                  END DO
+               END DO
+            END DO
+            !
+            IF( ln_traldf_blp ) THEN                ! bilaplacian operator
+               DO jk = 2, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   &
+                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) )  )
+                     END DO
+                  END DO
+               END DO
+            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator
+               DO jk = 2, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk)
+                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
+                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt
+                     END DO
+                  END DO
+               END DO
+           ENDIF
+           !
+         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit
+            akz(:,:,:) = ah_wslp2(:,:,:)      
+         ENDIF
       ENDIF
       !
@@ -131,7 +209,7 @@
          !!   I - masked horizontal derivative 
          !!----------------------------------------------------------------------
-         !!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient....
-         zdit (1,:,:) = 0.e0     ;     zdit (jpi,:,:) = 0.e0
-         zdjt (1,:,:) = 0.e0     ;     zdjt (jpi,:,:) = 0.e0
+!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient....
+         zdit (1,:,:) = 0._wp     ;     zdit (jpi,:,:) = 0._wp
+         zdjt (1,:,:) = 0._wp     ;     zdjt (jpi,:,:) = 0._wp
          !!end
 
@@ -145,157 +223,92 @@
             END DO
          END DO
-
-         ! partial cell correction
-         IF( ln_zps ) THEN      ! partial steps correction at the last ocean level 
-            DO jj = 1, jpjm1
+         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient
+            DO jj = 1, jpjm1              ! bottom correction (partial bottom cell)
                DO ji = 1, fs_jpim1   ! vector opt.
-! IF useless if zpshde defines pgu everywhere
                   zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)          
                   zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
                END DO
             END DO
+            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)          
+                     IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)     
+                  END DO
+               END DO
+            ENDIF
          ENDIF
-         IF( ln_zps .AND. ln_isfcav ) THEN      ! partial steps correction at the first wet level beneath a cavity
-            DO jj = 1, jpjm1
+         !
+         !!----------------------------------------------------------------------
+         !!   II - horizontal trend  (full)
+         !!----------------------------------------------------------------------
+         !
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !
+            !                             !== Vertical tracer gradient
+            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1
+            !
+            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)                          ! surface: zdkt(jk=1)=zdkt(jk=2)
+            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk)
+            ENDIF
+            DO jj = 1 , jpjm1            !==  Horizontal fluxes
                DO ji = 1, fs_jpim1   ! vector opt.
-                  IF (miku(ji,jj) > 1) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)          
-                  IF (mikv(ji,jj) > 1) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)     
-               END DO
-            END DO
-         END IF
-
-         !!----------------------------------------------------------------------
-         !!   II - horizontal trend  (full)
-         !!----------------------------------------------------------------------
-!!!!!!!!!!CDIR PARALLEL DO PRIVATE( zdk1t ) 
-            ! 1. Vertical tracer gradient at level jk and jk+1
-            ! ------------------------------------------------
-         ! 
-         ! interior value 
-         DO jk = 2, jpkm1               
-            DO jj = 1, jpj
-               DO ji = 1, jpi   ! vector opt.
-                  zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn  ) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)
-                  !
-                  zdkt(ji,jj,jk)  = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn  ) ) * wmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
-         zdk1t(:,:,1) = ( ptb(:,:,1,jn  ) - ptb(:,:,2,jn) ) * wmask(:,:,2)
-         zdkt (:,:,1) = zdk1t(:,:,1)
-         IF ( ln_isfcav ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi   ! vector opt.
-                  ikt = mikt(ji,jj) ! surface level
-                  zdk1t(ji,jj,ikt) = ( ptb(ji,jj,ikt,jn  ) - ptb(ji,jj,ikt+1,jn) ) * wmask(ji,jj,ikt+1)
-                  zdkt (ji,jj,ikt) = zdk1t(ji,jj,ikt)
-               END DO
-            END DO
-         END IF
-
-         ! 2. Horizontal fluxes
-         ! --------------------   
-         DO jk = 1, jpkm1
-            DO jj = 1 , jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
-                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
-                  !
-                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   &
-                     &             + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. )
-                  !
-                  zmskv = 1. / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   &
-                     &             + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. )
-                  !
-                  zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
-                  zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
+                  zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)
+                  zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)
+                  !
+                  zmsku = 1. / MAX(  wmask(ji+1,jj,jk  ) + wmask(ji,jj,jk+1)   &
+                     &             + wmask(ji+1,jj,jk+1) + wmask(ji,jj,jk  ), 1. )
+                  !
+                  zmskv = 1. / MAX(  wmask(ji,jj+1,jk  ) + wmask(ji,jj,jk+1)   &
+                     &             + wmask(ji,jj+1,jk+1) + wmask(ji,jj,jk  ), 1. )
+                  !
+                  zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
+                  zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
                   !
                   zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   &
-                     &              + zcof1 * (  zdkt (ji+1,jj,jk) + zdk1t(ji,jj,jk)      &
-                     &                         + zdk1t(ji+1,jj,jk) + zdkt (ji,jj,jk)  )  ) * umask(ji,jj,jk)
+                     &               + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
+                     &                          + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk)
                   zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
-                     &              + zcof2 * (  zdkt (ji,jj+1,jk) + zdk1t(ji,jj,jk)      &
-                     &                         + zdk1t(ji,jj+1,jk) + zdkt (ji,jj,jk)  )  ) * vmask(ji,jj,jk)                  
-               END DO
-            END DO
-
-            ! II.4 Second derivative (divergence) and add to the general trend
-            ! ----------------------------------------------------------------
-            DO jj = 2 , jpjm1
+                     &               + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
+                     &                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                  
+               END DO
+            END DO
+            !
+            DO jj = 2 , jpjm1          !== horizontal divergence and add to pta
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
-                  ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-            !                                          ! ===============
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      &
+                     &                                           + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   &
+                     &                                        * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
          END DO                                        !   End of slab  
-         !                                             ! ===============
-         !
-         ! "Poleward" diffusive heat or salt transports (T-S case only)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
-            ! note sign is reversed to give down-gradient diffusive transports (#1043)
-            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) )
-            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) )
-         ENDIF
- 
-         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
-           !
-           IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
-               z2d(:,:) = 0._wp 
-               DO jk = 1, jpkm1
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1   ! vector opt.
-                        z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
-                     END DO
-                  END DO
-               END DO
-               z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043)
-               CALL lbc_lnk( z2d, 'U', -1. )
-               CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
-               !
-               z2d(:,:) = 0._wp 
-               DO jk = 1, jpkm1
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1   ! vector opt.
-                        z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
-                     END DO
-                  END DO
-               END DO
-               z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043)
-               CALL lbc_lnk( z2d, 'V', -1. )
-               CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
-            END IF
-            !
-         ENDIF
-
-         !!----------------------------------------------------------------------
-         !!   III - vertical trend of T & S (extra diagonal terms only)
-         !!----------------------------------------------------------------------
-         
-         ! Local constant initialization
-         ! -----------------------------
-         ztfw(1,:,:) = 0.e0     ;     ztfw(jpi,:,:) = 0.e0
-         
+
+         !!----------------------------------------------------------------------
+         !!   III - vertical trend (full)
+         !!----------------------------------------------------------------------
+         !
+         ztfw(1,:,:) = 0._wp     ;     ztfw(jpi,:,:) = 0._wp
+         !
          ! Vertical fluxes
          ! ---------------
+         !                          ! Surface and bottom vertical fluxes set to zero
+         ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp
          
-         ! Surface and bottom vertical fluxes set to zero
-         ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpk) = 0.e0
-         
-         ! interior (2=<jk=<jpk-1)
-         DO jk = 2, jpkm1
+         DO jk = 2, jpkm1           ! interior (2=<jk=<jpk-1)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zcoef0 = - fsahtw(ji,jj,jk) * wmask(ji,jj,jk)
-                  !
-                  zmsku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      &
-                     &            + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.  )
-                  zmskv = 1./MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      &
-                     &            + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.  )
-                  !
-                  zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)
-                  zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
+                  !
+                  zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
+                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  )
+                  zmskv = wmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          &
+                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
+                     !
+                  zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
+                     &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
+                  zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
+                     &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
+                     !
+                  zcoef3 = - zahu_w * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)   !wslpi & j are already w-masked
+                  zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
                   !
                   ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
@@ -306,41 +319,104 @@
             END DO
          END DO
-         
-         
-         ! I.5 Divergence of vertical fluxes added to the general tracer trend
-         ! -------------------------------------------------------------------
-         DO jk = 1, jpkm1
+         !                                !==  add the vertical 33 flux  ==!
+         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
+            DO jk = 2, jpkm1       
+               DO jj = 1, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)   &
+                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             &
+                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
+                  END DO
+               END DO
+            END DO
+            !
+         ELSE                                   ! bilaplacian 
+            SELECT CASE( kpass )
+            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2
+               DO jk = 2, jpkm1 
+                  DO jj = 1, jpjm1
+                     DO ji = fs_2, fs_jpim1
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk)    &
+                           &           + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   &
+                           &           * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO 
+            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp.
+               DO jk = 2, jpkm1 
+                  DO jj = 1, jpjm1
+                     DO ji = fs_2, fs_jpim1
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)                      &
+                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   &
+                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   )
+                     END DO
+                  END DO
+               END DO
+            END SELECT
+         ENDIF
+         !         
+         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==!
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
-                  ztra = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   &
+                     &                                        * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
                END DO
             END DO
          END DO
          !
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj, z2d ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 
+         IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==!
+             ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==!
+            !
+            !                             ! "Poleward" diffusive heat or salt transports (T-S case only)
+            IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+               ! note sign is reversed to give down-gradient diffusive transports (#1043)
+               IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) )
+               IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) )
+            ENDIF
+            !
+            IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
+              !
+              IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
+                  z2d(:,:) = zftu(ji,jj,1) 
+                  DO jk = 2, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
+                        END DO
+                     END DO
+                  END DO
+!!gm CAUTION I think there is an error of sign when using BLP operator....
+!!gm         a multiplication by zsign is required (to be checked twice !)
+                  z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043)
+                  CALL lbc_lnk( z2d, 'U', -1. )
+                  CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
+                  !
+                  z2d(:,:) = zftv(ji,jj,1) 
+                  DO jk = 2, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
+                        END DO
+                     END DO
+                  END DO
+                  z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043)
+                  CALL lbc_lnk( z2d, 'V', -1. )
+                  CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
+               END IF
+               !
+            ENDIF
+            !
+         ENDIF                                                    !== end pass selection  ==!
+         !
+         !                                                        ! ===============
+      END DO                                                      ! end tracer loop
+      !                                                           ! ===============
+      !
+      CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt , zftu, zftv, ztfw  ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso')
       !
    END SUBROUTINE tra_ldf_iso
-
-#else
-   !!----------------------------------------------------------------------
-   !!   default option :   Dummy code   NO rotation of the diffusive tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE tra_ldf_iso( kt, kit000,cdtype, pgu, pgv, pgui, pgvi, ptb, pta, kjpt, pahtb0 )      ! Empty routine
-      INTEGER:: kt, kit000
-      CHARACTER(len=3) ::   cdtype
-      REAL, DIMENSION(:,:,:) ::   pgu, pgv, pgui, pgvi    ! tracer gradient at pstep levels
-      REAL, DIMENSION(:,:,:,:) ::   ptb, pta
-      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, kit000, cdtype,   &
-         &                       pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0
-   END SUBROUTINE tra_ldf_iso
-#endif
 
    !!==============================================================================
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90	(revision 6807)
+++ 	(revision )
@@ -1,450 +1,0 @@
-MODULE traldf_iso_grif
-   !!======================================================================
-   !!                   ***  MODULE  traldf_iso_grif  ***
-   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
-   !!======================================================================
-   !! History : 3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)
-   !!                !          Griffies operator version adapted from traldf_iso.F90
-   !!----------------------------------------------------------------------
-#if   defined key_ldfslp   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_ldfslp'               slope of the lateral diffusive direction
-   !!----------------------------------------------------------------------
-   !!   tra_ldf_iso_grif  : update the tracer trend with the horizontal component
-   !!                       of the Griffies iso-neutral laplacian operator
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE zdf_oce         ! ocean vertical physics
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE ldfslp          ! iso-neutral slopes
-   USE diaptr          ! poleward transport diagnostics
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_ldf_iso_grif   ! routine called by traldf.F90
-
-   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   psix_eiv, psiy_eiv   !: eiv stream function (diag only)
-   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   ah_wslp2             !: aeiv*w-slope^2
-   REAL(wp),         DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt3d               !: vertical tracer gradient at 2 levels
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-#  include "ldfeiv_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-  SUBROUTINE tra_ldf_iso_grif( kt, kit000, cdtype, pgu, pgv,              &
-       &                                   ptb, pta, kjpt, pahtb0 )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_ldf_iso_grif  ***
-      !!
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive
-      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and
-      !!      add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   The horizontal component of the lateral diffusive trends
-      !!      is provided by a 2nd order operator rotated along neural or geopo-
-      !!      tential surfaces to which an eddy induced advection can be added
-      !!      It is computed using before fields (forward in time) and isopyc-
-      !!      nal or geopotential slopes computed in routine ldfslp.
-      !!
-      !!      1st part :  masked horizontal derivative of T  ( di[ t ] )
-      !!      ========    with partial cell update if ln_zps=T.
-      !!
-      !!      2nd part :  horizontal fluxes of the lateral mixing operator
-      !!      ========
-      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
-      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ]
-      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
-      !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ]
-      !!      take the horizontal divergence of the fluxes:
-      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
-      !!      Add this trend to the general trend (ta,sa):
-      !!         ta = ta + difft
-      !!
-      !!      3rd part: vertical trends of the lateral mixing operator
-      !!      ========  (excluding the vertical flux proportional to dk[t] )
-      !!      vertical fluxes associated with the rotated lateral mixing:
-      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(tb)) ]
-      !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  }
-      !!      take the horizontal divergence of the fluxes:
-      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ]
-      !!      Add this trend to the general trend (ta,sa):
-      !!         pta = pta + difft
-      !!
-      !! ** Action :   Update pta arrays with the before rotated diffusion
-      !!----------------------------------------------------------------------
-      USE oce     , ONLY:   zftu => ua       , zftv => va            ! (ua,va) used as 3D workspace
-      !
-      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
-      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef
-      !
-      INTEGER  ::  ji, jj, jk,jn   ! dummy loop indices
-      INTEGER  ::  ip,jp,kp        ! dummy loop indices
-      INTEGER  ::  ierr            ! temporary integer
-      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars
-      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
-      REAL(wp) ::  zcoef0, zbtr                  !   -      -
-      !
-      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv
-      REAL(wp) ::   ze1ur, zdxt, ze2vr, ze3wr, zdyt, zdzt
-      REAL(wp) ::   zah, zah_slp, zaei_slp
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw 
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso_grif')
-      !
-      CALL wrk_alloc( jpi, jpj,      z2d ) 
-      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw  ) 
-      !
-
-      IF( kt == kit000 .AND. .NOT.ALLOCATED(ah_wslp2) )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_ldf_iso_grif : rotated laplacian diffusion operator on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-         ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt3d(jpi,jpj,0:1), STAT=ierr )
-         IF( lk_mpp   )   CALL mpp_sum ( ierr )
-         IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate arrays')
-         IF( ln_traldf_gdia ) THEN
-            IF (.NOT. ALLOCATED(psix_eiv))THEN
-                ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr )
-                IF( lk_mpp   )   CALL mpp_sum ( ierr )
-                IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics')
-            ENDIF
-         ENDIF
-      ENDIF
-
-      !!----------------------------------------------------------------------
-      !!   0 - calculate  ah_wslp2, psix_eiv, psiy_eiv
-      !!----------------------------------------------------------------------
-
-      !!gm Future development: consider using Ah defined at T-points and attached to the 4 t-point triads
-
-      ah_wslp2(:,:,:) = 0._wp
-      IF( ln_traldf_gdia ) THEN
-         psix_eiv(:,:,:) = 0._wp
-         psiy_eiv(:,:,:) = 0._wp
-      ENDIF
-
-      DO ip = 0, 1
-         DO kp = 0, 1
-            DO jk = 1, jpkm1
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1
-                     ze1ur = 1._wp / e1u(ji,jj)
-                     ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
-                     zbu   = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-                     zah   = fsahtu(ji,jj,jk)                                  ! fsaht(ji+ip,jj,jk)
-                     zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
-                     ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
-                     ! (do this by *adding* gradient of depth)
-                     zslope2 = zslope_skew + ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * ze1ur * umask(ji,jj,jk+kp)
-                     zslope2 = zslope2 *zslope2
-                     ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp)    &
-                        &                     + zah * ( zbu * ze3wr / ( e1t(ji+ip,jj) * e2t(ji+ip,jj) ) ) * zslope2
-                     IF( ln_traldf_gdia ) THEN
-                        zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew           ! fsaeit(ji+ip,jj,jk)*zslope_skew
-                        psix_eiv(ji,jj,jk+kp) = psix_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-         END DO
-      END DO
-      !
-      DO jp = 0, 1
-         DO kp = 0, 1
-            DO jk = 1, jpkm1
-               DO jj = 1, jpjm1
-                  DO ji=1,fs_jpim1
-                     ze2vr = 1._wp / e2v(ji,jj)
-                     ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp)
-                     zbv   = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
-                     zah   = fsahtv(ji,jj,jk)                                  ! fsaht(ji,jj+jp,jk)
-                     zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
-                     ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
-                     !    (do this by *adding* gradient of depth)
-                     zslope2 = zslope_skew + ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * ze2vr * vmask(ji,jj,jk+kp)
-                     zslope2 = zslope2 * zslope2
-                     ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp)   &
-                        &                     + zah * ( zbv * ze3wr / ( e1t(ji,jj+jp) * e2t(ji,jj+jp) ) ) * zslope2
-                     IF( ln_traldf_gdia ) THEN
-                        zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew           ! fsaeit(ji,jj+jp,jk)*zslope_skew
-                        psiy_eiv(ji,jj,jk+kp) = psiy_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-         END DO
-      END DO
-      !
-      IF( iom_use("uoce_eiv") .OR. iom_use("voce_eiv") .OR. iom_use("woce_eiv") )  THEN
-         !
-         IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN
-            CALL wrk_alloc( jpi , jpj , jpk  , zw3d )
-            DO jk=1,jpkm1
-               zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz
-            END DO
-            zw3d(:,:,jpk) = 0._wp
-            CALL iom_put( "uoce_eiv", zw3d )    ! i-eiv current
-
-            DO jk=1,jpk-1
-               zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz
-            END DO
-            zw3d(:,:,jpk) = 0._wp
-            CALL iom_put( "voce_eiv", zw3d )    ! j-eiv current
-
-            DO jk=1,jpk-1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1  ! vector opt.
-                     zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + &
-                          &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx
-                  END DO
-               END DO
-            END DO
-            zw3d(:,:,jpk) = 0._wp
-            CALL iom_put( "woce_eiv", zw3d )    ! vert. eiv current
-            CALL wrk_dealloc( jpi , jpj , jpk  , zw3d )
-         ENDIF
-         !
-      ENDIF
-      !                                                          ! ===========
-      DO jn = 1, kjpt                                            ! tracer loop
-         !                                                       ! ===========
-         ! Zero fluxes for each tracer
-         ztfw(:,:,:) = 0._wp
-         zftu(:,:,:) = 0._wp
-         zftv(:,:,:) = 0._wp
-         !
-         DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
-                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         IF( ln_zps.and.l_grad_zps ) THEN              ! partial steps: correction at the last level
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
-                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
-               END DO
-            END DO
-         ENDIF
-
-         !!----------------------------------------------------------------------
-         !!   II - horizontal trend  (full)
-         !!----------------------------------------------------------------------
-         !
-         DO jk = 1, jpkm1
-            !
-            !                    !==  Vertical tracer gradient at level jk and jk+1
-            zdkt3d(:,:,1) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
-            !
-            !                    ! surface boundary condition: zdkt3d(jk=0)=zdkt3d(jk=1)
-            IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1)
-            ELSE                 ;   zdkt3d(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk)
-            ENDIF
-
-
-            IF (ln_botmix_grif) THEN
-               DO ip = 0, 1              !==  Horizontal & vertical fluxes
-                  DO kp = 0, 1
-                     DO jj = 1, jpjm1
-                        DO ji = 1, fs_jpim1
-                           ze1ur = 1._wp / e1u(ji,jj)
-                           zdxt  = zdit(ji,jj,jk) * ze1ur
-                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
-                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
-                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
-                           zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp)
-
-                           zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-                           ! ln_botmix_grif is .T. don't mask zah for bottom half cells
-                           zah = fsahtu(ji,jj,jk)   !*umask(ji,jj,jk+kp)         !fsaht(ji+ip,jj,jk)           ===>>  ????
-                           zah_slp  = zah * zslope_iso
-                           zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew    !fsaeit(ji+ip,jj,jk)*zslope_skew
-                           zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
-                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
-                        END DO
-                     END DO
-                  END DO
-               END DO
-
-               DO jp = 0, 1
-                  DO kp = 0, 1
-                     DO jj = 1, jpjm1
-                        DO ji = 1, fs_jpim1
-                           ze2vr = 1._wp / e2v(ji,jj)
-                           zdyt  = zdjt(ji,jj,jk) * ze2vr
-                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)
-                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
-                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
-                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
-                           zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
-                           ! ln_botmix_grif is .T. don't mask zah for bottom half cells
-                           zah = fsahtv(ji,jj,jk)        !*vmask(ji,jj,jk+kp)  ! fsaht(ji,jj+jp,jk)
-                           zah_slp = zah * zslope_iso
-                           zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew        ! fsaeit(ji,jj+jp,jk)*zslope_skew
-                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
-                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
-                        END DO
-                     END DO
-                  END DO
-               END DO
-            ELSE
-               DO ip = 0, 1              !==  Horizontal & vertical fluxes
-                  DO kp = 0, 1
-                     DO jj = 1, jpjm1
-                        DO ji = 1, fs_jpim1
-                           ze1ur = 1._wp / e1u(ji,jj)
-                           zdxt  = zdit(ji,jj,jk) * ze1ur
-                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
-                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
-                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
-                           zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp)
-
-                           zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
-                           ! ln_botmix_grif is .F. mask zah for bottom half cells
-                           zah = fsahtu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! fsaht(ji+ip,jj,jk)   ===>>  ????
-                           zah_slp  = zah * zslope_iso
-                           zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew        ! fsaeit(ji+ip,jj,jk)*zslope_skew
-                           zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
-                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
-                        END DO
-                     END DO
-                  END DO
-               END DO
-
-               DO jp = 0, 1
-                  DO kp = 0, 1
-                     DO jj = 1, jpjm1
-                        DO ji = 1, fs_jpim1
-                           ze2vr = 1._wp / e2v(ji,jj)
-                           zdyt  = zdjt(ji,jj,jk) * ze2vr
-                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)
-                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
-                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
-                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
-                           zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
-                           ! ln_botmix_grif is .F. mask zah for bottom half cells
-                           zah = fsahtv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! fsaht(ji,jj+jp,jk)
-                           zah_slp = zah * zslope_iso
-                           zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew        ! fsaeit(ji,jj+jp,jk)*zslope_skew
-                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
-                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
-                        END DO
-                     END DO
-                  END DO
-               END DO
-            END IF
-            !                          !==  divergence and add to the general trend  ==!
-            DO jj = 2 , jpjm1
-               DO ji = fs_2, fs_jpim1  ! vector opt.
-                  zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (   zftu(ji-1,jj,jk) - zftu(ji,jj,jk)   &
-                     &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )
-               END DO
-            END DO
-            !
-         END DO
-         !
-         DO jk = 1, jpkm1              !== Divergence of vertical fluxes added to the general tracer trend
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1  ! vector opt.
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   &
-                     &                                / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
-         !
-         !                             ! "Poleward" diffusive heat or salt transports (T-S case only)
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
-            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names
-            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) )
-         ENDIF
-
-         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
-           !
-           IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
-               z2d(:,:) = 0._wp 
-               DO jk = 1, jpkm1
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1   ! vector opt.
-                        z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
-                     END DO
-                  END DO
-               END DO
-               z2d(:,:) = rau0_rcp * z2d(:,:) 
-               CALL lbc_lnk( z2d, 'U', -1. )
-               CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
-               !
-               z2d(:,:) = 0._wp 
-               DO jk = 1, jpkm1
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1   ! vector opt.
-                        z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
-                     END DO
-                  END DO
-               END DO
-               z2d(:,:) = rau0_rcp * z2d(:,:)     
-               CALL lbc_lnk( z2d, 'V', -1. )
-               CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
-            END IF
-            !
-         ENDIF
-         !
-      END DO
-      !
-      CALL wrk_dealloc( jpi, jpj,      z2d ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw  ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso_grif')
-      !
-  END SUBROUTINE tra_ldf_iso_grif
-
-#else
-   !!----------------------------------------------------------------------
-   !!   default option :   Dummy code   NO rotation of the diffusive tensor
-   !!----------------------------------------------------------------------
-   REAL, PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   psix_eiv, psiy_eiv   !: eiv stream function (diag only)
-CONTAINS
-   SUBROUTINE tra_ldf_iso_grif( kt, kit000, cdtype, pgu, pgv,              &
-       &                                   ptb, pta, kjpt, pahtb0 )
-      CHARACTER(len=3) ::   cdtype
-      INTEGER          ::   kit000     ! first time step index
-      REAL, DIMENSION(:,:,:) ::   pgu, pgv   ! tracer gradient at pstep levels
-      REAL, DIMENSION(:,:,:,:) ::   ptb, pta
-      WRITE(*,*) 'tra_ldf_iso_grif: You should not have seen this print! error?', kt, cdtype,    &
-         &                  pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0
-   END SUBROUTINE tra_ldf_iso_grif
-#endif
-
-   !!==============================================================================
-END MODULE traldf_iso_grif
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 6807)
+++ 	(revision )
@@ -1,168 +1,0 @@
-MODULE traldf_lap
-   !!==============================================================================
-   !!                       ***  MODULE  traldf_lap  ***
-   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
-   !!==============================================================================
-   !! History :  OPA  !  87-06  (P. Andrich, D. L Hostis)  Original code
-   !!                 !  91-11  (G. Madec)
-   !!                 !  95-11  (G. Madec)  suppress volumetric scale factors
-   !!                 !  96-01  (G. Madec)  statement function for e3
-   !!            NEMO !  02-06  (G. Madec)  F90: Free form and module
-   !!            1.0  !  04-08  (C. Talandier) New trends organization
-   !!                 !  05-11  (G. Madec)  add zps case
-   !!            3.0  !  10-06  (C. Ethe, G. Madec) Merge TRA-TRC
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_ldf_lap  : update the tracer trend with the horizontal diffusion
-   !!                 using a iso-level harmonic (laplacien) operator.
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE in_out_manager  ! I/O manager
-   USE diaptr          ! poleward transport diagnostics
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE lib_mpp         ! MPP library
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_ldf_lap   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pgu , pgv ,    &
-      &                                        pgui, pgvi,    &
-      &                                ptb, pta, kjpt ) 
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_ldf_lap  ***
-      !!                   
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   Second order diffusive operator evaluated using before
-      !!      fields (forward time scheme). The horizontal diffusive trends of 
-      !!      the tracer is given by:
-      !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(tb) ]
-      !!                                   + dj-1[ aht e1v*e3v/e2v dj(tb) ] }
-      !!      Add this trend to the general tracer trend pta :
-      !!          pta = pta + difft
-      !!
-      !! ** Action  : - Update pta arrays with the before iso-level 
-      !!                harmonic mixing trend.
-      !!----------------------------------------------------------------------
-      USE oce, ONLY:   ztu => ua , ztv => va  ! (ua,va) used as workspace
-      !
-      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
-      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top levels
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
-      !
-      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
-      INTEGER  ::   iku, ikv, ierr       ! local integers
-      REAL(wp) ::   zabe1, zabe2, zbtr   ! local scalars
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 ) CALL timing_start('tra_ldf_lap')
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
-      ENDIF
-
-      !                                                          ! =========== !
-      DO jn = 1, kjpt                                            ! tracer loop !
-         !                                                       ! =========== !    
-         DO jk = 1, jpkm1                                            ! slab loop
-            !                                           
-            ! 1. First derivative (gradient)
-            ! -------------------
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
-                  zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
-                  ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
-                  ztv(ji,jj,jk) = zabe2 * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
-               END DO
-            END DO
-            IF( ln_zps ) THEN      ! set gradient at partial step level for the last ocean cell
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     ! last level
-                     iku = mbku(ji,jj)
-                     ikv = mbkv(ji,jj)
-                     IF( iku == jk ) THEN
-                        zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku)
-                        ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn)
-                     ENDIF
-                     IF( ikv == jk ) THEN
-                        zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv)
-                        ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn)
-                     ENDIF
-                  END DO
-               END DO
-            ENDIF
-            ! (ISH)
-            IF( ln_zps .AND. ln_isfcav ) THEN      ! set gradient at partial step level for the first ocean cell
-                                                   ! into a cavity
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     ! ice shelf level level MAX(2,jk) => only where ice shelf
-                     iku = miku(ji,jj) 
-                     ikv = mikv(ji,jj) 
-                     IF( iku == MAX(2,jk) ) THEN 
-                        zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku) 
-                        ztu(ji,jj,jk) = zabe1 * pgui(ji,jj,jn) 
-                     ENDIF 
-                     IF( ikv == MAX(2,jk) ) THEN 
-                        zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 
-                        ztv(ji,jj,jk) = zabe2 * pgvi(ji,jj,jn) 
-                     END IF 
-                  END DO
-               END DO
-            ENDIF
-         
-         
-            ! 2. Second derivative (divergence) added to the general tracer trends
-            ! ---------------------------------------------------------------------
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1._wp / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
-                  ! horizontal diffusive trends added to the general tracer trends
-                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
-                     &                                          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
-               END DO
-            END DO
-            !
-         END DO                                             !  End of slab  
-         !
-         ! "Poleward" diffusive heat or salt transports
-         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
-            IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( ztv(:,:,:) )
-            IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( ztv(:,:,:) )
-         ENDIF
-         !                                                  ! ==================
-      END DO                                                ! end of tracer loop
-      !                                                     ! ==================
-      IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_lap')
-      !
-   END SUBROUTINE tra_ldf_lap
-
-   !!==============================================================================
-END MODULE traldf_lap
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90	(revision 6808)
@@ -0,0 +1,253 @@
+MODULE traldf_lap_blp
+   !!==============================================================================
+   !!                       ***  MODULE  traldf_lap_blp  ***
+   !! Ocean tracers:  lateral diffusivity trend  (laplacian and bilaplacian)
+   !!==============================================================================
+   !! History :  3.7  ! 2014-01  (G. Madec, S. Masson)  Original code, re-entrant laplacian 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_lap   : tracer trend update with iso-level laplacian diffusive operator
+   !!   tra_ldf_blp   : tracer trend update with iso-level or iso-neutral bilaplacian operator
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE ldftra         ! lateral physics: eddy diffusivity
+   USE traldf_iso     ! iso-neutral lateral diffusion (standard operator)     (tra_ldf_iso   routine)
+   USE traldf_triad   ! iso-neutral lateral diffusion (triad    operator)     (tra_ldf_triad routine)
+   USE diaptr         ! poleward transport diagnostics
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE zpshde         ! partial step: hor. derivative     (zps_hde routine)
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! distribued memory computing library
+   USE timing         ! Timing
+   USE wrk_nemo       ! Memory allocation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf_lap   ! called by traldf.F90
+   PUBLIC   tra_ldf_blp   ! called by traldf.F90
+
+   !                      ! Flag to control the type of lateral diffusive operator
+   INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10   ! error in specification of lateral diffusion
+   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00   ! without operator (i.e. no lateral diffusive trend)
+   !                          !!      laplacian     !    bilaplacian    !
+   INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  ! iso-level operator
+   INTEGER, PARAMETER, PUBLIC ::   np_lap_i  = 11   ,   np_blp_i  = 21  ! standard iso-neutral or geopotential operator
+   INTEGER, PARAMETER, PUBLIC ::   np_lap_it = 12   ,   np_blp_it = 22  ! triad    iso-neutral or geopotential operator
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
+      &                                                    pgui, pgvi,   &
+      &                                        ptb , pta , kjpt, kpass ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_lap  ***
+      !!                   
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   Second order diffusive operator evaluated using before
+      !!      fields (forward time scheme). The horizontal diffusive trends of 
+      !!      the tracer is given by:
+      !!          difft = 1/(e1e2t*e3t) {  di-1[ pahu e2u*e3u/e1u di(tb) ]
+      !!                                 + dj-1[ pahv e1v*e3v/e2v dj(tb) ] }
+      !!      Add this trend to the general tracer trend pta :
+      !!          pta = pta + difft
+      !!
+      !! ** Action  : - Update pta arrays with the before iso-level 
+      !!                harmonic mixing trend.
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zsign            ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztu, ztv, zaheeu, zaheev
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('tra_ldf_lap')
+      !
+      IF( kt == nit000 .AND. lwp )  THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass
+         WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev ) 
+      !
+      !                                !==  Initialization of metric arrays used for all tracers  ==!
+      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
+      ELSE                    ;   zsign = -1._wp
+      ENDIF
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)   !!gm   * umask(ji,jj,jk) pah masked!
+               zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)   !!gm   * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      !                             ! =========== !
+      DO jn = 1, kjpt               ! tracer loop !
+         !                          ! =========== !    
+         !                               
+         DO jk = 1, jpkm1              !== First derivative (gradient)  ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1
+                  ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+            END DO
+         END DO  
+         IF( ln_zps ) THEN                ! set gradient at bottom/top ocean level
+            DO jj = 1, jpjm1                    ! bottom
+               DO ji = 1, fs_jpim1
+                  ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn)
+                  ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn)
+               END DO
+            END DO  
+            IF( ln_isfcav ) THEN                ! top in ocean cavities only
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 
+                     IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) 
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+         !
+         DO jk = 1, jpkm1              !== Second derivative (divergence) added to the general tracer trends  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     &
+                     &                                   + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   &
+                     &                                / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
+               END DO
+            END DO
+         END DO  
+         !
+         !                             !== "Poleward" diffusive heat or salt transports  ==!
+         IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR.  &     !==  first pass only (  laplacian)  ==!
+             ( kpass == 2 .AND.      ln_traldf_blp ) ) THEN      !==  2nd   pass only (bilaplacian)  ==!
+            IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+               IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( -ztv(:,:,:) )
+               IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( -ztv(:,:,:) )
+            ENDIF
+         ENDIF
+         !                          ! ==================
+      END DO                        ! end of tracer loop
+      !                             ! ==================
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_lap')
+      !
+   END SUBROUTINE tra_ldf_lap
+   
+
+   SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
+      &                                                    pgui, pgvi,   &
+      &                                                    ptb , pta , kjpt, kldf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tra_ldf_blp  ***
+      !!                    
+      !! ** Purpose :   Compute the before lateral tracer diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The lateral diffusive trends is provided by a bilaplacian
+      !!      operator applied to before field (forward in time).
+      !!      It is computed by two successive calls to laplacian routine
+      !!
+      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kldf       ! type of operator used
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
+      !
+      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlap         ! laplacian at t-point
+      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points)
+      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points)
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_blp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,kjpt,   zlap ) 
+      CALL wrk_alloc( jpi,jpj,    kjpt,   zglu, zglv, zgui, zgvi ) 
+      !
+      IF( kt == kit000 .AND. lwp )  THEN
+         WRITE(numout,*)
+         SELECT CASE ( kldf )
+         CASE ( np_blp    )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-level   bilaplacian operator on ', cdtype
+         CASE ( np_blp_i  )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (Standard)'
+         CASE ( np_blp_it )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (triad)'
+         END SELECT
+         WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      zlap(:,:,:,:) = 0._wp
+      !
+      SELECT CASE ( kldf )       !==  1st laplacian applied to ptb (output in zlap)  ==!
+      !
+      CASE ( np_blp    )               ! iso-level bilaplacian
+         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb,      zlap, kjpt, 1 )
+      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec)
+         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
+      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies)
+         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
+      END SELECT
+      !
+      DO jn = 1, kjpt
+         CALL lbc_lnk( zlap(:,:,:,jn) , 'T', 1. )     ! Lateral boundary conditions (unchanged sign)
+      END DO
+      !                                               ! Partial top/bottom cell: GRADh( zlap )  
+      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom
+      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, kjpt, zlap, zglu, zglv )              ! only bottom 
+      ENDIF
+      !
+      SELECT CASE ( kldf )       !==  2nd laplacian applied to zlap (output in pta)  ==!
+      !
+      CASE ( np_blp    )               ! iso-level bilaplacian
+         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta,      kjpt, 2 )
+      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec)
+         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
+      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies)
+         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,kjpt,   zlap ) 
+      CALL wrk_dealloc( jpi,jpj    ,kjpt,   zglu, zglv, zgui, zgvi ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_blp')
+      !
+   END SUBROUTINE tra_ldf_blp
+
+   !!==============================================================================
+END MODULE traldf_lap_blp
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90	(revision 6808)
@@ -0,0 +1,467 @@
+MODULE traldf_triad
+   !!======================================================================
+   !!                   ***  MODULE  traldf_triad  ***
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!======================================================================
+   !! History :  3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)  Griffies operator (original code)
+   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_triad : update the tracer trend with the iso-neutral laplacian triad-operator
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE zdf_oce        ! ocean vertical physics
+   USE ldftra         ! lateral physics: eddy diffusivity
+   USE ldfslp         ! lateral physics: iso-neutral slopes
+   USE traldf_iso     ! lateral diffusion (Madec operator)         (tra_ldf_iso routine)
+   USE diaptr         ! poleward transport diagnostics
+   USE zpshde         ! partial step: hor. derivative     (zps_hde routine)
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf_triad   ! routine called by traldf.F90
+
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt3d   !: vertical tracer gradient at 2 levels
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+  SUBROUTINE tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
+      &                                                     pgui, pgvi,   &
+      &                                         ptb , ptbb, pta , kjpt, kpass )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_triad  ***
+      !!
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive
+      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and
+      !!      add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The horizontal component of the lateral diffusive trends
+      !!      is provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      see documentation for the desciption
+      !!
+      !! ** Action :   pta   updated with the before rotated diffusion
+      !!               ah_wslp2 ....
+      !!               akz   stabilizing vertical diffusivity coefficient (used in trazdf_imp)
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu , pgv  ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
+      !
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::  ip,jp,kp         ! dummy loop indices
+      INTEGER  ::  ierr            ! local integer
+      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3          ! local scalars
+      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4          !   -      -
+      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt  !   -      -
+      !
+      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv
+      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt
+      REAL(wp) ::   zah, zah_slp, zaei_slp
+#if defined key_diaar5
+      REAL(wp) ::   zztmp              ! local scalar
+#endif
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d                                            ! 2D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_triad')
+      !
+      CALL wrk_alloc( jpi,jpj,       z2d ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  ) 
+      !
+      IF( .NOT.ALLOCATED(zdkt3d) )  THEN
+         ALLOCATE( zdkt3d(jpi,jpj,0:1) , STAT=ierr )
+         IF( lk_mpp   )   CALL mpp_sum ( ierr )
+         IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_triad: unable to allocate arrays')
+      ENDIF
+     !
+      IF( kpass == 1 .AND. kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_triad : rotated laplacian diffusion operator on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+      !                                               ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == kit000 ) THEN   ;   z2dt =     rdt      ! at nit000   (Euler)
+      ELSE                                        ;   z2dt = 2.* rdt      !             (Leapfrog)
+      ENDIF
+      z1_2dt = 1._wp / z2dt
+      !
+      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
+      ELSE                    ;   zsign = -1._wp
+      ENDIF
+      !    
+      !!----------------------------------------------------------------------
+      !!   0 - calculate  ah_wslp2, akz, and optionally zpsi_uw, zpsi_vw
+      !!----------------------------------------------------------------------
+      !
+      IF( kpass == 1 ) THEN         !==  first pass only  and whatever the tracer is  ==!
+         !
+         akz     (:,:,:) = 0._wp      
+         ah_wslp2(:,:,:) = 0._wp
+         IF( ln_ldfeiv_dia ) THEN
+            zpsi_uw(:,:,:) = 0._wp
+            zpsi_vw(:,:,:) = 0._wp
+         ENDIF
+         !
+         DO ip = 0, 1                            ! i-k triads
+            DO kp = 0, 1
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp)
+                        zbu   = e1e2u(ji,jj) * e3u_n(ji,jj,jk)
+                        zah   = 0.25_wp * pahu(ji,jj,jk)
+                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                        ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth)
+                        zslope2 = zslope_skew + ( gdept_n(ji+1,jj,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)
+                        zslope2 = zslope2 *zslope2
+                        ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2
+                        akz     (ji+ip,jj,jk+kp) = akz     (ji+ip,jj,jk+kp) + zah * r1_e1u(ji,jj)       &
+                           &                                                      * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)
+                           !
+                       IF( ln_ldfeiv_dia )   zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp)   &
+                           &                                       + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * zslope_skew
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         DO jp = 0, 1                            ! j-k triads 
+            DO kp = 0, 1
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze3wr = 1.0_wp / e3w_n(ji,jj+jp,jk+kp)
+                        zbv   = e1e2v(ji,jj) * e3v_n(ji,jj,jk)
+                        zah   = 0.25_wp * pahv(ji,jj,jk)
+                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                        ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
+                        !    (do this by *adding* gradient of depth)
+                        zslope2 = zslope_skew + ( gdept_n(ji,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)
+                        zslope2 = zslope2 * zslope2
+                        ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2
+                        akz     (ji,jj+jp,jk+kp) = akz     (ji,jj+jp,jk+kp) + zah * r1_e2v(ji,jj)     &
+                           &                                                      * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)
+                        !
+                        IF( ln_ldfeiv_dia )   zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp)   &
+                           &                                       + 0.25 * aeiv(ji,jj,jk) * e1v(ji,jj) * zslope_skew
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient
+            !
+            IF( ln_traldf_blp ) THEN                ! bilaplacian operator
+               DO jk = 2, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   &
+                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) )  )
+                     END DO
+                  END DO
+               END DO
+            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator
+               DO jk = 2, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk)
+                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
+                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt
+                     END DO
+                  END DO
+               END DO
+           ENDIF
+           !
+         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit
+            akz(:,:,:) = ah_wslp2(:,:,:)      
+         ENDIF
+         !
+         IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw )
+         !
+      ENDIF                                  !==  end 1st pass only  ==!
+      !
+      !                                                           ! ===========
+      DO jn = 1, kjpt                                             ! tracer loop
+         !                                                        ! ===========
+         ! Zero fluxes for each tracer
+!!gm  this should probably be done outside the jn loop
+         ztfw(:,:,:) = 0._wp
+         zftu(:,:,:) = 0._wp
+         zftv(:,:,:) = 0._wp
+         !
+         DO jk = 1, jpkm1        !==  before lateral T & S gradients at T-level jk  ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_zps .AND. l_grad_zps ) THEN    ! partial steps: correction at top/bottom ocean level
+            DO jj = 1, jpjm1                       ! bottom level
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
+                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
+               END DO
+            END DO
+            IF( ln_isfcav ) THEN                   ! top level (ocean cavities only)
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 
+                     IF( mikv(ji,jj)  > 1 )   zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn) 
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+         !
+         !!----------------------------------------------------------------------
+         !!   II - horizontal trend  (full)
+         !!----------------------------------------------------------------------
+         !
+         DO jk = 1, jpkm1
+            !                    !==  Vertical tracer gradient at level jk and jk+1
+            zdkt3d(:,:,1) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
+            !
+            !                    ! surface boundary condition: zdkt3d(jk=0)=zdkt3d(jk=1)
+            IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1)
+            ELSE                 ;   zdkt3d(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk)
+            ENDIF
+            !
+            zaei_slp = 0._wp
+            !
+            IF( ln_botmix_triad ) THEN
+               DO ip = 0, 1              !==  Horizontal & vertical fluxes
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze1ur = r1_e1u(ji,jj)
+                           zdxt  = zdit(ji,jj,jk) * ze1ur
+                           ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp)
+                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
+                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                           zslope_iso  = triadi  (ji+ip,jj,jk,1-ip,kp)
+                           !
+                           zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk)
+                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked....
+                           zah = pahu(ji,jj,jk)
+                           zah_slp  = zah * zslope_iso
+                           IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew
+                           zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
+                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - ( zah_slp + zaei_slp) * zdxt                 * zbu * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+               !
+               DO jp = 0, 1
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze2vr = r1_e2v(ji,jj)
+                           zdyt  = zdjt(ji,jj,jk) * ze2vr
+                           ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp)
+                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
+                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
+                           zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk)
+                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????  ahv is masked...
+                           zah = pahv(ji,jj,jk)
+                           zah_slp = zah * zslope_iso
+                           IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew
+                           zftv(ji,jj   ,jk   ) = zftv(ji,jj   ,jk   ) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
+                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - ( zah_slp + zaei_slp ) * zdyt                * zbv * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+               !
+            ELSE
+               !
+               DO ip = 0, 1               !==  Horizontal & vertical fluxes
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze1ur = r1_e1u(ji,jj)
+                           zdxt  = zdit(ji,jj,jk) * ze1ur
+                           ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp)
+                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
+                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                           zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp)
+                           !
+                           zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk)
+                           ! ln_botmix_triad is .F. mask zah for bottom half cells
+                           zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ????
+                           zah_slp  = zah * zslope_iso
+                           IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew        ! aeit(ji+ip,jj,jk)*zslope_skew
+                           zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
+                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+               !
+               DO jp = 0, 1
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze2vr = r1_e2v(ji,jj)
+                           zdyt  = zdjt(ji,jj,jk) * ze2vr
+                           ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp)
+                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
+                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
+                           zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk)
+                           ! ln_botmix_triad is .F. mask zah for bottom half cells
+                           zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ????
+                           zah_slp = zah * zslope_iso
+                           IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew        ! aeit(ji,jj+jp,jk)*zslope_skew
+                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
+                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+            !                             !==  horizontal divergence and add to the general trend  ==!
+            DO jj = 2 , jpjm1
+               DO ji = fs_2, fs_jpim1  ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji-1,jj,jk) - zftu(ji,jj,jk)       &
+                     &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )   &
+                     &                                        / (  e1e2t(ji,jj) * e3t_n(ji,jj,jk)  )
+               END DO
+            END DO
+            !
+         END DO
+         !
+         !                                !==  add the vertical 33 flux  ==!
+         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
+            DO jk = 2, jpkm1       
+               DO jj = 1, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)   &
+                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             &
+                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
+                  END DO
+               END DO
+            END DO
+         ELSE                                   ! bilaplacian 
+            SELECT CASE( kpass )
+            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2
+               DO jk = 2, jpkm1 
+                  DO jj = 1, jpjm1
+                     DO ji = fs_2, fs_jpim1
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)             &
+                           &                            * ah_wslp2(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
+                     END DO
+                  END DO
+               END DO 
+            CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp.
+               DO jk = 2, jpkm1 
+                  DO jj = 1, jpjm1
+                     DO ji = fs_2, fs_jpim1
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)                      &
+                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   &
+                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   )
+                     END DO
+                  END DO
+               END DO
+            END SELECT 
+         ENDIF
+         !
+         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1  ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   &
+                     &                                        / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         !
+         IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==!
+             ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==!
+            !
+            !                          ! "Poleward" diffusive heat or salt transports (T-S case only)
+            IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+               IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names
+               IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) )
+            ENDIF
+            !
+            IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
+              !
+              IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
+                  z2d(:,:) = zftu(ji,jj,1) 
+                  DO jk = 2, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
+                        END DO
+                     END DO
+                  END DO
+                  z2d(:,:) = rau0_rcp * z2d(:,:) 
+                  CALL lbc_lnk( z2d, 'U', -1. )
+                  CALL iom_put( "udiff_heattr", z2d )                  ! heat i-transport
+                  !
+                  z2d(:,:) = zftv(ji,jj,1) 
+                  DO jk = 2, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
+                        END DO
+                     END DO
+                  END DO
+                  z2d(:,:) = rau0_rcp * z2d(:,:)     
+                  CALL lbc_lnk( z2d, 'V', -1. )
+                  CALL iom_put( "vdiff_heattr", z2d )                  !  heat j-transport
+               ENDIF
+               !
+            ENDIF
+            !
+         ENDIF                                                    !== end pass selection  ==!
+         !
+         !                                                        ! ===============
+      END DO                                                      ! end tracer loop
+      !                                                           ! ===============
+      !
+      CALL wrk_dealloc( jpi,jpj,       z2d ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_triad')
+      !
+   END SUBROUTINE tra_ldf_triad
+
+   !!==============================================================================
+END MODULE traldf_triad
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 6808)
@@ -13,19 +13,19 @@
 
    !!----------------------------------------------------------------------
-   !!   tra_npc : apply the non penetrative convection scheme
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE zdf_oce         ! ocean vertical physics
-   USE trd_oce         ! ocean active tracer trends
-   USE trdtra          ! ocean active tracer trends
-   USE eosbn2          ! equation of state (eos routine)
+   !!   tra_npc       : apply the non penetrative convection scheme
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE zdf_oce        ! ocean vertical physics
+   USE trd_oce        ! ocean active tracer trends
+   USE trdtra         ! ocean active tracer trends
+   USE eosbn2         ! equation of state (eos routine)
    !
-   USE lbclnk          ! lateral boundary conditions (or mpp link)
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   USE lbclnk         ! lateral boundary conditions (or mpp link)
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -35,5 +35,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -55,5 +54,5 @@
       !!              (i.e. static stability computed locally)
       !!
-      !! ** Action  : - (ta,sa) after the application od the npc scheme
+      !! ** Action  : - tsa: after tracers with the application of the npc scheme
       !!              - send the associated trends for on-line diagnostics (l_trdtra=T)
       !!
@@ -115,9 +114,9 @@
                   zvts(:,jp_tem) = tsa(ji,jj,:,jp_tem)      ! temperature
                   zvts(:,jp_sal) = tsa(ji,jj,:,jp_sal)      ! salinity
-
+                  !
                   zvab(:,jp_tem)  = zab(ji,jj,:,jp_tem)     ! Alpha 
                   zvab(:,jp_sal)  = zab(ji,jj,:,jp_sal)     ! Beta  
                   zvn2(:)         = zn2(ji,jj,:)            ! N^2 
-                 
+                  !
                   IF( l_LB_debug ) THEN                  !LB debug:
                      lp_monitor_point = .FALSE.
@@ -126,5 +125,5 @@
                      lp_monitor_point = (narea == nncpu).AND.lp_monitor_point                      
                   ENDIF                                  !LB debug  end
-
+                  !
                   ikbot = mbkt(ji,jj)   ! ikbot: ocean bottom T-level
                   ikp = 1                  ! because N2 is irrelevant at the surface level (will start at ikp=2)
@@ -132,23 +131,23 @@
                   jiter  = 0
                   l_column_treated = .FALSE.
-                 
+                  !
                   DO WHILE ( .NOT. l_column_treated )
                      !
                      jiter = jiter + 1
-                    
+                     ! 
                      IF( jiter >= 400 ) EXIT
-                    
+                     !
                      l_bottom_reached = .FALSE.
-
+                     !
                      DO WHILE ( .NOT. l_bottom_reached )
-
+                        !
                         ikp = ikp + 1
-                       
+                        !
                         !! Testing level ikp for instability
                         !! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                         IF( zvn2(ikp) <  -zn2_zero ) THEN ! Instability found!
-
+                           !
                            ilayer = ilayer + 1    ! yet another instable portion of the water column found....
-
+                           !
                            IF( lp_monitor_point ) THEN 
                               WRITE(numout,*)
@@ -165,13 +164,12 @@
                               WRITE(numout,*)
                            ENDIF
-                           
-
+                           !
                            IF( jiter == 1 )   inpcc = inpcc + 1 
-
+                           !
                            IF( lp_monitor_point )   WRITE(numout, *) 'Negative N2 at ikp =',ikp,' for layer #', ilayer
-
+                           !
                            !! ikup is the uppermost point where mixing will start:
                            ikup = ikp - 1 ! ikup is always "at most at ikp-1", less if neutral levels overlying
-                           
+                           !
                            !! If the points above ikp-1 have N2 == 0 they must also be mixed:
                            IF( ikp > 2 ) THEN
@@ -184,7 +182,7 @@
                               END DO
                            ENDIF
-                           
+                           !
                            IF( ikup < 1 )   CALL ctl_stop( 'tra_npc :  PROBLEM #1')
-
+                           !
                            zsum_temp = 0._wp
                            zsum_sali = 0._wp
@@ -195,5 +193,5 @@
                            DO jk = ikup, ikbot      ! Inside the instable (and overlying neutral) portion of the column
                               !
-                              zdz       = fse3t(ji,jj,jk)
+                              zdz       = e3t_n(ji,jj,jk)
                               zsum_temp = zsum_temp + zvts(jk,jp_tem)*zdz
                               zsum_sali = zsum_sali + zvts(jk,jp_sal)*zdz
@@ -244,6 +242,6 @@
 
                               !! Interpolating alfa and beta at W point:
-                              zrw =  (fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk)) &
-                                 & / (fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk))
+                              zrw =  (gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk)) &
+                                 & / (gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk))
                               zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw
                               zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw
@@ -252,5 +250,5 @@
                               zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     &
                                  &            - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )  &
-                                 &       / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                                 &       / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
 
                               !! OR, faster  => just considering the vertical gradient of density
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 6808)
@@ -28,13 +28,13 @@
    USE sbc_oce         ! surface boundary condition: ocean
    USE sbcrnf          ! river runoffs
+   USE sbcisf          ! ice shelf melting
    USE zdf_oce         ! ocean vertical mixing
    USE domvvl          ! variable volume
-   USE dynspg_oce      ! surface     pressure gradient variables
-   USE dynhpg          ! hydrostatic pressure gradient 
    USE trd_oce         ! trends: ocean variables
    USE trdtra          ! trends manager: tracers 
    USE traqsr          ! penetrative solar radiation (needed for nksr)
    USE phycst          ! physical constant
-   USE ldftra_oce      ! lateral physics on tracers
+   USE ldftra          ! lateral physics on tracers
+   USE ldfslp
    USE bdy_oce         ! BDY open boundary condition variables
    USE bdytra          ! open boundary condition (bdy_tra routine)
@@ -46,5 +46,4 @@
    USE timing          ! Timing
 #if defined key_agrif
-   USE agrif_opa_update
    USE agrif_opa_interp
 #endif
@@ -57,8 +56,6 @@
    PUBLIC   tra_nxt_vvl   ! to be used in trcnxt
 
-   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg
-
    !! * Substitutions
-#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO-Consortium (2010) 
@@ -88,11 +85,10 @@
       !!             domains (lk_agrif=T)
       !!
-      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
-      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
+      !! ** Action  : - tsb & tsn ready for the next time step
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
       !!
-      INTEGER  ::   jk, jn    ! dummy loop indices
-      REAL(wp) ::   zfact     ! local scalars
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zfact            ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
@@ -104,10 +100,12 @@
          IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
          IF(lwp) WRITE(numout,*) '~~~~~~~'
-         !
-         rbcp = 0.25_wp * (1._wp + atfp) * (1._wp + atfp) * ( 1._wp - atfp)      ! Brown & Campana parameter for semi-implicit hpg
       ENDIF
 
       ! Update after tracer on domain lateral boundaries
       ! 
+#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 )
@@ -116,11 +114,8 @@
       IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
 #endif
-#if defined key_agrif
-      CALL Agrif_tra                     ! AGRIF zoom boundaries
-#endif
  
       ! set time step size (Euler/Leapfrog)
-      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler)
-      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2._wp* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
+      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =     rdt      ! at nit000             (Euler)
+      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp* rdt   ! at nit000 or nit000+1 (Leapfrog)
       ENDIF
 
@@ -142,21 +137,22 @@
             END DO
          END DO
+         !
       ELSE                                            ! Leap-Frog + Asselin filter time stepping
          !
-         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa,   &
-           &                                                              sbc_tsc, sbc_tsc_b, jpts )  ! variable volume level (vvl) 
-         ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level 
+         IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nit000,      'TRA', tsb, tsn, tsa, jpts )  ! linear free surface 
+         ELSE                   ;   CALL tra_nxt_vvl( kt, nit000, rdt, 'TRA', tsb, tsn, tsa,   &
+           &                                                                sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
          ENDIF
-      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
+         !
+         DO jn = 1, jpts
+            CALL lbc_lnk( tsb(:,:,:,jn), 'T', 1._wp ) 
+            CALL lbc_lnk( tsn(:,:,:,jn), 'T', 1._wp )
+            CALL lbc_lnk( tsa(:,:,:,jn), 'T', 1._wp )
+         END DO
+      ENDIF     
+      !
       IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
          DO jk = 1, jpkm1
-            zfact = 1._wp / r2dtra(jk)             
+            zfact = 1._wp / r2dt             
             ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
             ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
@@ -184,32 +180,20 @@
       !! 
       !! ** Method  : - Apply a Asselin time filter on now fields.
-      !!              - save in (ta,sa) an average over the three time levels 
-      !!             which will be used to compute rdn and thus the semi-implicit
-      !!             hydrostatic pressure gradient (ln_dynhpg_imp = T)
       !!              - swap tracer fields to prepare the next time_step.
-      !!                This can be summurized for tempearture as:
-      !!             ztm = tn + rbcp * [ta -2 tn + tb ]       ln_dynhpg_imp = T
-      !!             ztm = 0                                   otherwise
-      !!                   with rbcp=1/4 * (1-atfp^4) / (1-atfp)
-      !!             tb  = tn + atfp*[ tb - 2 tn + ta ]
-      !!             tn  = ta  
-      !!             ta  = ztm       (NB: reset to 0 after eos_bn2 call)
-      !!
-      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
-      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
-      !!----------------------------------------------------------------------
-      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
-      INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index
-      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
-      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
+      !!
+      !! ** Action  : - tsb & tsn ready for the next time step
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      LOGICAL  ::   ll_tra_hpg       ! local logical
       REAL(wp) ::   ztn, ztd         ! local scalars
       !!----------------------------------------------------------------------
-
+      !
       IF( kt == kit000 )  THEN
          IF(lwp) WRITE(numout,*)
@@ -218,20 +202,14 @@
       ENDIF
       !
-      IF( cdtype == 'TRA' )  THEN   ;   ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg    
-      ELSE                          ;   ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
-      ENDIF
-      !
       DO jn = 1, kjpt
          !
          DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
                   ztn = ptn(ji,jj,jk,jn)                                    
-                  ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
-                  !
-                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                       ! ptb <-- filtered ptn 
-                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                       ! ptn <-- pta
-                  !
-                  IF( ll_tra_hpg )   pta(ji,jj,jk,jn) = ztn + rbcp * ztd    ! pta <-- Brown & Campana average
+                  ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn)  ! time laplacian on tracers
+                  !
+                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                      ! ptb <-- filtered ptn 
+                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                      ! ptn <-- pta
                END DO
            END DO
@@ -251,33 +229,23 @@
       !! 
       !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
-      !!              - save in (ta,sa) a thickness weighted average over the three 
-      !!             time levels which will be used to compute rdn and thus the semi-
-      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
       !!              - swap tracer fields to prepare the next time_step.
-      !!                This can be summurized for tempearture as:
-      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
-      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
-      !!             ztm = 0                                                       otherwise
       !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
       !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
       !!             tn  = ta 
-      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
-      !!
-      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
-      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
-      !!----------------------------------------------------------------------
-      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index
-      INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index
-      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step
-      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator)
-      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend
-      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content
-      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content
-
-      !!     
-      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf   ! local logical
+      !!
+      !! ** Action  : - tsb & tsn ready for the next time step
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
+      REAL(wp)                             , INTENT(in   ) ::  p2dt      ! time-step
+      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc   ! surface tracer content
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc_b ! before surface tracer content
+      !
+      LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! 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
@@ -292,22 +260,22 @@
       !
       IF( cdtype == 'TRA' )  THEN   
-         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg
          ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
          ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
-      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     = ln_isf           ! active  tracers case  and  ice shelf melting
+      ELSE                          ! passive tracers case
+         ll_traqsr  = .FALSE.          ! NO solar penetration
+         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ?  
+         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ?? 
       ENDIF
       !
       DO jn = 1, kjpt      
          DO jk = 1, jpkm1
-            zfact1 = atfp * p2dt(jk)
-            zfact2 = zfact1 / rau0
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ze3t_b = fse3t_b(ji,jj,jk)
-                  ze3t_n = fse3t_n(ji,jj,jk)
-                  ze3t_a = fse3t_a(ji,jj,jk)
+            zfact1 = atfp * p2dt
+            zfact2 = zfact1 * r1_rau0
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  ze3t_b = e3t_b(ji,jj,jk)
+                  ze3t_n = e3t_n(ji,jj,jk)
+                  ze3t_a = e3t_a(ji,jj,jk)
                   !                                         ! tracer content at Before, now and after
                   ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
@@ -321,24 +289,36 @@
                   ztc_f  = ztc_n  + atfp * ztc_d
                   !
-                  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) )
+                  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))  )
                      ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
                   ENDIF
-
-                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only)
+                  !
+                  ! solar penetration (temperature only)
+                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
                      &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
-
-                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )   & 		      ! river runoffs
+                     !
+                  ! river runoff
+                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
                      &     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)
-
+                     &                              * e3t_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) )  &
+                               &                 * e3t_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) )  &
+                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
+                  END IF
+                  !
                   ze3t_f = 1.e0 / ze3t_f
                   ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
                   ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
                   !
-                  IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
-                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
-                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
-                  ENDIF
                END DO
             END DO
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 6808)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                       ***  MODULE  traqsr  ***
-   !! Ocean physics: solar radiation penetration in the top ocean levels
+   !! Ocean physics:   solar radiation penetration in the top ocean levels
    !!======================================================================
    !! History :  OPA  !  1990-10  (B. Blanke)  Original code
@@ -10,24 +10,27 @@
    !!             -   !  2005-11  (G. Madec) zco, zps, sco coordinate
    !!            3.2  !  2009-04  (G. Madec & NEMO team) 
-   !!            4.0  !  2012-05  (C. Rousset) store attenuation coef for use in ice model 
+   !!            3.6  !  2012-05  (C. Rousset) store attenuation coef for use in ice model 
+   !!            3.7  !  2015-11  (G. Madec, A. Coward)  remove optimisation for fix volume 
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   tra_qsr      : trend due to the solar radiation penetration
-   !!   tra_qsr_init : solar radiation penetration initialization
+   !!   tra_qsr       : temperature trend due to the penetration of solar radiation 
+   !!   tra_qsr_init  : initialization of the qsr penetration 
    !!----------------------------------------------------------------------
-   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 oce            ! ocean dynamics and active tracers
+   USE phycst         ! physical constants
+   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         ! trends manager: tracers
-   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
-   USE restart         ! ocean restart
-   USE lib_mpp         ! MPP library
+   !
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE iom            ! I/O manager
+   USE fldread        ! read input fields
+   USE restart        ! ocean restart
+   USE lib_mpp        ! MPP library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
@@ -49,14 +52,20 @@
    REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands)
    REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands)
+   !
+   INTEGER , PUBLIC ::   nksr         !: levels below which the light cannot penetrate (depth larger than 391 m)
  
-   ! Module variables
-   REAL(wp) ::   xsi0r                           !: inverse of rn_si0
-   REAL(wp) ::   xsi1r                           !: inverse of rn_si1
+   INTEGER, PARAMETER ::   np_RGB  = 1   ! R-G-B     light penetration with constant Chlorophyll
+   INTEGER, PARAMETER ::   np_RGBc = 2   ! R-G-B     light penetration with Chlorophyll data
+   INTEGER, PARAMETER ::   np_2BD  = 3   ! 2 bands   light penetration
+   INTEGER, PARAMETER ::   np_BIO  = 4   ! bio-model light penetration
+   !
+   INTEGER  ::   nqsr    ! user choice of the type of light penetration
+   REAL(wp) ::   xsi0r   ! inverse of rn_si0
+   REAL(wp) ::   xsi1r   ! inverse of rn_si1
+   !
+   REAL(wp) , DIMENSION(3,61)           ::   rkrgb    ! tabulated attenuation coefficients for RGB absorption
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (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
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -72,5 +81,5 @@
       !!
       !! ** Purpose :   Compute the temperature trend due to the solar radiation
-      !!      penetration and add it to the general temperature trend.
+      !!              penetration and add it to the general temperature trend.
       !!
       !! ** Method  : The profile of the solar radiation within the ocean is defined
@@ -83,32 +92,27 @@
       !!      all heat which has not been absorbed in the above levels is put
       !!      in the last ocean level.
-      !!         In z-coordinate case, the computation is only done down to the
-      !!      level where I(k) < 1.e-15 W/m2. In addition, the coefficients 
-      !!      used for the computation are calculated one for once as they
-      !!      depends on k only.
+      !!         The computation is only done down to the level where 
+      !!      I(k) < 1.e-15 W/m2 (i.e. over the top nksr levels) . 
       !!
       !! ** Action  : - update ta with the penetrative solar radiation trend
-      !!              - save the trend in ttrd ('key_trdtra')
+      !!              - send  trend for further diagnostics (l_trdtra=T)
       !!
       !! Reference  : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
       !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
       !!----------------------------------------------------------------------
-      !
       INTEGER, INTENT(in) ::   kt     ! ocean time-step
       !
-      INTEGER  ::   ji, jj, jk           ! dummy loop indices
-      INTEGER  ::   irgb                 ! local integers
-      REAL(wp) ::   zchl, zcoef, zfact   ! local scalars
-      REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         -
+      INTEGER  ::   ji, jj, jk               ! dummy loop indices
+      INTEGER  ::   irgb                     ! local integers
+      REAL(wp) ::   zchl, zcoef, z1_2        ! local scalars
+      REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         -
       REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         -
-      REAL(wp) ::   zz0, zz1, z1_e3t     !    -         -
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr
+      REAL(wp) ::   zz0 , zz1                !    -         -
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zekb, zekg, zekr
       REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zetot
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('tra_qsr')
-      !
-      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        ) 
-      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
       !
       IF( kt == nit000 ) THEN
@@ -116,228 +120,168 @@
          IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation'
          IF(lwp) WRITE(numout,*) '~~~~~~~'
-         IF( .NOT.ln_traqsr )   RETURN
-      ENDIF
-
-      IF( l_trdtra ) THEN      ! Save ta and sa trends
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdt ) 
+      ENDIF
+      !
+      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt ) 
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
       ENDIF
-
-      !                                        Set before qsr tracer content field
-      !                                        ***********************************
-      IF( kt == nit000 ) THEN                     ! Set the forcing field at nit000 - 1
-         !                                        ! -----------------------------------
-         qsr_hc(:,:,:) = 0.e0
-         !
-         IF( ln_rstart .AND.    &                    ! Restart: read in restart file
-              & iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN
-            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field red in the restart file'
-            zfact = 0.5e0
+      !
+      !                         !-----------------------------------!
+      !                         !  before qsr induced heat content  !
+      !                         !-----------------------------------!
+      IF( kt == nit000 ) THEN          !==  1st time step  ==!
+!!gm case neuler  not taken into account....
+         IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN    ! read in restart
+            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file'
+            z1_2 = 0.5_wp
             CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux
          ELSE                                           ! No restart or restart not found: Euler forward time stepping
-            zfact = 1.e0
-            qsr_hc_b(:,:,:) = 0.e0
+            z1_2 = 1._wp
+            qsr_hc_b(:,:,:) = 0._wp
          ENDIF
-      ELSE                                        ! Swap of forcing field
-         !                                        ! ---------------------
-         zfact = 0.5e0
+      ELSE                             !==  Swap of qsr heat content  ==!
+         z1_2 = 0.5_wp
          qsr_hc_b(:,:,:) = qsr_hc(:,:,:)
       ENDIF
-      !                                        Compute now qsr tracer content field
-      !                                        ************************************
-      
-      !                                           ! ============================================== !
-      IF( lk_qsr_bio .AND. ln_qsr_bio ) THEN      !  bio-model fluxes  : all vertical coordinates  !
-         !                                        ! ============================================== !
-         DO jk = 1, jpkm1
+      !
+      !                         !--------------------------------!
+      SELECT CASE( nqsr )       !  now qsr induced heat content  !
+      !                         !--------------------------------!
+      !
+      CASE( np_BIO )                   !==  bio-model fluxes  ==!
+         !
+         DO jk = 1, nksr
             qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
          END DO
-         !                                        Add to the general trend
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z1_e3t = zfact / fse3t(ji,jj,jk)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t
+         !
+      CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==!
+         !
+         CALL wrk_alloc( jpi,jpj,       zekb, zekg, zekr        ) 
+         CALL wrk_alloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea ) 
+         !
+         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll
+            CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step
+            DO jj = 2, jpjm1                       ! Separation in R-G-B depending of the surface Chl
+               DO ji = fs_2, fs_jpim1
+                  zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) )
+                  irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
+                  zekb(ji,jj) = rkrgb(1,irgb)
+                  zekg(ji,jj) = rkrgb(2,irgb)
+                  zekr(ji,jj) = rkrgb(3,irgb)
                END DO
             END DO
-         END DO
-         CALL iom_put( 'qsr3d', etot3 )   ! Shortwave Radiation 3D distribution
-         ! clem: store attenuation coefficient of the first ocean level
-         IF ( ln_qsr_ice ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF ( qsr(ji,jj) /= 0._wp ) THEN
-                     fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) )
-                  ELSE
-                     fraqsr_1lev(ji,jj) = 1.
-                  ENDIF
+         ELSE                                !* constant chrlorophyll
+            zchl = 0.05                            ! constant chlorophyll
+            !                                      ! Separation in R-G-B depending of the chlorophyll
+            irgb = NINT( 41 + 20.*LOG10( zchl ) + 1.e-15 )
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zekb(ji,jj) = rkrgb(1,irgb)                      
+                  zekg(ji,jj) = rkrgb(2,irgb)
+                  zekr(ji,jj) = rkrgb(3,irgb)
                END DO
             END DO
          ENDIF
-         !                                        ! ============================================== !
-      ELSE                                        !  Ocean alone : 
-         !                                        ! ============================================== !
-         !
-         !                                                ! ------------------------- !
-         IF( ln_qsr_rgb) THEN                             !  R-G-B  light penetration !
-            !                                             ! ------------------------- !
-            ! Set chlorophyl concentration
-            IF( nn_chldta == 1 .OR. lk_vvl ) THEN            !*  Variable Chlorophyll or ocean volume
-               !
-               IF( nn_chldta == 1 ) THEN                             !*  Variable Chlorophyll
-                  !
-                  CALL fld_read( kt, 1, sf_chl )                         ! Read Chl data and provides it at the current time step
-                  !         
-!CDIR COLLAPSE
-!CDIR NOVERRCHK
-                  DO jj = 1, jpj                                         ! Separation in R-G-B depending of the surface Chl
-!CDIR NOVERRCHK
-                     DO ji = 1, jpi
-                        zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) )
-                        irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
-                        zekb(ji,jj) = rkrgb(1,irgb)
-                        zekg(ji,jj) = rkrgb(2,irgb)
-                        zekr(ji,jj) = rkrgb(3,irgb)
-                     END DO
-                  END DO
-               ELSE                                            ! Variable ocean volume but constant chrlorophyll
-                  zchl = 0.05                                     ! constant chlorophyll
-                  irgb = NINT( 41 + 20.*LOG10( zchl ) + 1.e-15 )
-                  zekb(:,:) = rkrgb(1,irgb)                       ! Separation in R-G-B depending of the chlorophyll 
-                  zekg(:,:) = rkrgb(2,irgb)
-                  zekr(:,:) = rkrgb(3,irgb)
+         !
+         zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               ze0(ji,jj,1) = rn_abs * qsr(ji,jj)
+               ze1(ji,jj,1) = zcoef  * qsr(ji,jj)
+               ze2(ji,jj,1) = zcoef  * qsr(ji,jj)
+               ze3(ji,jj,1) = zcoef  * qsr(ji,jj)
+               zea(ji,jj,1) =          qsr(ji,jj)
+            END DO
+         END DO
+         !
+         DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * xsi0r       )
+                  zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekb(ji,jj) )
+                  zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekg(ji,jj) )
+                  zc3 = ze3(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekr(ji,jj) )
+                  ze0(ji,jj,jk) = zc0
+                  ze1(ji,jj,jk) = zc1
+                  ze2(ji,jj,jk) = zc2
+                  ze3(ji,jj,jk) = zc3
+                  zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, nksr                     !* now qsr induced heat content
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) )
+               END DO
+            END DO
+         END DO
+         !
+         CALL wrk_dealloc( jpi,jpj,        zekb, zekg, zekr        ) 
+         CALL wrk_dealloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea ) 
+         !
+      CASE( np_2BD  )            !==  2-bands fluxes  ==!
+         !
+         zz0 =        rn_abs   * r1_rau0_rcp      ! surface equi-partition in 2-bands
+         zz1 = ( 1. - rn_abs ) * r1_rau0_rcp
+         DO jk = 1, nksr                          ! solar heat absorbed at T-point in the top 400m 
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zc0 = zz0 * EXP( -gdepw_n(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk  )*xsi1r )
+                  zc1 = zz0 * EXP( -gdepw_n(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk+1)*xsi1r )
+                  qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) ) 
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+      !                          !-----------------------------!
+      DO jk = 1, nksr            !  update to the temp. trend  !
+         DO jj = 2, jpjm1        !-----------------------------!
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
+                  &                 + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      IF( ln_qsr_ice ) THEN      ! sea-ice: store the 1st ocean level attenuation coefficient
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) )
+               ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp
                ENDIF
-               !
-               zcoef  = ( 1. - rn_abs ) / 3.e0                        ! equi-partition in R-G-B
-               ze0(:,:,1) = rn_abs  * qsr(:,:)
-               ze1(:,:,1) = zcoef * qsr(:,:)
-               ze2(:,:,1) = zcoef * qsr(:,:)
-               ze3(:,:,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) * zekb(ji,jj) )
-                        zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg(ji,jj) )
-                        zc3 = ze3(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekr(ji,jj) )
-                        ze0(ji,jj,jk) = zc0
-                        ze1(ji,jj,jk) = zc1
-                        ze2(ji,jj,jk) = zc2
-                        ze3(ji,jj,jk) = zc3
-                        zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * 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) * zekb(ji,jj) )
-                        zzc2 = zcoef  * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) )
-                        zzc3 = zcoef  * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) )
-                        fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2  + zzc3  ) * 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     ! below 400m set to zero
-               CALL iom_put( 'qsr3d', zea )   ! Shortwave Radiation 3D distribution
-               !
-            ELSE                                                 !*  Constant Chlorophyll
-               DO jk = 1, nksr
-                  qsr_hc(:,:,jk) =  etot3(:,:,jk) * qsr(:,:)
-               END DO
-               ! clem: store attenuation coefficient of the first ocean level
-               IF ( ln_qsr_ice ) THEN
-                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp
-               ENDIF
-           ENDIF
-
-         ENDIF
-         !                                                ! ------------------------- !
-         IF( ln_qsr_2bd ) THEN                            !  2 band light penetration !
-            !                                             ! ------------------------- !
-            !
-            IF( lk_vvl ) THEN                                  !* variable volume
-               zz0   =        rn_abs   * r1_rau0_rcp
-               zz1   = ( 1. - rn_abs ) * r1_rau0_rcp
-               DO jk = 1, nksr                    ! solar heat absorbed at T-point in the top 400m 
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
-                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
-                        qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) ) 
-                     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
-                        zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r )
-                        zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r )
-                        fraqsr_1lev(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp
-                     END DO
-                  END DO
-               ENDIF
-            ELSE                                               !* constant volume: coef. computed one for all
-               DO jk = 1, nksr
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1   ! vector opt.
-                        ! (ISF) no light penetration below the ice shelves         
-                        qsr_hc(ji,jj,jk) =  etot3(ji,jj,jk) * qsr(ji,jj) * tmask(ji,jj,1)
-                     END DO
-                  END DO
-               END DO
-               ! clem: store attenuation coefficient of the first ocean level
-               IF ( ln_qsr_ice ) THEN
-                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp
-               ENDIF
-               !
-            ENDIF
-            !
-         ENDIF
-         !
-         !                                        Add to the general trend
-         DO jk = 1, nksr
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z1_e3t = zfact / fse3t(ji,jj,jk)
-                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF
-      !
-      IF( lrst_oce ) THEN   !                  Write in the ocean restart file
-         !                                     *******************************
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'qsr tracer content forcing field written in ocean restart file ',   &
-            &                    'at it= ', kt,' date= ', ndastp
-         IF(lwp) WRITE(numout,*) '~~~~'
+            END DO
+         END DO
+         ! Update haloes since lim_thd needs fraqsr_1lev to be defined everywhere
+         CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp )
+      ENDIF
+      !
+      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution
+         CALL wrk_alloc( jpi,jpj,jpk,   zetot )
+         !
+         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero
+         DO jk = nksr, 1, -1
+            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp
+         END DO         
+         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation
+         !
+         CALL wrk_dealloc( jpi,jpj,jpk,   zetot ) 
+      ENDIF
+      !
+      IF( lrst_oce ) THEN     ! write in the ocean restart file
          CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      )
-         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev )   ! default definition in sbcssm 
-         !
-      ENDIF
-
+         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev ) 
+      ENDIF
+      !
       IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
          CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt )
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt ) 
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt ) 
       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' )
-      !
-      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_qsr')
@@ -363,34 +307,25 @@
       !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
       !!----------------------------------------------------------------------
-      !
-      INTEGER  ::   ji, jj, jk                   ! dummy loop indices
-      INTEGER  ::   irgb, ierror, ioptio, nqsr   ! local integer
-      INTEGER  ::   ios                          ! Local integer output status for namelist read
-      REAL(wp) ::   zz0, zc0  , zc1, zcoef       ! local scalars
-      REAL(wp) ::   zz1, zc2  , zc3, zchl        !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea
+      INTEGER  ::   ji, jj, jk                  ! dummy loop indices
+      INTEGER  ::   ios, irgb, ierror, ioptio   ! local integer
+      REAL(wp) ::   zz0, zc0 , zc1, zcoef      ! local scalars
+      REAL(wp) ::   zz1, zc2 , zc3, zchl       !   -      -
       !
       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_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  &
+      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  &
          &                  nn_chldta, rn_abs, rn_si0, rn_si1
       !!----------------------------------------------------------------------
-
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init')
-      !
-      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        ) 
-      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
-      !
-
-      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference namelist : Ratio and length of penetration
+      !
+      IF( nn_timing == 1 )   CALL timing_start('tra_qsr_init')
+      !
+      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference     namelist
       READ  ( numnam_ref, namtra_qsr, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_qsr in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              !  Namelist namtra_qsr in configuration namelist : Ratio and length of penetration
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namtra_qsr in configuration namelist
       READ  ( numnam_cfg, namtra_qsr, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namtra_qsr )
       !
@@ -400,175 +335,84 @@
          WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namtra_qsr : set the parameter of penetration'
-         WRITE(numout,*) '      Light penetration (T) or not (F)         ln_traqsr  = ', ln_traqsr
-         WRITE(numout,*) '      RGB (Red-Green-Blue) light penetration   ln_qsr_rgb = ', ln_qsr_rgb
-         WRITE(numout,*) '      2 band               light penetration   ln_qsr_2bd = ', ln_qsr_2bd
-         WRITE(numout,*) '      bio-model            light penetration   ln_qsr_bio = ', ln_qsr_bio
-         WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice
-         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)    nn_chldta  = ', nn_chldta
-         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs = ', rn_abs
-         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
-      ENDIF
-
-      IF( ln_traqsr ) THEN     ! control consistency
-         !                      
-         IF( .NOT.lk_qsr_bio .AND. ln_qsr_bio )   THEN
-            CALL ctl_warn( 'No bio model : force ln_qsr_bio = FALSE ' )
-            ln_qsr_bio = .FALSE.
+         WRITE(numout,*) '      RGB (Red-Green-Blue) light penetration       ln_qsr_rgb = ', ln_qsr_rgb
+         WRITE(numout,*) '      2 band               light penetration       ln_qsr_2bd = ', ln_qsr_2bd
+         WRITE(numout,*) '      bio-model            light penetration       ln_qsr_bio = ', ln_qsr_bio
+         WRITE(numout,*) '      light penetration for ice-model (LIM3)       ln_qsr_ice = ', ln_qsr_ice
+         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)        nn_chldta  = ', nn_chldta
+         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs     = ', rn_abs
+         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,*)
+      ENDIF
+      !
+      ioptio = 0                    ! Parameter control
+      IF( ln_qsr_rgb  )   ioptio = ioptio + 1
+      IF( ln_qsr_2bd  )   ioptio = ioptio + 1
+      IF( ln_qsr_bio  )   ioptio = ioptio + 1
+      !
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE type of light penetration in namelist namtra_qsr',  &
+         &                               ' 2 bands, 3 RGB bands or bio-model light penetration' )
+      !
+      IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr = np_RGB 
+      IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr = np_RGBc
+      IF( ln_qsr_2bd                      )   nqsr = np_2BD
+      IF( ln_qsr_bio                      )   nqsr = np_BIO
+      !
+      !                             ! Initialisation
+      xsi0r = 1._wp / rn_si0
+      xsi1r = 1._wp / rn_si1
+      !
+      SELECT CASE( nqsr )
+      !                               
+      CASE( np_RGB , np_RGBc )         !==  Red-Green-Blue light penetration  ==!
+         !                             
+         IF(lwp)   WRITE(numout,*) '   R-G-B   light penetration '
+         !
+         CALL trc_oce_rgb( rkrgb )                 ! tabulated attenuation coef.
+         !                                   
+         nksr = trc_oce_ext_lev( r_si2, 33._wp )   ! level of light extinction
+         !
+         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
+         !
+         IF( nqsr == np_RGBc ) THEN                ! Chl data : set sf_chl structure
+            IF(lwp) WRITE(numout,*) '        Chlorophyll read in a file'
+            ALLOCATE( sf_chl(1), STAT=ierror )
+            IF( ierror > 0 ) THEN
+               CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN
+            ENDIF
+            ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   )
+            IF( sn_chl%ln_tint )   ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
+            !                                        ! fill sf_chl with sn_chl and control print
+            CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   &
+               &           'Solar penetration function of read chlorophyll', 'namtra_qsr' )
          ENDIF
-         !
-         ioptio = 0                      ! Parameter control
-         IF( ln_qsr_rgb  )   ioptio = ioptio + 1
-         IF( ln_qsr_2bd  )   ioptio = ioptio + 1
-         IF( ln_qsr_bio  )   ioptio = ioptio + 1
-         !
-         IF( ioptio /= 1 ) &
-            CALL ctl_stop( '          Choose ONE type of light penetration in namelist namtra_qsr',  &
-            &              ' 2 bands, 3 RGB bands or bio-model light penetration' )
-         !
-         IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr =  1 
-         IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr =  2
-         IF( ln_qsr_2bd                      )   nqsr =  3
-         IF( ln_qsr_bio                      )   nqsr =  4
-         !
-         IF(lwp) THEN                   ! Print the choice
-            WRITE(numout,*)
-            IF( nqsr ==  1 )   WRITE(numout,*) '         R-G-B   light penetration - Constant Chlorophyll'
-            IF( nqsr ==  2 )   WRITE(numout,*) '         R-G-B   light penetration - Chl data '
-            IF( nqsr ==  3 )   WRITE(numout,*) '         2 bands light penetration'
-            IF( nqsr ==  4 )   WRITE(numout,*) '         bio-model light penetration'
+         IF( nqsr == np_RGB ) THEN                 ! constant Chl
+            IF(lwp) WRITE(numout,*) '        Constant Chlorophyll concentration = 0.05'
          ENDIF
          !
-      ENDIF
-      !                          ! ===================================== !
-      IF( ln_traqsr  ) THEN      !  Initialisation of Light Penetration  !  
-         !                       ! ===================================== !
-         !
-         xsi0r = 1.e0 / rn_si0
-         xsi1r = 1.e0 / rn_si1
-         !                                ! ---------------------------------- !
-         IF( ln_qsr_rgb ) THEN            !  Red-Green-Blue light penetration  !
-            !                             ! ---------------------------------- !
-            !
-            CALL trc_oce_rgb( rkrgb )           !* tabulated attenuation coef.
-            !
-            !                                   !* level of light extinction
-            IF(  ln_sco ) THEN   ;   nksr = jpkm1
-            ELSE                 ;   nksr = trc_oce_ext_lev( r_si2, 0.33e2 )
-            ENDIF
-
-            IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
-            !
-            IF( nn_chldta == 1 ) THEN           !* Chl data : set sf_chl structure
-               IF(lwp) WRITE(numout,*)
-               IF(lwp) WRITE(numout,*) '        Chlorophyll read in a file'
-               ALLOCATE( sf_chl(1), STAT=ierror )
-               IF( ierror > 0 ) THEN
-                  CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN
-               ENDIF
-               ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   )
-               IF( sn_chl%ln_tint )ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
-               !                                        ! fill sf_chl with sn_chl and control print
-               CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   &
-                  &                                         'Solar penetration function of read chlorophyll', 'namtra_qsr' )
-               !
-            ELSE                                !* constant Chl : compute once for all the distribution of light (etot3)
-               IF(lwp) WRITE(numout,*)
-               IF(lwp) WRITE(numout,*) '        Constant Chlorophyll concentration = 0.05'
-               IF( lk_vvl ) THEN                   ! variable volume
-                  IF(lwp) WRITE(numout,*) '        key_vvl: light distribution will be computed at each time step'
-               ELSE                                ! constant volume: computes one for all
-                  IF(lwp) WRITE(numout,*) '        fixed volume: light distribution computed one for all'
-                  !
-                  zchl = 0.05                                 ! constant chlorophyll
-                  irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
-                  zekb(:,:) = rkrgb(1,irgb)                   ! Separation in R-G-B depending of the chlorophyll 
-                  zekg(:,:) = rkrgb(2,irgb)
-                  zekr(:,:) = rkrgb(3,irgb)
-                  !
-                  zcoef = ( 1. - rn_abs ) / 3.e0              ! equi-partition in R-G-B
-                  ze0(:,:,1) = rn_abs
-                  ze1(:,:,1) = zcoef
-                  ze2(:,:,1) = zcoef 
-                  ze3(:,:,1) = zcoef
-                  zea(:,:,1) = tmask(:,:,1)                   ! = ( ze0+ze1+z2+ze3 ) * tmask
-               
-                  DO jk = 2, nksr+1
-!CDIR NOVERRCHK
-                     DO jj = 1, jpj
-!CDIR NOVERRCHK   
-                        DO ji = 1, jpi
-                           zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r     )
-                           zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekb(ji,jj) )
-                           zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekg(ji,jj) )
-                           zc3 = ze3(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekr(ji,jj) )
-                           ze0(ji,jj,jk) = zc0
-                           ze1(ji,jj,jk) = zc1
-                           ze2(ji,jj,jk) = zc2
-                           ze3(ji,jj,jk) = zc3
-                           zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk)
-                        END DO
-                     END DO
-                  END DO 
-                  !
-                  DO jk = 1, nksr
-                     ! (ISF) no light penetration below the ice shelves
-                     etot3(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) ) * tmask(:,:,1)
-                  END DO
-                  etot3(:,:,nksr+1:jpk) = 0.e0                ! below 400m set to zero
-               ENDIF
-            ENDIF
-            !
-         ENDIF
-            !                             ! ---------------------------------- !
-         IF( ln_qsr_2bd ) THEN            !    2 bands    light penetration    !
-            !                             ! ---------------------------------- !
-            !
-            !                                ! level of light extinction
-            nksr = trc_oce_ext_lev( rn_si1, 1.e2 )
-            IF(lwp) THEN
-               WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
-            ENDIF
-            !
-            IF( lk_vvl ) THEN                   ! variable volume
-               IF(lwp) WRITE(numout,*) '        key_vvl: light distribution will be computed at each time step'
-            ELSE                                ! constant volume: computes one for all
-               zz0 =        rn_abs   * r1_rau0_rcp
-               zz1 = ( 1. - rn_abs ) * r1_rau0_rcp
-               DO jk = 1, nksr                    !*  solar heat absorbed at T-point computed once for all
-                  DO jj = 1, jpj                              ! top 400 meters
-                     DO ji = 1, jpi
-                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
-                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
-                        etot3(ji,jj,jk) = (  zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1)  ) * tmask(ji,jj,1) 
-                     END DO
-                  END DO
-               END DO
-               etot3(:,:,nksr+1:jpk) = 0.e0                   ! below 400m set to zero
-               !
-            ENDIF
-         ENDIF
-         !                       ! ===================================== !
-      ELSE                       !        No light penetration           !                   
-         !                       ! ===================================== !
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'tra_qsr_init : NO solar flux penetration'
-            WRITE(numout,*) '~~~~~~~~~~~~'
-         ENDIF
-      ENDIF
-      !
-      ! initialisation of fraqsr_1lev used in sbcssm
+      CASE( np_2BD )                   !==  2 bands light penetration  ==!
+         !
+         IF(lwp)  WRITE(numout,*) '   2 bands light penetration'
+         !
+         nksr = trc_oce_ext_lev( rn_si1, 100._wp )    ! level of light extinction
+         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
+         !
+      CASE( np_BIO )                   !==  BIO light penetration  ==!
+         !
+         IF(lwp) WRITE(numout,*) '   bio-model light penetration'
+         IF( .NOT.lk_qsr_bio )   CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' )
+         !
+      END SELECT
+      !
+      qsr_hc(:,:,:) = 0._wp     ! now qsr heat content set to zero where it will not be computed
+      !
+      ! 1st ocean level attenuation coefficient (used in sbcssm)
       IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN
          CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  )
       ELSE
-         fraqsr_1lev(:,:) = 1._wp   ! default definition
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_qsr_init')
+         fraqsr_1lev(:,:) = 1._wp   ! default : no penetration
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('tra_qsr_init')
       !
    END SUBROUTINE tra_qsr_init
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 6808)
@@ -13,32 +13,32 @@
 
    !!----------------------------------------------------------------------
-   !!   tra_sbc      : update the tracer trend at ocean surface
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE dom_oce         ! ocean space domain variables
-   USE phycst          ! physical constant
-   USE sbcmod          ! ln_rnf  
-   USE sbcrnf          ! River runoff  
-   USE sbcisf          ! Ice shelf   
-   USE traqsr          ! solar radiation penetration
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
+   !!   tra_sbc       : update the tracer trend at ocean surface
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE dom_oce        ! ocean space domain variables
+   USE phycst         ! physical constant
+   USE eosbn2         ! Equation Of State
+   USE sbcmod         ! ln_rnf  
+   USE sbcrnf         ! River runoff  
+   USE sbcisf         ! Ice shelf   
+   USE iscplini       ! Ice sheet coupling
+   USE traqsr         ! solar radiation penetration
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends manager: tracers 
    !
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
-   USE iom
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
-   USE eosbn2
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE iom            ! xIOS server
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   tra_sbc    ! routine called by step.F90
+   PUBLIC   tra_sbc   ! routine called by step.F90
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -57,68 +57,22 @@
       !!      and add it to the general trend of tracer equations.
       !!
-      !! ** Method :
-      !!      Following Roullet and Madec (2000), the air-sea flux can be divided 
-      !!      into three effects: (1) Fext, external forcing; 
-      !!      (2) Fwi, concentration/dilution effect due to water exchanged 
-      !!         at the surface by evaporation, precipitations and runoff (E-P-R); 
-      !!      (3) Fwe, tracer carried with the water that is exchanged. 
-      !!            - salinity    : salt flux only due to freezing/melting
-      !!            sa = sa +  sfx / rau0 / e3t  for k=1
+      !! ** Method :   The (air+ice)-sea flux has two components: 
+      !!      (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface); 
+      !!      (2) Fwe , tracer carried with the water that is exchanged with air+ice. 
+      !!               The input forcing fields (emp, rnf, sfx, isf) contain Fext+Fwe,
+      !!             they are simply added to the tracer trend (tsa).
+      !!               In linear free surface case (ln_linssh=T), the volume of the
+      !!             ocean does not change with the water exchanges at the (air+ice)-sea
+      !!             interface. Therefore another term has to be added, to mimic the
+      !!             concentration/dilution effect associated with water exchanges.
       !!
-      !!      Fext, flux through the air-sea interface for temperature and salt: 
-      !!            - temperature : heat flux q (w/m2). If penetrative solar
-      !!         radiation q is only the non solar part of the heat flux, the
-      !!         solar part is added in traqsr.F routine.
-      !!            ta = ta + q /(rau0 rcp e3t)  for k=1
-      !!            - salinity    : no salt flux
-      !!
-      !!      The formulation for Fwb and Fwi vary according to the free 
-      !!      surface formulation (linear or variable volume). 
-      !!      * Linear free surface
-      !!            The surface freshwater flux modifies the ocean volume
-      !!         and thus the concentration of a tracer and the temperature.
-      !!         First order of the effect of surface freshwater exchange 
-      !!         for salinity, it can be neglected on temperature (especially
-      !!         as the temperature of precipitations and runoffs is usually
-      !!         unknown).
-      !!            - temperature : we assume that the temperature of both
-      !!         precipitations and runoffs is equal to the SST, thus there
-      !!         is no additional flux since in this case, the concentration
-      !!         dilution effect is balanced by the net heat flux associated
-      !!         to the freshwater exchange (Fwe+Fwi=0):
-      !!            (Tp P - Te E) + SST (P-E) = 0 when Tp=Te=SST
-      !!            - salinity    : evaporation, precipitation and runoff
-      !!         water has a zero salinity  but there is a salt flux due to 
-      !!         freezing/melting, thus:
-      !!            sa = sa + emp * sn / rau0 / e3t   for k=1
-      !!                    + sfx    / rau0 / e3t
-      !!         where emp, the surface freshwater budget (evaporation minus
-      !!         precipitation minus runoff) given in kg/m2/s is divided
-      !!         by rau0 (density of sea water) to obtain m/s.    
-      !!         Note: even though Fwe does not appear explicitly for 
-      !!         temperature in this routine, the heat carried by the water
-      !!         exchanged through the surface is part of the total heat flux
-      !!         forcing and must be taken into account in the global heat
-      !!         balance).
-      !!      * nonlinear free surface (variable volume, lk_vvl)
-      !!         contrary to the linear free surface case, Fwi is properly 
-      !!         taken into account by using the true layer thicknesses to       
-      !!         calculate tracer content and advection. There is no need to 
-      !!         deal with it in this routine.
-      !!           - temperature: Fwe=SST (P-E+R) is added to Fext.
-      !!           - salinity:  Fwe = 0, there is no surface flux of salt.
-      !!
-      !! ** Action  : - Update the 1st level of (ta,sa) with the trend associated
-      !!                with the tracer surface boundary condition 
-      !!              - send trends to trdtra module (l_trdtra=T)
+      !! ** Action  : - Update tsa with the surface boundary condition trend 
+      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T)
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices  
-      INTEGER  ::   ikt, ikb 
-      INTEGER  ::   nk_isf
-      REAL(wp) ::   zfact, z1_e3t, zdep
-      REAL(wp) ::   zalpha, zhk
-      REAL(wp) ::  zt_frz, zpress
+      !
+      INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices  
+      INTEGER  ::   ikt, ikb              ! local integers
+      REAL(wp) ::   zfact, z1_e3t, zdep   ! local scalar
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
@@ -131,5 +85,5 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
       ENDIF
-
+      !
       IF( l_trdtra ) THEN                    !* Save ta and sa trends
          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
@@ -137,9 +91,9 @@
          ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
-
-!!gm      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration
+      !
+!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
       IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
          qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns
-         qsr(:,:) = 0.e0                     ! qsr set to zero
+         qsr(:,:) = 0._wp                     ! qsr set to zero
       ENDIF
 
@@ -147,71 +101,51 @@
       !        EMP, SFX and QNS effects
       !----------------------------------------
-      !                                          Set before sbc tracer content fields
-      !                                          ************************************
-      IF( kt == nit000 ) THEN                      ! Set the forcing field at nit000 - 1
-         !                                         ! -----------------------------------
-         IF( ln_rstart .AND.    &                     ! Restart: read in restart file
+      !                             !==  Set before sbc tracer content fields  ==!
+      IF( kt == nit000 ) THEN             !* 1st time-step
+         IF( ln_rstart .AND.    &               ! Restart: read in restart file
               & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN
-            IF(lwp) WRITE(numout,*) '          nit000-1 surface tracer content forcing fields red in the restart file'
+            IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file'
             zfact = 0.5_wp
             CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend
             CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend
-         ELSE                                         ! No restart or restart not found: Euler forward time stepping
+         ELSE                                   ! No restart or restart not found: Euler forward time stepping
             zfact = 1._wp
             sbc_tsc_b(:,:,:) = 0._wp
          ENDIF
-      ELSE                                         ! Swap of forcing fields
-         !                                         ! ----------------------
+      ELSE                                !* other time-steps: swap of forcing fields
          zfact = 0.5_wp
          sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:)
       ENDIF
-      !                                          Compute now sbc tracer content fields
-      !                                          *************************************
-
-                                                   ! Concentration dilution effect on (t,s) due to  
-                                                   ! evaporation, precipitation and qns, but not river runoff 
-                                               
-      IF( lk_vvl ) THEN                            ! Variable Volume case  ==>> heat content of mass flux is in qns
-         DO jj = 1, jpj
-            DO ji = 1, jpi 
-               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)                              ! non solar heat flux
-               sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)                              ! salt flux due to freezing/melting
+      !                             !==  Now sbc tracer content fields  ==!
+      DO jj = 2, jpj
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux
+            sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)   ! salt flux due to freezing/melting
+         END DO
+      END DO
+      IF( ln_linssh ) THEN                !* linear free surface  
+         DO jj = 2, jpj                         !==>> add concentration/dilution effect due to constant volume cell
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rau0 * emp(ji,jj) * tsn(ji,jj,1,jp_tem)
+               sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rau0 * emp(ji,jj) * tsn(ji,jj,1,jp_sal)
             END DO
-         END DO
-      ELSE                                         ! Constant Volume case ==>> Concentration dilution effect
+         END DO                                 !==>> output c./d. term
+         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )
+         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )
+      ENDIF
+      !
+      DO jn = 1, jpts               !==  update tracer trend  ==!
          DO jj = 2, jpj
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! temperature : heat flux
-               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)                          &   ! non solar heat flux
-                  &                  + r1_rau0     * emp(ji,jj)  * tsn(ji,jj,1,jp_tem)       ! concent./dilut. effect
-               ! salinity    : salt flux + concent./dilut. effect (both in sfx)
-               sbc_tsc(ji,jj,jp_sal) = r1_rau0  * (  sfx(ji,jj)                          &   ! salt flux (freezing/melting)
-                  &                                + emp(ji,jj) * tsn(ji,jj,1,jp_sal) )      ! concent./dilut. effect
+            DO ji = fs_2, fs_jpim1   ! vector opt.  
+               tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t_n(ji,jj,1)
             END DO
          END DO
-         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )   ! c/d term on sst
-         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )   ! c/d term on sss
-      ENDIF
-      ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff  
-      DO jn = 1, jpts
-         DO jj = 2, jpj
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               z1_e3t = zfact / fse3t(ji,jj,1)
-               tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) * z1_e3t
-            END DO
-         END DO
       END DO
-      !                                          Write in the ocean restart file
-      !                                          *******************************
-      IF( lrst_oce ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in ocean restart file ',   &
-            &                    'at it= ', kt,' date= ', ndastp
-         IF(lwp) WRITE(numout,*) '~~~~'
+      !                  
+      IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==!
          CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )
          CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) )
       ENDIF
       !
-      !
       !----------------------------------------
       !       Ice Shelf effects (ISF)
@@ -219,47 +153,33 @@
       !----------------------------------------
       !
-      IF( nn_isf > 0 ) THEN
-         zfact = 0.5e0
+!!gm BUG ?   Why no differences between non-linear and linear free surface ?
+!!gm         probably taken into account in r1_hisf_tbl : to be verified
+      IF( ln_isf ) THEN
+         zfact = 0.5_wp
          DO jj = 2, jpj
             DO ji = fs_2, fs_jpim1
-         
+               !
                ikt = misfkt(ji,jj)
                ikb = misfkb(ji,jj)
-   
+               !
                ! level fully include in the ice shelf boundary layer
-               ! if isfdiv, we have to remove heat flux due to inflow at 0oC (as in rnf when you add rnf at sst)
                ! sign - because fwf sign of evapo (rnf sign of precip)
                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)          &
-                     &               - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) &
+                  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)
-                  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)
                END DO
    
                ! 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)          &
-                  &                  - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) & 
+               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)
-               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) 
+
             END DO
          END DO
          IF( lrst_oce ) THEN
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'sbc : isf surface tracer content forcing fields written in ocean restart file ',   &
-               &                    'at it= ', kt,' date= ', ndastp
-            IF(lwp) WRITE(numout,*) '~~~~'
-            CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:)          )
+            CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf  (:,:)        )
             CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) )
             CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) )
@@ -278,8 +198,8 @@
                   zdep = zfact / h_rnf(ji,jj)
                   DO jk = 1, nk_rnf(ji,jj)
-                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
-                                          &               +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
-                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
-                                          &               +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
+                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                 &
+                                           &                 +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
+                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)                                 &
+                                           &                 +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
                   END DO
                ENDIF
@@ -287,6 +207,24 @@
          END DO  
       ENDIF
- 
-      IF( l_trdtra )   THEN                      ! send trends for further diagnostics
+      !
+      !----------------------------------------
+      !        Ice Sheet coupling imbalance correction to have conservation
+      !----------------------------------------
+      !
+      IF( ln_iscpl .AND. ln_hsb) THEN         ! input of heat and salt due to river runoff 
+         DO jk = 1,jpk
+            DO jj = 2, jpj 
+               DO ji = fs_2, fs_jpim1
+                  zdep = 1._wp / e3t_n(ji,jj,jk) 
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - htsc_iscpl(ji,jj,jk,jp_tem)                       &
+                      &                                         * zdep
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - htsc_iscpl(ji,jj,jk,jp_sal)                       &
+                      &                                         * zdep  
+               END DO  
+            END DO  
+         END DO
+      ENDIF
+
+      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 6808)
@@ -9,26 +9,26 @@
 
    !!----------------------------------------------------------------------
-   !!   tra_zdf      : Update the tracer trend with the vertical diffusion
-   !!   tra_zdf_init : initialisation of the computation
+   !!   tra_zdf       : Update the tracer trend with the vertical diffusion
+   !!   tra_zdf_init  : initialisation of the computation
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE domvvl          ! variable volume
-   USE phycst          ! physical constant
-   USE zdf_oce         ! ocean vertical physics variables
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE dynspg_oce
-   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine)
-   USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine)
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables 
+   USE domvvl         ! variable volume
+   USE phycst         ! physical constant
+   USE zdf_oce        ! ocean vertical physics variables
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE ldftra         ! lateral diffusion: eddy diffusivity
+   USE ldfslp         ! lateral diffusion: iso-neutral slope 
+   USE trazdf_exp     ! vertical diffusion: explicit (tra_zdf_exp routine)
+   USE trazdf_imp     ! vertical diffusion: implicit (tra_zdf_imp routine)
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends: tracer trend manager
    !
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory allocation
-   USE timing          ! Timing
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -41,9 +41,8 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -58,5 +57,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !!
+      !
       INTEGER  ::   jk                   ! Dummy loop indices
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace
@@ -66,9 +65,9 @@
       !
       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
-         r2dtra(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping)
+         r2dt =  rdt                          ! = rdt (restarting with Euler time stepping)
       ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
-         r2dtra(:) = 2. * rdttra(:)                      ! = 2 rdttra (leapfrog)
+         r2dt = 2. * rdt                      ! = 2 rdt (leapfrog)
       ENDIF
-
+      !
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
@@ -76,33 +75,29 @@
          ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
-
+      !
       SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
-      CASE ( 0 )    ;    CALL tra_zdf_exp( kt, nit000, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme 
-      CASE ( 1 )    ;    CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra,            tsb, tsa, jpts )  !   implicit scheme 
-      CASE ( -1 )                                       ! esopa: test all possibility with control print
-         CALL tra_zdf_exp( kt, nit000, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts )
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask,               &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra,            tsb, tsa, jpts ) 
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask,               &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      CASE ( 0 )    ;    CALL tra_zdf_exp( kt, nit000, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme 
+      CASE ( 1 )    ;    CALL tra_zdf_imp( kt, nit000, 'TRA', r2dt,            tsb, tsa, jpts )  !   implicit scheme 
       END SELECT
+!!gm WHY here !   and I don't like that !
       ! DRAKKAR SSS control {
       ! JMM avoid negative salinities near river outlet ! Ugly fix
       ! JMM : restore negative salinities to small salinities:
-      WHERE ( tsa(:,:,:,jp_sal) < 0._wp )   tsa(:,:,:,jp_sal) = 0.1_wp
+      WHERE( tsa(:,:,:,jp_sal) < 0._wp )   tsa(:,:,:,jp_sal) = 0.1_wp
+!!gm
 
       IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
          DO jk = 1, jpkm1
-            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk) ) - ztrdt(:,:,jk)
-            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk)
+            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt ) - ztrdt(:,:,jk)
+            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt ) - ztrds(:,:,jk)
          END DO
+!!gm this should be moved in trdtra.F90 and done on all trends
          CALL lbc_lnk( ztrdt, 'T', 1. )
          CALL lbc_lnk( ztrds, 'T', 1. )
+!!gm
          CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt )
          CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds )
          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
       ENDIF
-
       !                                          ! print mean trends (used for debugging)
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf  - Ta: ', mask1=tmask,               &
@@ -123,32 +118,27 @@
       !!      nzdf = 0   explicit (time-splitting) scheme (ln_zdfexp=T)
       !!           = 1   implicit (euler backward) scheme (ln_zdfexp=F)
-      !!      NB: rotation of lateral mixing operator or TKE or KPP scheme,
-      !!      the implicit scheme is required.
+      !!      NB: rotation of lateral mixing operator or TKE & GLS schemes,
+      !!          an implicit scheme is required.
       !!----------------------------------------------------------------------
       USE zdftke
       USE zdfgls
-      USE zdfkpp
       !!----------------------------------------------------------------------
-
+      !
       ! Choice from ln_zdfexp already read in namelist in zdfini module
       IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme
       ELSE                   ;   nzdf = 1           ! use implicit scheme
       ENDIF
-
+      !
       ! Force implicit schemes
-      IF( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp )   nzdf = 1      ! TKE, GLS or KPP physics
-      IF( ln_traldf_iso                           )   nzdf = 1      ! iso-neutral lateral physics
-      IF( ln_traldf_hor .AND. ln_sco              )   nzdf = 1      ! horizontal lateral physics in s-coordinate
+      IF( lk_zdftke .OR. lk_zdfgls   )   nzdf = 1   ! TKE, or GLS physics
+      IF( ln_traldf_iso              )   nzdf = 1   ! iso-neutral lateral physics
+      IF( ln_traldf_hor .AND. ln_sco )   nzdf = 1   ! horizontal lateral physics in s-coordinate
       IF( ln_zdfexp .AND. nzdf == 1 )   CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator',   &
-            &                         ' TKE or KPP scheme, the implicit scheme is required, set ln_zdfexp = .false.' )
-
-      ! Test: esopa
-      IF( lk_esopa )    nzdf = -1                      ! All schemes used
-
+            &                         ' GLS or TKE scheme, the implicit scheme is required, set ln_zdfexp = .false.' )
+            !
       IF(lwp) THEN
          WRITE(numout,*)
          WRITE(numout,*) 'tra_zdf_init : vertical tracer physics scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
-         IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
          IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme'
          IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 6808)
@@ -20,17 +20,18 @@
 
    !!----------------------------------------------------------------------
-   !!   tra_zdf_exp  : compute the tracer the vertical diffusion trend using a
-   !!                  split-explicit time stepping and provide the after tracer
+   !!   tra_zdf_exp   : compute the tracer the vertical diffusion trend using a
+   !!                   split-explicit time stepping and provide the after tracer
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers 
-   USE dom_oce         ! ocean space and time domain 
-   USE domvvl          ! variable volume levels
-   USE zdf_oce         ! ocean vertical physics
-   USE zdfddm          ! ocean vertical physics: double diffusion
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   USE oce            ! ocean dynamics and active tracers 
+   USE dom_oce        ! ocean space and time domain 
+   USE domvvl         ! variable volume levels
+   USE zdf_oce        ! ocean vertical physics
+   USE zdfddm         ! ocean vertical physics: double diffusion
+   USE trc_oce        ! share passive tracers/Ocean variables
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -40,5 +41,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
@@ -50,6 +50,6 @@
 CONTAINS
 
-   SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, kn_zdfexp,   &
-      &                                ptb , pta      , kjpt )
+   SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, ksts,   &
+      &                                        ptb , pta , kjpt )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_zdf_exp  ***
@@ -60,5 +60,5 @@
       !! ** Method  : - The after tracer fields due to the vertical diffusion
       !!      of tracers alone is given by:
-      !!                zwx = ptb + p2dt difft
+      !!                ztb = ptb + p2dt difft
       !!      where difft = dz( avt dz(ptb) ) = 1/e3t dk+1( avt/e3w dk(ptb) )
       !!           (if lk_zdfddm=T use avs on salinity and passive tracers instead of avt)
@@ -67,33 +67,28 @@
       !!      (N.B. bottom condition is applied through the masked field avt).
       !!              - the after tracer fields due to the whole trend is 
-      !!      obtained in leap-frog environment by :
-      !!          pta = zwx + p2dt pta
-      !!              - in case of variable level thickness (lk_vvl=T) the 
-      !!     the leap-frog is applied on thickness weighted tracer. That is:
-      !!          pta = [ ptb*e3tb + e3tn*( zwx - ptb + p2dt pta ) ] / e3tn
+      !!      obtained in leap-frog environment applied on thickness weighted tracer by :
+      !!          pta = [ ptb*e3tb + e3tn*( ztb - ptb + p2dt pta ) ] / e3tn
       !!
       !! ** Action : - after tracer fields pta
       !!---------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000   ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   ksts     ! number of sub-time step
+      REAL(wp)                             , INTENT(in   ) ::   p2dt     ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! in: tracer trend ; out: after tracer field 
       !
-      INTEGER                              , INTENT(in   ) ::   kt          ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000      ! first time step index
-      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype      ! =TRA or TRC (tracer indicator)
-      INTEGER                              , INTENT(in   ) ::   kjpt        ! number of tracers
-      INTEGER                              , INTENT(in   ) ::   kn_zdfexp   ! number of sub-time step
-      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt        ! vertical profile of tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb         ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta         ! tracer trend 
-      !
-      INTEGER  ::  ji, jj, jk, jn, jl        ! dummy loop indices
-      REAL(wp) ::  zlavmr, zave3r, ze3tr     ! local scalars
-      REAL(wp) ::  ztra, ze3tb               !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwx, zwy
+      INTEGER  ::  ji, jj, jk, jn, jl   ! dummy loop indices
+      REAL(wp) ::  z1_ksts, ze3tr       ! local scalars
+      REAL(wp) ::  ztra, ze3tb    !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztb, zwf
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('tra_zdf_exp')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zwx, zwy ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   ztb, zwf ) 
       !
-
       IF( kt == kit000 )  THEN
          IF(lwp) WRITE(numout,*)
@@ -104,27 +99,22 @@
       ! Initializations
       ! ---------------
-      zlavmr = 1. / float( kn_zdfexp )         ! Local constant
+      z1_ksts = 1._wp / REAL( ksts, wp )
+      zwf(:,:, 1 ) = 0._wp    ! no flux at the surface and at bottom level
+      zwf(:,:,jpk) = 0._wp
       !
       !
-      DO jn = 1, kjpt                          ! loop over tracers
+      DO jn = 1, kjpt         !==  loop over tracers  ==!
          !
-         zwy(:,:, 1 ) = 0.e0     ! surface boundary conditions: no flux
-         zwy(:,:,jpk) = 0.e0     ! bottom  boundary conditions: no flux
-         !
-         zwx(:,:,:)   = ptb(:,:,:,jn)  ! zwx array set to before tracer values
-
-         ! Split-explicit loop  (after tracer due to the vertical diffusion alone)
-         ! -------------------
-         !
-         DO jl = 1, kn_zdfexp
-            !                     ! first vertical derivative
-            DO jk = 2, jpk
+         ztb(:,:,:) = ptb(:,:,:,jn)    ! initial before value for tracer
+         ! 
+         DO jl = 1, ksts         !==  Split-explicit loop  ==!
+            !              
+            DO jk = 2, jpk             ! 1st vertical derivative (w-flux)
                DO jj = 2, jpjm1 
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zave3r = 1.e0 / fse3w_n(ji,jj,jk) 
                      IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN  ! temperature : use of avt
-                        zwy(ji,jj,jk) =   avt(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r
+                        zwf(ji,jj,jk) =   avt(ji,jj,jk) * ( ztb(ji,jj,jk-1) - ztb(ji,jj,jk) ) / e3w_b(ji,jj,jk)
                      ELSE                                           ! salinity or pass. tracer : use of avs
-                        zwy(ji,jj,jk) = fsavs(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r
+                        zwf(ji,jj,jk) = fsavs(ji,jj,jk) * ( ztb(ji,jj,jk-1) - ztb(ji,jj,jk) ) / e3w_b(ji,jj,jk)
                      END IF
                   END DO
@@ -132,40 +122,27 @@
             END DO
             !
-            DO jk = 1, jpkm1      ! second vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
+            DO jk = 1, jpkm1           ! 2nd vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
                DO jj = 2, jpjm1 
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3tr = zlavmr / fse3t_n(ji,jj,jk)
-                     zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt(jk) * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) * ze3tr
+                     ztb(ji,jj,jk) = ztb(ji,jj,jk) + p2dt * ( zwf(ji,jj,jk) - zwf(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
                   END DO
                END DO
             END DO
             !
-         END DO
+         END DO                  ! end sub-time stepping
 
-         ! After tracer due to all trends
-         ! ------------------------------
-         IF( lk_vvl ) THEN          ! variable level thickness : leap-frog on tracer*e3t
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3tb = fse3t_b(ji,jj,jk) / fse3t(ji,jj,jk)                          ! before e3t
-                     ztra  = zwx(ji,jj,jk) - ptb(ji,jj,jk,jn) + p2dt(jk) * pta(ji,jj,jk,jn)       ! total trends * 2*rdt 
-                     pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk)
-                  END DO
+         DO jk = 1, jpkm1        !==  After tracer due to all trends
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ze3tb = e3t_b(ji,jj,jk) / e3t_n(ji,jj,jk)
+                  ztra  = ( ztb(ji,jj,jk) - ptb(ji,jj,jk,jn) ) + p2dt * pta(ji,jj,jk,jn)  ! total trend * 2dt 
+                  pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk)    ! after tracer
                END DO
             END DO
-         ELSE                       ! fixed level thickness : leap-frog on tracers
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1 
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     pta(ji,jj,jk,jn) = ( zwx(ji,jj,jk) + p2dt(jk) * pta(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ENDIF
+         END DO
          !
-      END DO
+      END DO                     ! end of tracer loop
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zwx, zwy ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,   ztb, zwf ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_exp')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 6808)
@@ -16,25 +16,25 @@
    !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
    !!             -   !  2011-02  (A. Coward, C. Ethe, G. Madec) improvment of surface boundary condition
+   !!            3.7  !  2015-11  (G. Madec, A. Coward)  non linear free surface by default 
    !!----------------------------------------------------------------------
   
    !!----------------------------------------------------------------------
-   !!   tra_zdf_imp : Update the tracer trend with the diagonal vertical  
-   !!                 part of the mixing tensor.
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE zdf_oce         ! ocean vertical physics variables
-   USE trc_oce         ! share passive tracers/ocean variables
-   USE domvvl          ! variable volume
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE ldftra          ! lateral mixing type
-   USE ldfslp          ! lateral physics: slope of diffusion
-   USE zdfddm          ! ocean vertical physics: double diffusion
-   USE traldf_iso_grif ! active tracers: Griffies operator
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! MPP library
-   USE wrk_nemo        ! Memory Allocation
-   USE timing          ! Timing
+   !!   tra_zdf_imp   : Update the tracer trend with vertical mixing, nad compute the after tracer field
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables 
+   USE zdf_oce        ! ocean vertical physics variables
+   USE trc_oce        ! share passive tracers/ocean variables
+   USE domvvl         ! variable volume
+   USE ldftra         ! lateral mixing type
+   USE ldfslp         ! lateral physics: slope of diffusion
+   USE zdfddm         ! ocean vertical physics: double diffusion
+   USE traldf_triad   ! active tracers: Method of Stabilizing Correction
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
 
    IMPLICIT NONE
@@ -43,13 +43,9 @@
    PUBLIC   tra_zdf_imp   !  routine called by step.F90
 
-   REAL(wp) ::  r_vvl     ! variable volume indicator, =1 if lk_vvl=T, =0 otherwise 
-
    !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
 #  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -66,7 +62,8 @@
       !!     it is already computed and add to the general trend in traldf) 
       !!
-      !! ** Method  :  The vertical diffusion of the tracer t  is given by:
-      !!                  difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
-      !!      It is computed using a backward time scheme (t=ta).
+      !! ** Method  :  The vertical diffusion of a tracer ,t , is given by:
+      !!          difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
+      !!      It is computed using a backward time scheme (t=after field)
+      !!      which provide directly the after tracer field.
       !!      If lk_zdfddm=T, use avs for salinity or for passive tracers
       !!      Surface and bottom boundary conditions: no diffusive flux on
@@ -76,22 +73,20 @@
       !! ** Action  : - pta  becomes the after tracer
       !!---------------------------------------------------------------------
-      USE oce     , ONLY:   zwd => ua       , zws => va         ! (ua,va) used as 3D workspace
-      !
       INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
-      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      INTEGER                              , INTENT(in   ) ::   kit000   ! first time step index
       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
       INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
-      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt     ! vertical profile of tracer time-step
+      REAL(wp)                             , INTENT(in   ) ::   p2dt     ! tracer time-step
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! in: tracer trend ; out: after tracer field
       !
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::  zrhs, ze3tb, ze3tn, ze3ta   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwt
+      REAL(wp) ::  zrhs             ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwt, zwd, zws
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('tra_zdf_imp')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwt ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   zwi, zwt, zwd, zws ) 
       !
       IF( kt == kit000 )  THEN
@@ -99,14 +94,8 @@
          IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype
          IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ '
-         !
-         IF( lk_vvl ) THEN   ;    r_vvl = 1._wp       ! Variable volume indicator
-         ELSE                ;    r_vvl = 0._wp       
-         ENDIF
       ENDIF
-      !
       !                                               ! ============= !
       DO jn = 1, kjpt                                 !  tracer loop  !
          !                                            ! ============= !
-         !
          !  Matrix construction
          ! --------------------
@@ -120,41 +109,34 @@
             ELSE                                            ;   zwt(:,:,2:jpk) = fsavs(:,:,2:jpk)
             ENDIF
-            DO jj=1, jpj
-               DO ji=1, jpi
-                  zwt(ji,jj,1) = 0._wp
-               END DO
-            END DO
-!
-#if defined key_ldfslp
-            ! isoneutral diffusion: add the contribution 
-            IF( ln_traldf_grif    ) THEN     ! Griffies isoneutral diff
-               DO jk = 2, jpkm1
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1   ! vector opt.
-                        zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)       
+            zwt(:,:,1) = 0._wp
+            !
+            IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution 
+               IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator 
+                  DO jk = 2, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)  
+                        END DO
                      END DO
                   END DO
-               END DO
-            ELSE IF( l_traldf_rot ) THEN     ! standard isoneutral diff
-               DO jk = 2, jpkm1
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1   ! vector opt.
-                        zwt(ji,jj,jk) = zwt(ji,jj,jk) + fsahtw(ji,jj,jk)                       &
-                           &                          * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
-                           &                             + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
+               ELSE                          ! standard or triad iso-neutral operator
+                  DO jk = 2, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)
+                        END DO
                      END DO
                   END DO
-               END DO
+               ENDIF
             ENDIF
-#endif
+            !
             ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked)
             DO jk = 1, jpkm1
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ze3ta =  ( 1. - r_vvl ) +        r_vvl   * fse3t_a(ji,jj,jk)   ! after scale factor at T-point
-                     ze3tn =         r_vvl   + ( 1. - r_vvl ) * fse3t_n(ji,jj,jk)   ! now   scale factor at T-point
-                     zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) )
-                     zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) )
-                     zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk)
+!!gm BUG  I think, use e3w_a instead of e3w_n
+                     zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w_n(ji,jj,jk  )
+                     zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1)
+                     zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zwi(ji,jj,jk) - zws(ji,jj,jk)
                  END DO
                END DO
@@ -180,8 +162,6 @@
             !   used as a work space array: its value is modified.
             !
-            ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
-            ! done once for all passive tracers (so included in the IF instruction)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
+            DO jj = 2, jpjm1        !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
+               DO ji = fs_2, fs_jpim1            ! done one for all passive tracers (so included in the IF instruction)
                   zwt(ji,jj,1) = zwd(ji,jj,1)
                END DO
@@ -195,13 +175,9 @@
             END DO
             !
-         END IF 
+         ENDIF 
          !         
-         ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-         DO jj = 2, jpjm1
+         DO jj = 2, jpjm1           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
             DO ji = fs_2, fs_jpim1
-               ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,1)
-               ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,1)
-               pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn)                     &
-                  &                      + p2dt(1) * ze3tn * pta(ji,jj,1,jn)
+               pta(ji,jj,1,jn) = e3t_b(ji,jj,1) * ptb(ji,jj,1,jn) + p2dt * e3t_n(ji,jj,1) * pta(ji,jj,1,jn)
             END DO
          END DO
@@ -209,14 +185,11 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1
-                  ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,jk)
-                  ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t  (ji,jj,jk)
-                  zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt(jk) * ze3tn * pta(ji,jj,jk,jn)   ! zrhs=right hand side 
+                  zrhs = e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * e3t_n(ji,jj,jk) * pta(ji,jj,jk,jn)   ! zrhs=right hand side
                   pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn)
                END DO
             END DO
          END DO
-
-         ! third recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer)
-         DO jj = 2, jpjm1
+         !
+         DO jj = 2, jpjm1           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer)
             DO ji = fs_2, fs_jpim1
                pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
@@ -235,5 +208,5 @@
       !                                               ! ================= !
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwt ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwi, zwt, zwd, zws ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_imp')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 6808)
@@ -32,5 +32,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -93,16 +92,15 @@
       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom)
       !
-      INTEGER  ::   ji, jj, jn      ! Dummy loop indices
-      INTEGER  ::   iku, ikv, ikum1, ikvm1   ! partial step level (ocean bottom level) at u- and v-points
-      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars
-      REAL(wp), DIMENSION(jpi,jpj)      ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos
-      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::  zti, ztj             ! 
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde')
-      !
-      pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ;
-      zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ;
-      zhi (:,:  )=0.0_wp ; zhj (:,:  )=0.0_wp ;
+      INTEGER  ::   ji, jj, jn                  ! Dummy loop indices
+      INTEGER  ::   iku, ikv, ikum1, ikvm1      ! partial step level (ocean bottom level) at u- and v-points
+      REAL(wp) ::   ze3wu, ze3wv, zmaxu, zmaxv  ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj)      ::   zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos
+      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::   zti, ztj             ! 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start( 'zps_hde')
+      !
+      pgtu(:,:,:)=0._wp   ;   zti (:,:,:)=0._wp   ;   zhi (:,:  )=0._wp
+      pgtv(:,:,:)=0._wp   ;   ztj (:,:,:)=0._wp   ;   zhj (:,:  )=0._wp
       !
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
@@ -112,10 +110,11 @@
                iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
                ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
-               ze3wu = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
-               ze3wv = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+!!gm BUG ? when applied to before fields, e3w_b should be used....
+               ze3wu = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
+               ze3wv = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
                !
                ! i- direction
                IF( ze3wu >= 0._wp ) THEN      ! case 1
-                  zmaxu =  ze3wu / fse3w(ji+1,jj,iku)
+                  zmaxu =  ze3wu / e3w_n(ji+1,jj,iku)
                   ! interpolated values of tracers
                   zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
@@ -123,5 +122,5 @@
                   pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
                ELSE                           ! case 2
-                  zmaxu = -ze3wu / fse3w(ji,jj,iku)
+                  zmaxu = -ze3wu / e3w_n(ji,jj,iku)
                   ! interpolated values of tracers
                   zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
@@ -132,5 +131,5 @@
                ! j- direction
                IF( ze3wv >= 0._wp ) THEN      ! case 1
-                  zmaxv =  ze3wv / fse3w(ji,jj+1,ikv)
+                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikv)
                   ! interpolated values of tracers
                   ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
@@ -138,5 +137,5 @@
                   pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
                ELSE                           ! case 2
-                  zmaxv =  -ze3wv / fse3w(ji,jj,ikv)
+                  zmaxv =  -ze3wv / e3w_n(ji,jj,ikv)
                   ! interpolated values of tracers
                   ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
@@ -149,35 +148,32 @@
          !
       END DO
-
-      ! horizontal derivative of density anomalies (rd)
-      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
-         pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ; 
+      !                
+      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
+         pgru(:,:) = 0._wp
+         pgrv(:,:) = 0._wp                ! depth of the partial step level
          DO jj = 1, jpjm1
             DO ji = 1, jpim1
                iku = mbku(ji,jj)
                ikv = mbkv(ji,jj)
-               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
-               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
-               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji  ,jj,iku)     ! i-direction: case 1
-               ELSE                        ;   zhi(ji,jj) = fsdept(ji+1,jj,iku)     ! -     -      case 2
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv)     ! j-direction: case 1
-               ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv)     ! -     -      case 2
-               ENDIF
-            END DO
-         END DO
-
-         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
-         ! step and store it in  zri, zrj for each  case
-         CALL eos( zti, zhi, zri )  
-         CALL eos( ztj, zhj, zrj )
-
-         ! Gradient of density at the last level 
-         DO jj = 1, jpjm1
+               ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
+               ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)     ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)     ! -     -      case 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)     ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)     ! -     -      case 2
+               ENDIF
+            END DO
+         END DO
+         !
+         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj 
+         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj 
+         !
+         DO jj = 1, jpjm1                 ! Gradient of density at the last level 
             DO ji = 1, jpim1
                iku = mbku(ji,jj)
                ikv = mbkv(ji,jj)
-               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
-               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+               ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
+               ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
                IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1
                ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2
@@ -192,22 +188,22 @@
       END IF
       !
-      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde')
+      IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde')
       !
    END SUBROUTINE zps_hde
    !
-   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv,   &
-      &                          prd, pgru, pgrv, pmru, pmrv, pgzu, pgzv, pge3ru, pge3rv,  &
-      &                   pgtui, pgtvi, pgrui, pgrvi, pmrui, pmrvi, pgzui, pgzvi, pge3rui, pge3rvi )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE zps_hde  ***
+   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi,  &
+      &                          prd, pgru, pgrv, pgrui, pgrvi )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE zps_hde_isf  ***
       !!                    
       !! ** Purpose :   Compute the horizontal derivative of T, S and rho
       !!      at u- and v-points with a linear interpolation for z-coordinate
-      !!      with partial steps.
+      !!      with partial steps for top (ice shelf) and bottom.
       !!
       !! ** Method  :   In z-coord with partial steps, scale factors on last 
       !!      levels are different for each grid point, so that T, S and rd 
       !!      points are not at the same depth as in z-coord. To have horizontal
-      !!      gradients again, we interpolate T and S at the good depth : 
+      !!      gradients again, we interpolate T and S at the good depth :
+      !!      For the bottom case:
       !!      Linear interpolation of T, S   
       !!         Computation of di(tb) and dj(tb) by vertical interpolation:
@@ -238,29 +234,22 @@
       !!          di(rho) = rd~ - rd(i,j,k)   or   rd(i+1,j,k) - rd~
       !!
+      !!      For the top case (ice shelf): As for the bottom case but upside down
+      !!
       !! ** Action  : compute for top and bottom interfaces
       !!              - pgtu, pgtv, pgtui, pgtvi: horizontal gradient of tracer at u- & v-points
       !!              - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points
-      !!              - pmru, pmrv, pmrui, pmrvi: horizontal sum of rho at u- & v- point (used in dynhpg with vvl)
-      !!              - pgzu, pgzv, pgzui, pgzvi: horizontal gradient of z at u- and v- point (used in dynhpg with vvl)
-      !!              - pge3ru, pge3rv, pge3rui, pge3rvi: horizontal gradient of rho weighted by local e3w at u- & v-points 
-      !!----------------------------------------------------------------------
-      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index
-      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields
-      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
-      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtui, pgtvi  ! hor. grad. of stra at u- & v-pts (ISF)
-      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv      ! hor. grad of prd at u- & v-pts (bottom)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pmru, pmrv      ! hor. sum  of prd at u- & v-pts (bottom)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzu, pgzv      ! hor. grad of z   at u- & v-pts (bottom)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3ru, pge3rv  ! hor. grad of prd weighted by local e3w at u- & v-pts (bottom)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi      ! hor. grad of prd at u- & v-pts (top)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pmrui, pmrvi      ! hor. sum  of prd at u- & v-pts (top)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzui, pgzvi      ! hor. grad of z   at u- & v-pts (top)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3rui, pge3rvi  ! hor. grad of prd weighted by local e3w at u- & v-pts (top)
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   )           ::  kt           ! ocean time-step index
+      INTEGER                              , INTENT(in   )           ::  kjpt         ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta          ! 4D tracers fields
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts 
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF)
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom)
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top)
       !
       INTEGER  ::   ji, jj, jn      ! Dummy loop indices
       INTEGER  ::   iku, ikv, ikum1, ikvm1,ikup1, ikvp1   ! partial step level (ocean bottom level) at u- and v-points
-      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv, zdzwu, zdzwv, zdzwuip1, zdzwvjp1  ! temporary scalars
+      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv             ! temporary scalars
       REAL(wp), DIMENSION(jpi,jpj)      ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos
       REAL(wp), DIMENSION(jpi,jpj,kjpt) ::  zti, ztj             ! 
@@ -269,8 +258,8 @@
       IF( nn_timing == 1 )  CALL timing_start( 'zps_hde_isf')
       !
-      pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ;
-      pgtui(:,:,:)=0.0_wp ; pgtvi(:,:,:)=0.0_wp ;
-      zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ;
-      zhi (:,:  )=0.0_wp ; zhj (:,:  )=0.0_wp ;
+      pgtu (:,:,:) = 0._wp   ;   pgtv (:,:,:) =0._wp
+      pgtui(:,:,:) = 0._wp   ;   pgtvi(:,:,:) =0._wp
+      zti  (:,:,:) = 0._wp   ;   ztj  (:,:,:) =0._wp
+      zhi  (:,:  ) = 0._wp   ;   zhj  (:,:  ) =0._wp
       !
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
@@ -278,244 +267,191 @@
          DO jj = 1, jpjm1
             DO ji = 1, jpim1
-               iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
-               ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
+
+               iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
+               ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
+               ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku)
+               ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)
+               !
+               ! i- direction
+               IF( ze3wu >= 0._wp ) THEN      ! case 1
+                  zmaxu =  ze3wu / e3w_n(ji+1,jj,iku)
+                  ! interpolated values of tracers
+                  zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
+                  ! gradient of  tracers
+                  pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+               ELSE                           ! case 2
+                  zmaxu = -ze3wu / e3w_n(ji,jj,iku)
+                  ! interpolated values of tracers
+                  zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
+                  ! gradient of tracers
+                  pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+               ENDIF
+               !
+               ! j- direction
+               IF( ze3wv >= 0._wp ) THEN      ! case 1
+                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikv)
+                  ! interpolated values of tracers
+                  ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+               ELSE                           ! case 2
+                  zmaxv =  -ze3wv / e3w_n(ji,jj,ikv)
+                  ! interpolated values of tracers
+                  ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+               ENDIF
+
+            END DO
+         END DO
+         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
+         !
+      END DO
+
+      ! horizontal derivative of density anomalies (rd)
+      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
+         pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ; 
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+
+               iku = mbku(ji,jj)
+               ikv = mbkv(ji,jj)
+               ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku)
+               ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)
+               !
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)    ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)    ! -     -      case 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)    ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)    ! -     -      case 2
+               ENDIF
+
+            END DO
+         END DO
+
+         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
+         ! step and store it in  zri, zrj for each  case
+         CALL eos( zti, zhi, zri )
+         CALL eos( ztj, zhj, zrj )
+
+         DO jj = 1, jpjm1                 ! Gradient of density at the last level 
+            DO ji = 1, jpim1
+               iku = mbku(ji,jj)
+               ikv = mbkv(ji,jj)
+               ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku)
+               ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)
+
+               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1
+               ELSE                        ;   pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1
+               ELSE                        ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2
+               ENDIF
+
+            END DO
+         END DO
+
+         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions
+         !
+      END IF
+      !
+      !     !==  (ISH)  compute grui and gruvi  ==!
+      !
+      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1
+               ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1
+               !
                ! (ISF) case partial step top and bottom in adjacent cell in vertical
                ! cannot used e3w because if 2 cell water column, we have ps at top and bottom
                ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj
                ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0
-               ze3wu  = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku))
-               ze3wv  = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv))
-               !
+               ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku)
+               ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) 
+
                ! i- direction
                IF( ze3wu >= 0._wp ) THEN      ! case 1
-                  zmaxu =  ze3wu / fse3w(ji+1,jj,iku)
-                  ! interpolated values of tracers
-                  zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
+                  zmaxu = ze3wu / e3w_n(ji+1,jj,ikup1)
+                  ! interpolated values of tracers
+                  zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) )
+                  ! gradient of tracers
+                  pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+               ELSE                           ! case 2
+                  zmaxu = - ze3wu / e3w_n(ji,jj,ikup1)
+                  ! interpolated values of tracers
+                  zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) )
                   ! gradient of  tracers
-                  pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
-               ELSE                           ! case 2
-                  zmaxu = -ze3wu / fse3w(ji,jj,iku)
-                  ! interpolated values of tracers
-                  zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
-                  ! gradient of tracers
-                  pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+                  pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
                ENDIF
                !
                ! j- direction
                IF( ze3wv >= 0._wp ) THEN      ! case 1
-                  zmaxv =  ze3wv / fse3w(ji,jj+1,ikv)
-                  ! interpolated values of tracers
-                  ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
-                  ! gradient of tracers
-                  pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
-               ELSE                           ! case 2
-                  zmaxv =  -ze3wv / fse3w(ji,jj,ikv)
-                  ! interpolated values of tracers
-                  ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
-                  ! gradient of tracers
-                  pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
-               ENDIF
-            END DO
-         END DO
-         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
+                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikvp1)
+                  ! interpolated values of tracers
+                  ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) )
+                  ! gradient of tracers
+                  pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+               ELSE                           ! case 2
+                  zmaxv =  - ze3wv / e3w_n(ji,jj,ikvp1)
+                  ! interpolated values of tracers
+                  ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) )
+                  ! gradient of tracers
+                  pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+               ENDIF
+
+            END DO
+         END DO
+         CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. ); CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
          !
       END DO
 
-      ! horizontal derivative of density anomalies (rd)
-      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
-         pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ; 
-         pgzu(:,:)=0.0_wp   ; pgzv(:,:)=0.0_wp ;
-         pmru(:,:)=0.0_wp   ; pmru(:,:)=0.0_wp ;
-         pge3ru(:,:)=0.0_wp ; pge3rv(:,:)=0.0_wp ;
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               iku = mbku(ji,jj)
-               ikv = mbkv(ji,jj)
-               ze3wu  = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku))
-               ze3wv  = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv))
-
-               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji+1,jj,iku) - ze3wu     ! i-direction: case 1
-               ELSE                        ;   zhi(ji,jj) = fsdept(ji  ,jj,iku) + ze3wu    ! -     -      case 2
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv) - ze3wv    ! j-direction: case 1
-               ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv) + ze3wv    ! -     -      case 2
-               ENDIF
-            END DO
-         END DO
-         
-         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
-         ! step and store it in  zri, zrj for each  case
-         CALL eos( zti, zhi, zri )  
-         CALL eos( ztj, zhj, zrj )
-
-         ! Gradient of density at the last level 
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
-               ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 )    ! last and before last ocean level at u- & v-points
-               ze3wu  = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku))
-               ze3wv  = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv))
-               IF( ze3wu >= 0._wp ) THEN 
-                  pgzu(ji,jj) = (fsde3w(ji+1,jj,iku) - ze3wu) - fsde3w(ji,jj,iku)
-                  pgru(ji,jj) = umask(ji,jj,iku) * ( zri(ji  ,jj) - prd(ji,jj,iku) )   ! i: 1
-                  pmru(ji,jj) = umask(ji,jj,iku) * ( zri(ji  ,jj) + prd(ji,jj,iku) )   ! i: 1 
-                  pge3ru(ji,jj) = umask(ji,jj,iku)                                                                  &
-                                * ( (fse3w(ji+1,jj,iku) - ze3wu )* ( zri(ji  ,jj    ) + prd(ji+1,jj,ikum1) + 2._wp) &
-                                   - fse3w(ji  ,jj,iku)          * ( prd(ji  ,jj,iku) + prd(ji  ,jj,ikum1) + 2._wp) )  ! j: 2
-               ELSE  
-                  pgzu(ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) + ze3wu)
-                  pgru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) )   ! i: 2
-                  pmru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) )   ! i: 2
-                  pge3ru(ji,jj) = umask(ji,jj,iku)                                                                  &
-                                * (  fse3w(ji+1,jj,iku)          * ( prd(ji+1,jj,iku) + prd(ji+1,jj,ikum1) + 2._wp) &
-                                   -(fse3w(ji  ,jj,iku) + ze3wu) * ( zri(ji  ,jj    ) + prd(ji  ,jj,ikum1) + 2._wp) )  ! j: 2
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN
-                  pgzv(ji,jj) = (fsde3w(ji,jj+1,ikv) - ze3wv) - fsde3w(ji,jj,ikv) 
-                  pgrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )   ! j: 1
-                  pmrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj  ) + prd(ji,jj,ikv) )   ! j: 1
-                  pge3rv(ji,jj) = vmask(ji,jj,ikv)                                                                  &
-                                * ( (fse3w(ji,jj+1,ikv) - ze3wv )* ( zrj(ji,jj      ) + prd(ji,jj+1,ikvm1) + 2._wp) &
-                                   - fse3w(ji,jj  ,ikv)          * ( prd(ji,jj  ,ikv) + prd(ji,jj  ,ikvm1) + 2._wp) )  ! j: 2
-               ELSE 
-                  pgzv(ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) + ze3wv)
-                  pgrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )   ! j: 2
-                  pmrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) )   ! j: 2
-                  pge3rv(ji,jj) = vmask(ji,jj,ikv)                                                                  &
-                                * (  fse3w(ji,jj+1,ikv)          * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikvm1) + 2._wp) &
-                                   -(fse3w(ji,jj  ,ikv) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikvm1) + 2._wp) )  ! j: 2
-               ENDIF
-            END DO
-         END DO
-         CALL lbc_lnk( pgru   , 'U', -1. )   ;   CALL lbc_lnk( pgrv   , 'V', -1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( pmru   , 'U',  1. )   ;   CALL lbc_lnk( pmrv   , 'V',  1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( pgzu   , 'U', -1. )   ;   CALL lbc_lnk( pgzv   , 'V', -1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( pge3ru , 'U', -1. )   ;   CALL lbc_lnk( pge3rv , 'V', -1. )   ! Lateral boundary conditions
-         !
-      END IF
-         ! (ISH)  compute grui and gruvi
-      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            !
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               iku = miku(ji,jj)   ;  ikup1 = miku(ji,jj) + 1
-               ikv = mikv(ji,jj)   ;  ikvp1 = mikv(ji,jj) + 1
-               !
-               ! (ISF) case partial step top and bottom in adjacent cell in vertical
-               ! cannot used e3w because if 2 cell water column, we have ps at top and bottom
-               ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj
-               ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0
-               ze3wu  = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 
-               ze3wv  = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv))
-               ! i- direction
-               IF( ze3wu >= 0._wp ) THEN      ! case 1
-                  zmaxu = ze3wu / fse3w(ji+1,jj,iku+1)
-                  ! interpolated values of tracers
-                  zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku+1,jn) - pta(ji+1,jj,iku,jn) )
-                  ! gradient of tracers
-                  pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
-               ELSE                           ! case 2
-                  zmaxu = - ze3wu / fse3w(ji,jj,iku+1)
-                  ! interpolated values of tracers
-                  zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku+1,jn) - pta(ji,jj,iku,jn) )
-                  ! gradient of  tracers
-                  pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
-               ENDIF
-               !
-               ! j- direction
-               IF( ze3wv >= 0._wp ) THEN      ! case 1
-                  zmaxv =  ze3wv / fse3w(ji,jj+1,ikv+1)
-                  ! interpolated values of tracers
-                  ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv+1,jn) - pta(ji,jj+1,ikv,jn) )
-                  ! gradient of tracers
-                  pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
-               ELSE                           ! case 2
-                  zmaxv =  - ze3wv / fse3w(ji,jj,ikv+1)
-                  ! interpolated values of tracers
-                  ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv+1,jn) - pta(ji,jj,ikv,jn) )
-                  ! gradient of tracers
-                  pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
-               ENDIF
-            END DO!!
-         END DO!!
-         CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
-         !
-      END DO
-
-      ! horizontal derivative of density anomalies (rd)
-      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
-         pgrui(:,:)  =0.0_wp ; pgrvi(:,:)  =0.0_wp ;
-         pgzui(:,:)  =0.0_wp ; pgzvi(:,:)  =0.0_wp ;
-         pmrui(:,:)  =0.0_wp ; pmrui(:,:)  =0.0_wp ;
-         pge3rui(:,:)=0.0_wp ; pge3rvi(:,:)=0.0_wp ;
-
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
+      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
+         !
+         pgrui(:,:)  =0.0_wp; pgrvi(:,:)  =0.0_wp;
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+
                iku = miku(ji,jj)
                ikv = mikv(ji,jj)
-               ze3wu  = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku))
-               ze3wv  = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv))
-
-               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji+1,jj,iku) + ze3wu    ! i-direction: case 1
-               ELSE                        ;   zhi(ji,jj) = fsdept(ji  ,jj,iku) - ze3wu    ! -     -      case 2
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv) + ze3wv    ! j-direction: case 1
-               ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv) - ze3wv    ! -     -      case 2
-               ENDIF
-            END DO
-         END DO
-
-         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
-         ! step and store it in  zri, zrj for each  case
-         CALL eos( zti, zhi, zri )  
-         CALL eos( ztj, zhj, zrj )
-
-         ! Gradient of density at the last level 
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               iku = miku(ji,jj) ; ikup1 = miku(ji,jj) + 1
-               ikv = mikv(ji,jj) ; ikvp1 = mikv(ji,jj) + 1
-               ze3wu  = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku))
-               ze3wv  = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv))
-               IF( ze3wu >= 0._wp ) THEN
-                 pgzui  (ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku)
-                 pgrui  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) - prd(ji,jj,iku) )          ! i: 1
-                 pmrui  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) + prd(ji,jj,iku) )          ! i: 1 
-                 pge3rui(ji,jj) = umask(ji,jj,iku+1)                                                                  &
-                                * ( (fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj    ) + prd(ji+1,jj,iku+1) + 2._wp)   &
-                                   - fse3w(ji  ,jj,iku+1)          * (prd(ji,jj,iku) + prd(ji  ,jj,iku+1) + 2._wp)   ) ! i: 1
-               ELSE
-                 pgzui  (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu)
-                 pgrui  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) - zri(ji,jj) )      ! i: 2
-                 pmrui  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) + zri(ji,jj) )      ! i: 2
-                 pge3rui(ji,jj) = umask(ji,jj,iku+1)                                                                   &
-                                * (  fse3w(ji+1,jj,iku+1)          * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp)  &
-                                   -(fse3w(ji  ,jj,iku+1) + ze3wu) * (zri(ji,jj      ) + prd(ji  ,jj,iku+1) + 2._wp)  )     ! i: 2
-               ENDIF
-               IF( ze3wv >= 0._wp ) THEN
-                 pgzvi  (ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv) 
-                 pgrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )        ! j: 1
-                 pmrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) + prd(ji,jj,ikv) )        ! j: 1
-                 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1)                                                                  & 
-                                * ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj    ) + prd(ji,jj+1,ikv+1) + 2._wp)  &
-                                   - fse3w(ji,jj  ,ikv+1)          * ( prd(ji,jj,ikv) + prd(ji,jj  ,ikv+1) + 2._wp)  ) ! j: 1
-                                  ! + 2 due to the formulation in density and not in anomalie in hpg sco
-               ELSE
-                 pgzvi  (ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv)
-                 pgrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )     ! j: 2
-                 pmrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) + zrj(ji,jj) )     ! j: 2
-                 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1)                                                                   &
-                                * (  fse3w(ji,jj+1,ikv+1)          * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) &
-                                   -(fse3w(ji,jj  ,ikv+1) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikv+1) + 2._wp) )  ! j: 2
-               ENDIF
-            END DO
-         END DO
-         CALL lbc_lnk( pgrui   , 'U', -1. )   ;   CALL lbc_lnk( pgrvi   , 'V', -1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( pmrui   , 'U',  1. )   ;   CALL lbc_lnk( pmrvi   , 'V',  1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( pgzui   , 'U', -1. )   ;   CALL lbc_lnk( pgzvi   , 'V', -1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( pge3rui , 'U', -1. )   ;   CALL lbc_lnk( pge3rvi , 'V', -1. )   ! Lateral boundary conditions
+               ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku)
+               ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) 
+               !
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)    ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)    ! -     -      case 2
+               ENDIF
+
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)    ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)    ! -     -      case 2
+               ENDIF
+
+            END DO
+         END DO
+         !
+         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj 
+         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj 
+         !
+         DO jj = 1, jpjm1                 ! Gradient of density at the last level 
+            DO ji = 1, jpim1
+               iku = miku(ji,jj) 
+               ikv = mikv(ji,jj) 
+               ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku)
+               ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) 
+
+               IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj      ) - prd(ji,jj,iku) ) ! i: 1
+               ELSE                      ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj  ,iku) - zri(ji,jj    ) ) ! i: 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji  ,jj      ) - prd(ji,jj,ikv) ) ! j: 1
+               ELSE                      ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji  ,jj+1,ikv) - zrj(ji,jj    ) ) ! j: 2
+               ENDIF
+
+            END DO
+         END DO
+         CALL lbc_lnk( pgrui   , 'U', -1. ); CALL lbc_lnk( pgrvi   , 'V', -1. )   ! Lateral boundary conditions
          !
       END IF  
       !
-      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde_isf')
+      IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde_isf')
       !
    END SUBROUTINE zps_hde_isf
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90	(revision 6808)
@@ -71,9 +71,7 @@
    INTEGER, PUBLIC, PARAMETER ::   jpdyn_bfri = 12     !: implicit bottom friction (ln_bfrimp=.TRUE.)
    INTEGER, PUBLIC, PARAMETER ::   jpdyn_ken  = 13     !: use for calculation of KE
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_spgflt  = 14  !: filter contribution to surface pressure gradient (spg_flt)
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_spgexp  = 15  !: explicit contribution to surface pressure gradient (spg_flt)
    !
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90	(revision 6808)
@@ -36,5 +36,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -113,8 +112,4 @@
       CASE( jpdyn_spg )   ;   CALL iom_put( "utrd_spg", putrd )    ! surface pressure gradient
                               CALL iom_put( "vtrd_spg", pvtrd )
-      CASE( jpdyn_spgexp );   CALL iom_put( "utrd_spgexp", putrd ) ! surface pressure gradient (explicit)
-                              CALL iom_put( "vtrd_spgexp", pvtrd )
-      CASE( jpdyn_spgflt );   CALL iom_put( "utrd_spgflt", putrd ) ! surface pressure gradient (filtered)
-                              CALL iom_put( "vtrd_spgflt", pvtrd )
       CASE( jpdyn_pvo )   ;   CALL iom_put( "utrd_pvo", putrd )    ! planetary vorticity
                               CALL iom_put( "vtrd_pvo", pvtrd )
@@ -147,6 +142,6 @@
                               !                                    ! wind stress trends
                               CALL wrk_alloc( jpi, jpj, z2dx, z2dy )
-                              z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( fse3u(:,:,1) * rau0 )
-                              z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( fse3v(:,:,1) * rau0 )
+                              z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rau0 )
+                              z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rau0 )
                               CALL iom_put( "utrd_tau", z2dx )
                               CALL iom_put( "vtrd_tau", z2dy )
@@ -165,6 +160,6 @@
                               	         ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels
                                           ikbv = mbkv(ji,jj)
-                                          z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) / fse3u(ji,jj,ikbu)
-                                          z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) / fse3v(ji,jj,ikbv)
+                                          z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu)
+                                          z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv)
                               	      END DO
                               	   END DO
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90	(revision 6808)
@@ -4,6 +4,6 @@
    !! Ocean diagnostics:  global domain averaged tracer and momentum trends
    !!=====================================================================
-   !! History :  1.0  !  2004-08 (C. Talandier) New trends organization
-   !!            3.5  !  2012-02 (G. Madec)  add 3D tracer zdf trend output using iom
+   !! History :  1.0  !  2004-08  (C. Talandier) New trends organization
+   !!            3.5  !  2012-02  (G. Madec)  add 3D tracer zdf trend output using iom
    !!----------------------------------------------------------------------
 
@@ -19,6 +19,6 @@
    USE trd_oce         ! trends: ocean variables
    USE phycst          ! physical constants
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE ldfdyn_oce      ! ocean dynamics: lateral physics
+   USE ldftra          ! lateral diffusion: eddy diffusivity & EIV coeff.
+   USE ldfdyn          ! ocean dynamics: lateral physics
    USE zdf_oce         ! ocean vertical physics
    USE zdfbfr          ! bottom friction
@@ -26,4 +26,5 @@
    USE eosbn2          ! equation of state
    USE phycst          ! physical constants
+   !
    USE lib_mpp         ! distibuted memory computing library
    USE in_out_manager  ! I/O manager
@@ -51,5 +52,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
 #  include "zdfddm_substitute.h90"
@@ -91,5 +91,5 @@
       	      DO jj = 1, jpj
       	         DO ji = 1, jpi        
-      	            zvm = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+      	            zvm = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
       	            zvt = ptrdx(ji,jj,jk) * zvm
       	            zvs = ptrdy(ji,jj,jk) * zvm
@@ -102,9 +102,9 @@
             END DO
             !                       ! linear free surface: diagnose advective flux trough the fixed k=1 w-surface
-            IF( .NOT.lk_vvl .AND. ktrd == jptra_zad ) THEN  
-               tmo(jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * e1e2t(:,:) )
-               smo(jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * e1e2t(:,:)  )
-               t2 (jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) * e1e2t(:,:)  )
-               s2 (jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) * e1e2t(:,:)  )
+            IF( ln_linssh .AND. ktrd == jptra_zad ) THEN  
+               tmo(jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:) )
+               smo(jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:)  )
+               t2 (jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:)  )
+               s2 (jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:)  )
             ENDIF
             !
@@ -125,7 +125,7 @@
                   DO ji = 1, jpim1
                      zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)   &
-                        &                  * e1u    (ji  ,jj  ) * e2u    (ji,jj) * fse3u(ji,jj,jk)
+                        &                  * e1u    (ji  ,jj  ) * e2u    (ji,jj) * e3u_n(ji,jj,jk)
                      zvs = ptrdy(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   &
-                        &                  * e1v    (ji  ,jj  ) * e2v    (ji,jj) * fse3u(ji,jj,jk)
+                        &                  * e1v    (ji  ,jj  ) * e2v    (ji,jj) * e3u_n(ji,jj,jk)
                      umo(ktrd) = umo(ktrd) + zvt
                      vmo(ktrd) = vmo(ktrd) + zvs
@@ -142,5 +142,5 @@
                         &                       * z1_2rau0 * e1u    (ji  ,jj  ) * e2u    (ji,jj)
                      zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   &
-                        &                       * z1_2rau0 * e1v    (ji  ,jj  ) * e2v    (ji,jj) * fse3u(ji,jj,jk)
+                        &                       * z1_2rau0 * e1v    (ji  ,jj  ) * e2v    (ji,jj) * e3u_n(ji,jj,jk)
                      umo(jpdyn_tau) = umo(jpdyn_tau) + zvt
                      vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs
@@ -224,6 +224,6 @@
             DO jj = 1, jpjm1
                DO ji = 1, jpim1
-                  zkx(ji,jj,jk) = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )
-                  zky(ji,jj,jk) = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) )
+                  zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )
+                  zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) )
                END DO
             END DO
@@ -236,5 +236,5 @@
                      &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               &
                      &                 + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )   )           &
-                     &              / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                     &              / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj)
                END DO
             END DO
@@ -245,5 +245,5 @@
          peke = 0._wp
          DO jk = 1, jpkm1
-            peke = peke + SUM( zkepe(:,:,jk) * fsdept(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) )
+            peke = peke + SUM( zkepe(:,:,jk) * gdept_n(:,:,jk) * e1e2t(:,:) * e3t_n(:,:,jk) )
          END DO
          peke = grav * peke
@@ -529,5 +529,5 @@
       tvolt = 0._wp
       DO jk = 1, jpkm1
-         tvolt = tvolt + SUM( e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) )
+         tvolt = tvolt + SUM( e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) )
       END DO
       IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain
@@ -546,6 +546,6 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
-               tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
+               tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u_n(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
+               tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v_n(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
             END DO
          END DO
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90	(revision 6808)
@@ -26,5 +26,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -91,5 +90,5 @@
 !!gm end
       !
-      IF( lk_vvl .AND. ( l_trdtra .OR. l_trddyn ) )  CALL ctl_stop( 'trend diagnostics with variable volume not validated' )
+      IF( .NOT.ln_linssh .AND. ( l_trdtra .OR. l_trddyn ) )  CALL ctl_stop( 'trend diagnostics with variable volume not validated' )
       
 !!gm  : Potential BUG : 3D output only for vector invariant form!  add a ctl_stop or code the flux form case
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90	(revision 6808)
@@ -13,14 +13,15 @@
    USE oce            ! ocean dynamics and tracers variables
    USE dom_oce        ! ocean space and time domain variables
+   USE sbc_oce        ! surface boundary condition: ocean
    USE zdf_oce        ! ocean vertical physics variables
    USE trd_oce        ! trends: ocean variables
 !!gm   USE dynhpg          ! hydrostatic pressure gradient   
    USE zdfbfr         ! bottom friction
-   USE ldftra_oce     ! ocean active tracers lateral physics
-   USE sbc_oce        ! surface boundary condition: ocean
+   USE ldftra         ! ocean active tracers lateral physics
    USE phycst         ! physical constants
    USE trdvor         ! ocean vorticity trends 
    USE trdglo         ! trends:global domain averaged
-   USE trdmxl         ! ocean active mixed layer tracers trends 
+   USE trdmxl         ! ocean active mixed layer tracers trends
+   !
    USE in_out_manager ! I/O manager
    USE iom            ! I/O manager library
@@ -40,5 +41,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -93,12 +93,10 @@
       CALL lbc_lnk( putrd, 'U', -1. )   ;   CALL lbc_lnk( pvtrd, 'V', -1. )      ! lateral boundary conditions
       !
-      IF ( lk_vvl .AND. kt /= nkstp ) THEN   ! Variable volume: set box volume at the 1st call of kt time step
-         nkstp = kt
-         DO jk = 1, jpkm1
-            bu   (:,:,jk) =  e1u(:,:) * e2u(:,:) * fse3u_n(:,:,jk)
-            bv   (:,:,jk) =  e1v(:,:) * e2v(:,:) * fse3v_n(:,:,jk)
-            r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) ) * tmask(:,:,jk)
-         END DO
-      ENDIF
+      nkstp = kt
+      DO jk = 1, jpkm1
+         bu   (:,:,jk) =    e1e2u(:,:) * e3u_n(:,:,jk)
+         bv   (:,:,jk) =    e1e2v(:,:) * e3v_n(:,:,jk)
+         r1_bt(:,:,jk) = r1_e1e2t(:,:) / e3t_n(:,:,jk) * tmask(:,:,jk)
+      END DO
       !
       zke(:,:,jpk) = 0._wp
@@ -117,28 +115,26 @@
       !
       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 
-                                 !                                   ! 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) 
+         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_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(:,:) ) * e1e2u(:,:) * umask(:,:,1)
+                           z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1)
+                           zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp
+                           DO jj = 2, jpj
+                              DO ji = 2, jpi
+                                 zke2d(ji,jj) = r1_rau0 * 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....
@@ -159,8 +155,8 @@
 !               END DO
 !            END DO
-!                              CALL iom_put( "ketrd_bfr", zke2d )    ! bottom friction (explicit case)
+!                                    CALL iom_put( "ketrd_bfr"  , zke2d )   ! bottom friction (explicit case)
 !         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....
@@ -171,6 +167,6 @@
 !                  ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels
 !                  ikbv = mbkv(ji,jj)
-!                  z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu) / fse3u(ji,jj,ikbu)
-!                  z2dy(ji,jj) = un(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv) / fse3v(ji,jj,ikbv)
+!                  z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu)
+!                  z2dy(ji,jj) = un(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv)
 !               END DO
 !            END DO
@@ -184,12 +180,11 @@
 !                              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
@@ -226,9 +221,9 @@
       
       !  Surface value (also valid in partial step case)
-      zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * wn(:,:,1) * fse3w(:,:,1)
+      zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * wn(:,:,1) * e3w_n(:,:,1)
 
       ! interior value (2=<jk=<jpkm1)
       DO jk = 2, jpk
-         zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * wn(:,:,jk) * fse3w(:,:,jk)
+         zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * wn(:,:,jk) * e3w_n(:,:,jk)
       END DO
 
@@ -237,5 +232,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zcoef = 0.5_wp / fse3t(ji,jj,jk)
+               zcoef = 0.5_wp / e3t_n(ji,jj,jk)
                pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk)
             END DO
@@ -263,16 +258,5 @@
       ENDIF
       !                           ! allocate box volume arrays
-      IF ( trd_ken_alloc() /= 0 )   CALL ctl_stop('trd_ken_alloc: failed to allocate arrays')
-      !
-!!gm      IF( .NOT. (ln_hpg_zco.OR.ln_hpg_zps) )   &
-!!gm         &   CALL ctl_stop('trd_ken_init : only full and partial cells are coded for conversion rate')
-      !
-      IF ( .NOT.lk_vvl ) THEN     ! constant volume: bu, bv, 1/bt computed one for all
-         DO jk = 1, jpkm1
-            bu   (:,:,jk) =  e1u(:,:) * e2u(:,:) * fse3u_n(:,:,jk)
-            bv   (:,:,jk) =  e1v(:,:) * e2v(:,:) * fse3v_n(:,:,jk)
-            r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) )
-         END DO
-      ENDIF
+      IF( trd_ken_alloc() /= 0 )   CALL ctl_stop('trd_ken_alloc: failed to allocate arrays')
       !
    END SUBROUTINE trd_ken_init
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90	(revision 6808)
@@ -22,7 +22,6 @@
    USE trd_oce         ! trends: ocean variables
    USE trdmxl_oce      ! ocean variables trends
-   USE ldftra_oce      ! ocean active tracers lateral physics
+   USE ldftra          ! lateral diffusion: eddy diffusivity & EIV coeff.
    USE zdf_oce         ! ocean vertical physics
-   USE in_out_manager  ! I/O manager
    USE phycst          ! Define parameters for the routines
    USE dianam          ! build the name of file (routine)
@@ -30,8 +29,9 @@
    USE zdfmxl          ! mixed layer depth
    USE zdfddm          ! ocean vertical physics: double diffusion
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE trdmxl_rst      ! restart for diagnosing the ML trends
+   !
+   USE in_out_manager  ! I/O manager
    USE ioipsl          ! NetCDF library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE diadimg         ! dimg direct access file format output
-   USE trdmxl_rst      ! restart for diagnosing the ML trends
    USE prtctl          ! Print control
    USE restart         ! for lrst_oce
@@ -48,6 +48,4 @@
 
    INTEGER ::   nkstp       ! current time step 
-
-
 
 !!gm  to be moved from trdmxl_oce
@@ -72,6 +70,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldftra_substitute.h90"
 #  include "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
@@ -126,5 +122,5 @@
             DO jj = 1,jpj
                DO ji = 1,jpi
-                  IF( jk - kmxln(ji,jj) < 0 )   wkx(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk)
+                  IF( jk - kmxln(ji,jj) < 0 )   wkx(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
                END DO
             END DO
@@ -165,11 +161,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( ....
 !!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) )
@@ -298,5 +294,5 @@
       !! 
       !! ** Purpose :  Compute and cumulate the mixed layer trends over an analysis
-      !!               period, and write NetCDF (or dimg) outputs.
+      !!               period, and write NetCDF outputs.
       !!
       !! ** Method/usage :
@@ -349,8 +345,4 @@
       REAL(wp), POINTER, DIMENSION(:,:  ) ::  ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2  
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztmltrd2, zsmltrd2   ! only needed for mean diagnostics
-#if defined key_dimgout
-      INTEGER ::  iyear,imon,iday
-      CHARACTER(LEN=80) :: cltext, clmode
-#endif
       !!----------------------------------------------------------------------
   
@@ -801,7 +793,4 @@
       END IF
 
-      IF( nn_cla == 1 )   CALL ctl_warn( '      You set n_cla = 1. Note that the Mixed-Layer diagnostics  ',   &
-         &                               '      are not exact along the corresponding straits.            ')
-
       !                                   ! allocate trdmxl arrays
       IF( trd_mxl_alloc()    /= 0 )   CALL ctl_stop( 'STOP', 'trd_mxl_init : unable to allocate trdmxl     arrays' )
@@ -810,6 +799,5 @@
 
 
-
-   	nkstp     = nit000 - 1              ! current time step indicator initialization
+      nkstp     = nit000 - 1              ! current time step indicator initialization
 
 
@@ -851,5 +839,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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90	(revision 6808)
@@ -15,5 +15,5 @@
 
    !                                                !* mixed layer trend indices
-   INTEGER, PUBLIC, PARAMETER ::   jpltrd = 11      !: number of mixed-layer trends arrays
+   INTEGER, PUBLIC, PARAMETER ::   jpltrd = 12      !: 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   !: asselin trend (**MUST BE THE LAST ONE**)
-   INTEGER, PUBLIC, PARAMETER ::   jpmxl_atf  = 12   !: asselin trend (**MUST BE THE LAST ONE**)
+   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**)
    !                                                            !!* Namelist namtrd_mxl:  trend diagnostics in the mixed layer *
    INTEGER           , PUBLIC ::   nn_ctls  = 0                  !: control surface type for trends vertical integration
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90	(revision 6808)
@@ -62,5 +62,4 @@
             WRITE(numout,*)
             SELECT CASE ( jprstlib )
-            CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ocean restart_mxl binary file: '//clname
             CASE DEFAULT         ;   WRITE(numout,*) '             open ocean restart_mxl NetCDF file: '//clname
             END SELECT
@@ -147,14 +146,4 @@
       clpath = TRIM(cn_ocerst_indir)
       IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
-
-      IF ( jprstlib == jprstdimg ) THEN
-         ! eventually read netcdf file (monobloc)  for restarting on different number of processors
-         ! if {cn_trdrst_in}.nc exists, then set jlibalt to jpnf90
-         INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_in)//'.nc', EXIST = llok )
-         IF ( llok ) THEN   ;   jlibalt = jpnf90   
-         ELSE               ;   jlibalt = jprstlib   
-         ENDIF
-      ENDIF
-
       CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_in), inum, kiolib = jlibalt ) 
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90	(revision 6808)
@@ -17,7 +17,8 @@
    USE trd_oce        ! trends: ocean variables
    USE eosbn2         ! equation of state and related derivatives
-   USE ldftra_oce     ! ocean active tracers lateral physics
+   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
    USE zdfddm         ! vertical physics: double diffusion
    USE phycst         ! physical constants
+   !
    USE in_out_manager ! I/O manager
    USE iom            ! I/O manager library
@@ -36,5 +37,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
@@ -78,5 +78,5 @@
       zpe(:,:,:) = 0._wp
       !
-      IF ( kt /= nkstp ) THEN   ! full eos: set partial derivatives at the 1st call of kt time step
+      IF( kt /= nkstp ) THEN     ! full eos: set partial derivatives at the 1st call of kt time step
          nkstp = kt
          CALL eos_pen( tsn, rab_PE, zpe )
@@ -96,10 +96,10 @@
       CASE ( jptra_yad  )   ;   CALL iom_put( "petrd_yad", zpe )   ! merid.   advection
       CASE ( jptra_zad  )   ;   CALL iom_put( "petrd_zad", zpe )   ! vertical advection
-                                IF( .NOT.lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface
+                                IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface
                                    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)    &
+                                     & ) / e3t_n(:,:,1)
                                    CALL iom_put( "petrd_sad" , z2d )
                                    CALL wrk_dealloc( jpi, jpj, z2d )
@@ -115,9 +115,9 @@
       CASE ( jptra_bbc  )   ;   CALL iom_put( "petrd_bbc" , zpe )   ! bottom bound cond (geoth flux)
       CASE ( jptra_atf  )   ;   CALL iom_put( "petrd_atf" , zpe )   ! asselin time filter (last trend)
-                                !IF( .NOT.lk_vvl ) THEN                   ! cst volume : ssh term (otherwise include in e3t variation)
+                                !IF( ln_linssh ) THEN                   ! cst volume : ssh term (otherwise include in e3t variation)
                                 !   CALL wrk_alloc( jpi, jpj, z2d )
                                 !   z2d(:,:) = ( ssha(:,:) - sshb(:,:) )                 &
                                 !      &     * (   dPE_dt(:,:,1) * tsn(:,:,1,jp_tem)    &
-                                !      &         + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / ( fse3t(:,:,1) * pdt )
+                                !      &         + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / ( e3t_n(:,:,1) * pdt )
                                 !   CALL iom_put( "petrd_sad" , z2d )
                                 !   CALL wrk_dealloc( jpi, jpj, z2d )
@@ -150,5 +150,5 @@
       rab_pe(:,:,:,:) = 0._wp
       !
-      IF ( lk_vvl               )   CALL ctl_stop('trd_pen_init : PE trends not coded for variable volume')
+      IF( .NOT.ln_linssh )   CALL ctl_stop('trd_pen_init : PE trends not coded for variable volume')
       !
       nkstp     = nit000 - 1
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 6808)
@@ -23,7 +23,9 @@
    USE trdpen         ! trends: Potential ENergy
    USE trdmxl         ! ocean active mixed layer tracers trends 
-   USE ldftra_oce     ! ocean active tracers lateral physics
+   USE ldftra         ! ocean active tracers lateral physics
+   USE ldfslp
    USE zdfddm         ! vertical physics: double diffusion
    USE phycst         ! physical constants
+   !
    USE in_out_manager ! I/O manager
    USE iom            ! I/O manager library
@@ -36,10 +38,7 @@
    PUBLIC   trd_tra   ! called by all tra_... modules
 
-   REAL(wp) ::   r2dt   ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0
-
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   trdtx, trdty, trdt   ! use to store the temperature trends
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
@@ -128,12 +127,12 @@
             zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp
             DO jk = 2, jpk
-               zwt(:,:,jk) =   avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk)
-               zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk)
+               zwt(:,:,jk) =   avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk)
+               zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk)
             END DO
             !
             ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp
             DO jk = 1, jpkm1
-               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk)
-               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk) 
+               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t_n(:,:,jk)
+               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t_n(:,:,jk) 
             END DO
             CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )  
@@ -205,5 +204,5 @@
                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)
+                 &              * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
             END DO
          END DO
@@ -227,6 +226,6 @@
       !!----------------------------------------------------------------------
 
-      IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdtra (restart with Euler time stepping)
-      ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdttra (leapfrog)
+      IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdt (restart with Euler time stepping)
+      ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdt (leapfrog)
       ENDIF
 
@@ -304,8 +303,8 @@
       CASE( jptra_zad  )   ;   CALL iom_put( "ttrd_zad" , ptrdx )        ! z- vertical   advection
                                CALL iom_put( "strd_zad" , ptrdy )
-                               IF( .NOT. lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface
+                               IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface
                                	 CALL wrk_alloc( jpi, jpj, z2dx, z2dy )
-                                  z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1)
-                                  z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1)
+                                  z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1)
+                                  z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1)
                                   CALL iom_put( "ttrd_sad", z2dx )
                                   CALL iom_put( "strd_sad", z2dy )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 6808)
@@ -20,10 +20,11 @@
    USE sbc_oce         ! surface boundary condition: ocean
    USE phycst          ! Define parameters for the routines
-   USE ldfdyn_oce      ! ocean active tracers: lateral physics
+   USE ldfdyn          ! ocean active tracers: lateral physics
    USE dianam          ! build the name of file (routine)
    USE zdfmxl          ! mixed layer depth
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   !
    USE in_out_manager  ! I/O manager
    USE ioipsl          ! NetCDF library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp         ! MPP library
    USE wrk_nemo        ! Memory allocation
@@ -56,6 +57,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "ldfdyn_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -85,5 +84,5 @@
       !! 
       !! ** Purpose :  computation of cumulated trends over analysis period
-      !!               and make outputs (NetCDF or DIMG format)
+      !!               and make outputs (NetCDF format)
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends 
@@ -109,6 +108,6 @@
          DO jj = 2, jpjm1                                                             ! wind stress trends
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(ji,jj,1) * rau0 )
-               ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(ji,jj,1) * rau0 )
+               ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_n(ji,jj,1) * rau0 )
+               ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * rau0 )
             END DO
          END DO
@@ -183,18 +182,18 @@
                ikbu = mbkv(ji,jj)
                ikbv = mbkv(ji,jj)            
-               zudpvor(ji,jj) = putrdvor(ji,jj) * fse3u(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu)
-               zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv)
+               zudpvor(ji,jj) = putrdvor(ji,jj) * e3u_n(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu)
+               zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v_n(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv)
             END DO
          END DO
          !
       CASE( jpvor_swf )        ! wind stress
-         zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1)
-         zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1)
+         zudpvor(:,:) = putrdvor(:,:) * e3u_n(:,:,1) * e1u(:,:) * umask(:,:,1)
+         zvdpvor(:,:) = pvtrdvor(:,:) * e3v_n(:,:,1) * e2v(:,:) * vmask(:,:,1)
          !
       END SELECT
 
       ! Average except for Beta.V
-      zudpvor(:,:) = zudpvor(:,:) * hur(:,:)
-      zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)
+      zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:)
+      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:)
    
       ! Curl
@@ -270,6 +269,6 @@
       ! putrdvor and pvtrdvor terms
       DO jk = 1,jpk
-        zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * fse3u(:,:,jk) * e1u(:,:) * umask(:,:,jk)
-        zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * fse3v(:,:,jk) * e2v(:,:) * vmask(:,:,jk)
+        zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u_n(:,:,jk) * e1u(:,:) * umask(:,:,jk)
+        zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v_n(:,:,jk) * e2v(:,:) * vmask(:,:,jk)
       END DO
 
@@ -286,10 +285,10 @@
          END DO
          ! Average of the Curl and Surface mask
-         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:) * fmask(:,:,1)
+         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu_n(:,:) * fmask(:,:,1)
       ENDIF
       !
       ! Average 
-      zudpvor(:,:) = zudpvor(:,:) * hur(:,:)
-      zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)
+      zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:)
+      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:)
       !
       ! Curl
@@ -318,5 +317,5 @@
       !! 
       !! ** Purpose :  computation of cumulated trends over analysis period
-      !!               and make outputs (NetCDF or DIMG format)
+      !!               and make outputs (NetCDF format)
       !!----------------------------------------------------------------------
       INTEGER                   , INTENT(in   ) ::   kt             ! time step
@@ -351,10 +350,10 @@
       ! Vertically averaged velocity
       DO jk = 1, jpk - 1
-         zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * fse3u(:,:,jk)
-         zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * fse3v(:,:,jk)
+         zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * e3u_n(:,:,jk)
+         zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * e3v_n(:,:,jk)
       END DO
  
-      zun(:,:) = zun(:,:) * hur(:,:)
-      zvn(:,:) = zvn(:,:) * hvr(:,:)
+      zun(:,:) = zun(:,:) * r1_hu_n(:,:)
+      zvn(:,:) = zvn(:,:) * r1_hv_n(:,:)
 
       ! Curl
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 6808)
@@ -16,5 +16,5 @@
    PUBLIC  zdf_oce_alloc    ! Called in nemogcm.F90
 
-#if defined key_zdfcst   ||   defined key_esopa
+#if defined key_zdfcst
    LOGICAL, PARAMETER, PUBLIC ::   lk_zdfcst        = .TRUE.         !: constant vertical mixing flag
 #else
@@ -43,5 +43,8 @@
    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avmu , avmv    !: vertical viscosity coef at uw- & vw-pts       [m2/s]
    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm  , avt     !: vertical viscosity & diffusivity coef at w-pt [m2/s]
- 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en              !: now turbulent kinetic energy   [m2/s2]
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
@@ -59,6 +62,9 @@
          &     avtb(jpk) , bfrva(jpi,jpj) , avtb_2d(jpi,jpj) ,      &
          &     tfrua(jpi, jpj), tfrva(jpi, jpj)              ,      &
-         &     avmu(jpi,jpj,jpk), avm(jpi,jpj,jpk)           ,      &
-         &     avmv(jpi,jpj,jpk), avt(jpi,jpj,jpk)           , STAT = zdf_oce_alloc )
+         &     avmu  (jpi,jpj,jpk), avm   (jpi,jpj,jpk)      ,      &
+         &     avmv  (jpi,jpj,jpk), avt   (jpi,jpj,jpk)      ,      &
+         &     avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk)      ,      & 
+         &     avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk)      ,      &
+         &     en    (jpi,jpj,jpk), STAT = zdf_oce_alloc )
          !
       IF( zdf_oce_alloc /= 0 )   CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 6808)
@@ -56,5 +56,4 @@
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
@@ -111,5 +110,5 @@
          CALL wrk_alloc( jpi, jpj, zbfrt, ztfrt )
 
-         IF ( ln_loglayer.AND.lk_vvl ) THEN ! "log layer" bottom friction coefficient
+         IF ( ln_loglayer.AND. .NOT.ln_linssh ) THEN ! "log layer" bottom friction coefficient
 
             DO jj = 1, jpj
@@ -117,5 +116,5 @@
                   ikbt = mbkt(ji,jj)
 !! JC: possible WAD implementation should modify line below if layers vanish
-                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
+                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
                   zbfrt(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp)
                   zbfrt(ji,jj) = MIN(zbfrt(ji,jj), rn_bfri2_max)
@@ -128,5 +127,5 @@
                      ikbt = mikt(ji,jj)
 ! JC: possible WAD implementation should modify line below if layers vanish
-                     ztmp = (1-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
+                     ztmp = (1.-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
                      ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
                      ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max)
@@ -134,5 +133,5 @@
                END DO
             END IF
-         !   
+            !   
          ELSE
             zbfrt(:,:) = bfrcoef2d(:,:)
@@ -158,20 +157,20 @@
                ! in case of 2 cell water column, we assume each cell feels the top and bottom friction
                IF ( ln_isfcav ) THEN
-                  IF ( miku(ji,jj) + 1 .GE. mbku(ji,jj) ) THEN
+                  IF ( miku(ji,jj) + 1  >=  mbku(ji,jj) ) THEN
                      bfrua(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji+1,jj  ) )   &
                                   &            + ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) ) ) &
                                   &          * zecu * (1._wp - umask(ji,jj,1))
-                  END IF
-                  IF ( mikv(ji,jj) + 1 .GE. mbkv(ji,jj) ) THEN
+                  ENDIF
+                  IF( mikv(ji,jj) + 1  >=  mbkv(ji,jj) ) THEN
                      bfrva(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji  ,jj+1) )   &
                                   &            + ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) ) ) &
                                   &          * zecv * (1._wp - vmask(ji,jj,1))
-                  END IF
-               END IF
+                  ENDIF
+               ENDIF
             END DO
          END DO
          CALL lbc_lnk( bfrua, 'U', 1. )   ;   CALL lbc_lnk( bfrva, 'V', 1. )      ! Lateral boundary condition
 
-         IF ( ln_isfcav ) THEN
+         IF( ln_isfcav ) THEN
             DO jj = 2, jpjm1
                DO ji = 2, jpim1
@@ -371,9 +370,9 @@
          END IF
          !
-         IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all
+         IF( ln_loglayer.AND. ln_linssh ) THEN ! set "log layer" bottom friction once for all
             DO jj = 1, jpj
                DO ji = 1, jpi
                   ikbt = mbkt(ji,jj)
-                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
+                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
                   bfrcoef2d(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp)
                   bfrcoef2d(ji,jj) = MIN(bfrcoef2d(ji,jj), rn_bfri2_max)
@@ -384,5 +383,5 @@
                   DO ji = 1, jpi
                      ikbt = mikt(ji,jj)
-                     ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp
+                     ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp
                      tfrcoef2d(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
                      tfrcoef2d(ji,jj) = MIN(tfrcoef2d(ji,jj), rn_tfri2_max)
@@ -424,6 +423,6 @@
              ikbu = mbku(ji,jj)       ! deepest ocean level at u- and v-points
              ikbv = mbkv(ji,jj)
-             zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt
-             zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt
+             zfru = 0.5 * e3u_n(ji,jj,ikbu) / rdt
+             zfrv = 0.5 * e3v_n(ji,jj,ikbv) / rdt
              IF( ABS( bfrcoef2d(ji,jj) ) > zfru ) THEN
                 IF( ln_ctl ) THEN
@@ -446,6 +445,6 @@
                 ikbu = miku(ji,jj)       ! 1st wet ocean level at u- and v-points
                 ikbv = mikv(ji,jj)
-                zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt
-                zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt
+                zfru = 0.5 * e3u_n(ji,jj,ikbu) / rdt
+                zfrv = 0.5 * e3v_n(ji,jj,ikbv) / rdt
                 IF( ABS( tfrcoef2d(ji,jj) ) > zfru ) THEN
                    IF( ln_ctl ) THEN
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 6808)
@@ -9,5 +9,5 @@
    !!            3.6  ! 2013-04  (G. Madec, F. Roquet) zrau compute locally using interpolation of alpha & beta
    !!----------------------------------------------------------------------
-#if defined key_zdfddm   ||   defined key_esopa
+#if defined key_zdfddm
    !!----------------------------------------------------------------------
    !!   'key_zdfddm' :                                     double diffusion
@@ -44,5 +44,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -115,6 +114,6 @@
          DO jj = 1, jpj                                ! R=zrau = (alpha / beta) (dk[t] / dk[s])
             DO ji = 1, jpi
-               zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   &
-                  &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 
+               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
+                  &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 
                !
                zaw = (  rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw  )  &
@@ -162,7 +161,5 @@
          ! ------------------
          ! Constant eddy coefficient: reset to the background value
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                zinr = 1._wp / zrau(ji,jj)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 6808)
@@ -7,19 +7,19 @@
    !! History :  OPA  !  1997-06  (G. Madec, A. Lazar)  Original code
    !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
-   !!             -   !  2005-06  (C. Ethe) KPP parameterization
    !!            3.2  !  2009-03  (M. Leclair, G. Madec, R. Benshila) test on both before & after
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   zdf_evd      : increase the momentum and tracer Kz at the location of
-   !!                  statically unstable portion of the water column (ln_zdfevd=T)
+   !!   zdf_evd       : increase the momentum and tracer Kz at the location of
+   !!                   statically unstable portion of the water column (ln_zdfevd=T)
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers variables
    USE dom_oce         ! ocean space and time domain variables
    USE zdf_oce         ! ocean vertical physics variables
-   USE zdfkpp          ! KPP vertical mixing
+   !
    USE in_out_manager  ! I/O manager
    USE iom             ! for iom_put
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! work arrays
    USE timing          ! Timing
 
@@ -29,6 +29,4 @@
    PUBLIC   zdf_evd    ! called by step.F90
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
@@ -53,9 +51,8 @@
       !! References :   Lazar, A., these de l'universite Paris VI, France, 1997
       !!----------------------------------------------------------------------
-      USE oce,   zavt_evd => ua , zavm_evd => va  ! (ua,va) used ua workspace
-      !
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step indexocean time step
       !
       INTEGER ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zavt_evd, zavm_evd
       !!----------------------------------------------------------------------
       !
@@ -68,7 +65,9 @@
          IF(lwp) WRITE(numout,*)
       ENDIF
-
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zavt_evd, zavm_evd ) 
+      !
       zavt_evd(:,:,:) = avt(:,:,:)           ! set avt prior to evd application
-
+      !
       SELECT CASE ( nn_evdm )
       !
@@ -80,10 +79,5 @@
             DO jj = 2, jpj             ! no vector opt.
                DO ji = 2, jpi
-#if defined key_zdfkpp
-                  ! no evd mixing in the boundary layer with KPP
-                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj)  ) THEN
-#else
                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN
-#endif
                      avt (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk)
                      avm (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk)
@@ -107,10 +101,5 @@
             DO jj = 1, jpj             ! loop over the whole domain (no lbc_lnk call)
                DO ji = 1, jpi
-#if defined key_zdfkpp
-                  ! no evd mixing in the boundary layer with KPP
-                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj)  )   &          
-#else
                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   &
-#endif
                      avt(ji,jj,jk) = rn_avevd * tmask(ji,jj,jk)
                END DO
@@ -123,4 +112,6 @@
       CALL iom_put( "avt_evd", zavt_evd )              ! output this change
       !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zavt_evd, zavm_evd ) 
+      !
       IF( nn_timing == 1 )  CALL timing_stop('zdf_evd')
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 6808)
@@ -8,5 +8,5 @@
    !!             3.3  !  2010-10  (C. Bricaud)  Add in the reference
    !!----------------------------------------------------------------------
-#if defined key_zdfgls   ||   defined key_esopa
+#if defined key_zdfgls
    !!----------------------------------------------------------------------
    !!   'key_zdfgls'                 Generic Length Scale vertical physics
@@ -42,11 +42,6 @@
    LOGICAL , PUBLIC, PARAMETER ::   lk_zdfgls = .TRUE.   !: TKE vertical mixing flag
    !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en      !: now turbulent kinetic energy
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zwall   !: wall function
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k   ! not enhanced Kz
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avm_k   ! not enhanced Kz
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k  ! not enhanced Kz
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmv_k  ! not enhanced Kz
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustars2 !: Squared surface velocity scale at T-points
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustarb2 !: Squared bottom  velocity scale at T-points
@@ -107,5 +102,4 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -120,8 +114,6 @@
       !!                ***  FUNCTION zdf_gls_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( en(jpi,jpj,jpk),  mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     &
-         &      avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk),                    &
-         &      avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk),                    &
-         &      ustars2(jpi,jpj), ustarb2(jpi,jpj)                      , STAT= zdf_gls_alloc )
+      ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     &
+         &      ustars2(jpi,jpj) , ustarb2(jpi,jpj)   , STAT= zdf_gls_alloc )
          !
       IF( lk_mpp             )   CALL mpp_sum ( zdf_gls_alloc )
@@ -161,6 +153,6 @@
       IF( nn_timing == 1 )  CALL timing_start('zdf_gls')
       !
-      CALL wrk_alloc( jpi,jpj, zdep, zkar, zflxs, zhsro )
-      CALL wrk_alloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi  )
+      CALL wrk_alloc( jpi,jpj,       zdep, zkar, zflxs, zhsro )
+      CALL wrk_alloc( jpi,jpj,jpk,   eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi  )
       
       ! Preliminary computing
@@ -176,7 +168,5 @@
 
       ! Compute surface and bottom friction at T-points
-!CDIR NOVERRCHK          
       DO jj = 2, jpjm1          
-!CDIR NOVERRCHK         
          DO ji = fs_2, fs_jpim1   ! vector opt.         
             !
@@ -213,10 +203,8 @@
                avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   &
                   &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   &
-                  &                            / (  fse3uw_n(ji,jj,jk)               &
-                  &                            *    fse3uw_b(ji,jj,jk) )
+                  &                            / (  e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) )
                avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )   &
                   &                            * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )   &
-                  &                            / (  fse3vw_n(ji,jj,jk)               &
-                  &                            *    fse3vw_b(ji,jj,jk) )
+                  &                            / (  e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) )
                eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT(en(ji,jj,jk)) / mxln(ji,jj,jk)
             END DO
@@ -235,6 +223,6 @@
             DO jj = 2, jpjm1 
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zup   = mxln(ji,jj,jk) * fsdepw(ji,jj,mbkt(ji,jj)+1)
-                  zdown = vkarmn * fsdepw(ji,jj,jk) * ( -fsdepw(ji,jj,jk) + fsdepw(ji,jj,mbkt(ji,jj)+1) )
+                  zup   = mxln(ji,jj,jk) * gdepw_n(ji,jj,mbkt(ji,jj)+1)
+                  zdown = vkarmn * gdepw_n(ji,jj,jk) * ( -gdepw_n(ji,jj,jk) + gdepw_n(ji,jj,mbkt(ji,jj)+1) )
                   zcoef = ( zup / MAX( zdown, rsmall ) )
                   zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk)
@@ -293,9 +281,9 @@
                ! lower diagonal
                z_elem_a(ji,jj,jk) = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &
-                  &                      / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+                  &                      / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  ) )
                !
                ! upper diagonal
                z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &
-                  &                      / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
+                  &                      / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
                !
                ! diagonal
@@ -329,5 +317,6 @@
       ! 
       ! One level below
-      en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+fsdepw(:,:,2))/zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp)
+      en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2)) &
+         &               / zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp)
       en(:,:,2) = MAX(en(:,:,2), rn_emin )
       z_elem_a(:,:,2) = 0._wp 
@@ -349,8 +338,9 @@
       z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
       z_elem_a(:,:,2) = 0._wp
-      zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*fsdept(:,:,1)/zhsro(:,:)) ))
-      zflxs(:,:)      = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) * ((zhsro(:,:)+fsdept(:,:,1))/zhsro(:,:) )**(1.5_wp*ra_sf)
-
-      en(:,:,2) = en(:,:,2) + zflxs(:,:)/fse3w(:,:,2)
+      zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*gdept_n(:,:,1)/zhsro(:,:)) ))
+      zflxs(:,:)      = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) &
+          &                       * ((zhsro(:,:)+gdept_n(:,:,1)) / zhsro(:,:) )**(1.5_wp*ra_sf)
+
+      en(:,:,2) = en(:,:,2) + zflxs(:,:)/e3w_n(:,:,2)
       !
       !
@@ -365,7 +355,5 @@
          !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = rn_lmin
          !                      ! Balance between the production and the dissipation terms
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
@@ -388,7 +376,5 @@
       CASE ( 1 )             ! Neumman boundary condition
          !                      
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
@@ -519,8 +505,8 @@
                ! lower diagonal
                z_elem_a(ji,jj,jk) = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &
-                  &                      / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+                  &                      / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  ) )
                ! upper diagonal
                z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &
-                  &                      / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
+                  &                      / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
                ! diagonal
                z_elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk)  &
@@ -550,6 +536,6 @@
       !
       ! One level below
-      zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*fsdepw(:,:,2)/zhsro(:,:) )))
-      zdep(:,:)       = (zhsro(:,:) + fsdepw(:,:,2)) * zkar(:,:)
+      zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*gdepw_n(:,:,2)/zhsro(:,:) )))
+      zdep(:,:)       = (zhsro(:,:) + gdepw_n(:,:,2)) * zkar(:,:)
       psi (:,:,2)     = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
       z_elem_a(:,:,2) = 0._wp
@@ -572,11 +558,11 @@
       !
       ! Set psi vertical flux at the surface:
-      zkar(:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*fsdept(:,:,1)/zhsro(:,:) )) ! Lengh scale slope
-      zdep(:,:) = ((zhsro(:,:) + fsdept(:,:,1)) / zhsro(:,:))**(rmm*ra_sf)
+      zkar(:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*gdept_n(:,:,1)/zhsro(:,:) )) ! Lengh scale slope
+      zdep(:,:) = ((zhsro(:,:) + gdept_n(:,:,1)) / zhsro(:,:))**(rmm*ra_sf)
       zflxs(:,:) = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp)
       zdep(:,:) =  rsbc_psi1 * (zwall_psi(:,:,1)*avm(:,:,1)+zwall_psi(:,:,2)*avm(:,:,2)) * &
-             & ustars2(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + fsdept(:,:,1))**(rnn-1.)
+             & ustars2(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept_n(:,:,1))**(rnn-1.)
       zflxs(:,:) = zdep(:,:) * zflxs(:,:)
-      psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
+      psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w_n(:,:,2)
 
       !   
@@ -593,7 +579,5 @@
          !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * rn_bfrz0
          !                      ! Balance between the production and the dissipation terms
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
@@ -606,5 +590,5 @@
                !
                ! Just above last level, Dirichlet condition again (GOTM like)
-               zdep(ji,jj) = vkarmn * ( rn_bfrz0 + fse3t(ji,jj,ibotm1) )
+               zdep(ji,jj) = vkarmn * ( rn_bfrz0 + e3t_n(ji,jj,ibotm1) )
                psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot  )**rmm * zdep(ji,jj)**rnn
                z_elem_a(ji,jj,ibotm1) = 0._wp
@@ -616,7 +600,5 @@
       CASE ( 1 )             ! Neumman boundary condition
          !                      
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
@@ -636,8 +618,8 @@
                !
                ! Set psi vertical flux at the bottom:
-               zdep(ji,jj) = rn_bfrz0 + 0.5_wp*fse3t(ji,jj,ibotm1)
+               zdep(ji,jj) = rn_bfrz0 + 0.5_wp*e3t_n(ji,jj,ibotm1)
                zflxb = rsbc_psi2 * ( avm(ji,jj,ibot) + avm(ji,jj,ibotm1) )   &
                   &  * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp)
-               psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / fse3w(ji,jj,ibotm1)
+               psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w_n(ji,jj,ibotm1)
             END DO
          END DO
@@ -839,6 +821,6 @@
       avmv_k(:,:,:) = avmv(:,:,:)
       !
-      CALL wrk_dealloc( jpi,jpj, zdep, zkar, zflxs, zhsro )
-      CALL wrk_dealloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )
+      CALL wrk_dealloc( jpi,jpj,       zdep, zkar, zflxs, zhsro )
+      CALL wrk_dealloc( jpi,jpj,jpk,   eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )
       !
       IF( nn_timing == 1 )  CALL timing_stop('zdf_gls')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 6808)
@@ -6,6 +6,7 @@
    !! History :  8.0  ! 1997-06  (G. Madec)  Original code from inimix
    !!            1.0  ! 2002-08  (G. Madec)  F90 : free form
-   !!             -   ! 2005-06  (C. Ethe) KPP parameterization
+   !!             -   ! 2005-06  (C. Ethe) KPP scheme
    !!             -   ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection
+   !!            3.7  ! 2014-12  (G. Madec) remove KPP scheme
    !!----------------------------------------------------------------------
 
@@ -14,19 +15,17 @@
    !!----------------------------------------------------------------------
    USE par_oce         ! mesh and scale factors
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE ldfdyn_oce      ! ocean dynamics lateral physics
    USE zdf_oce         ! TKE vertical mixing          
-   USE lib_mpp         ! distribued memory computing
+   USE sbc_oce         ! surface module (only for nn_isf in the option compatibility test)
    USE zdftke          ! TKE vertical mixing
    USE zdfgls          ! GLS vertical mixing
-   USE zdfkpp          ! KPP vertical mixing          
+   USE zdfric          ! Richardson vertical mixing   
    USE zdfddm          ! double diffusion mixing      
    USE zdfevd          ! enhanced vertical diffusion  
-   USE zdfric          ! Richardson vertical mixing   
    USE tranpc          ! convection: non penetrative adjustment
    USE ldfslp          ! iso-neutral slopes
-
+   !
    USE in_out_manager  ! I/O manager
    USE iom             ! IOM library
+   USE lib_mpp         ! distribued memory computing
 
    IMPLICIT NONE
@@ -50,6 +49,5 @@
       !! ** Method  :   Read namelist namzdf, control logicals 
       !!----------------------------------------------------------------------
-      INTEGER ::   ioptio       ! temporary scalar
-      INTEGER ::   ios
+      INTEGER ::   ioptio, ios       ! local integers
       !!
       NAMELIST/namzdf/ rn_avm0, rn_avt0, nn_avb, nn_havtb, ln_zdfexp, nn_zdfexp,   &
@@ -111,11 +109,7 @@
          ioptio = ioptio+1
       ENDIF
-      IF( lk_zdfkpp ) THEN
-         IF(lwp) WRITE(numout,*) '      KPP dependent eddy coefficients'
-         ioptio = ioptio+1
-      ENDIF
-      IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa )   &
+      IF( ioptio == 0 .OR. ioptio > 1 )   &
          &   CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' )
-      IF( ( lk_zdfric .OR. lk_zdfgls .OR. lk_zdfkpp ) .AND. ln_isfcav )   &
+      IF( ( lk_zdfric .OR. lk_zdfgls ) .AND. ln_isfcav )   &
          &   CALL ctl_stop( ' only zdfcst and zdftke were tested with ice shelves cavities ' )
       !
@@ -143,14 +137,7 @@
          IF(lwp) WRITE(numout,*) '      use the GLS closure scheme'
       ENDIF
-      IF( lk_zdfkpp ) THEN
-         IF(lwp) WRITE(numout,*) '      use the KPP closure scheme'
-         IF(lk_mpp) THEN
-            IF(lwp) WRITE(numout,cform_err)
-            IF(lwp) WRITE(numout,*) 'The KPP scheme is not ready to run in MPI'
-         ENDIF
-      ENDIF
-      IF ( ioptio > 1 .AND. .NOT. lk_esopa )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' )
-      IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) )           &
-         CALL ctl_stop( ' except for TKE, GLS or KPP physics, a convection scheme is',   &
+      IF ( ioptio > 1 )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' )
+      IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls ) )           &
+         CALL ctl_stop( ' except for TKE or GLS physics, a convection scheme is',   &
          &              ' required: ln_zdfevd or ln_zdfnpc logicals' )
 
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90	(revision 6807)
+++ 	(revision )
@@ -1,1592 +1,0 @@
-MODULE zdfkpp
-   !!======================================================================
-   !!                       ***  MODULE  zdfkpp  ***
-   !! Ocean physics:  vertical mixing coefficient compute from the KPP 
-   !!                 turbulent closure parameterization
-   !!=====================================================================
-   !! History :  OPA  ! 2000-03 (W.G. Large, J. Chanut) Original code
-   !!            8.1  ! 2002-06 (J.M. Molines) for real case CLIPPER  
-   !!            8.2  ! 2003-10 (Chanut J.) re-writting
-   !!   NEMO     1.0  ! 2005-01 (C. Ethe, G. Madec) Free form, F90 + creation of tra_kpp routine
-   !!            3.3  ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
-   !!----------------------------------------------------------------------
-#if defined key_zdfkpp   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_zdfkpp'                                             KPP scheme
-   !!----------------------------------------------------------------------
-   !!   zdf_kpp       : update momentum and tracer Kz from a kpp scheme
-   !!   zdf_kpp_init  : initialization, namelist read, and parameters control
-   !!   tra_kpp       : compute and add to the T & S trend the non-local flux
-   !!   trc_kpp       : compute and add to the passive tracer trend the non-local flux (lk_top=T)
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers 
-   USE dom_oce        ! ocean space and time domain
-   USE zdf_oce        ! ocean vertical physics
-   USE sbc_oce        ! surface boundary condition: ocean
-   USE phycst         ! physical constants
-   USE eosbn2         ! equation of state
-   USE zdfddm         ! double diffusion mixing (avs array)
-   USE lib_mpp        ! MPP library
-   USE trd_oce        ! ocean trends definition
-   USE trdtra         ! tracers trends
-   !
-   USE in_out_manager ! I/O manager
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl         ! Print control
-   USE wrk_nemo       ! work arrays
-   USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   zdf_kpp       ! routine called by step.F90
-   PUBLIC   zdf_kpp_init  ! routine called by opa.F90
-   PUBLIC   tra_kpp       ! routine called by step.F90
-   PUBLIC   trc_kpp       ! routine called by trcstp.F90
-
-   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfkpp = .TRUE.    !: KPP vertical mixing flag
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghats    !: non-local scalar mixing term (gamma/<ws>o)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wt0      !: surface temperature flux for non local flux
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ws0      !: surface salinity flux for non local flux
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hkpp     !: boundary layer depth
-
-   !                          !!* Namelist namzdf_kpp *
-   REAL(wp) ::   rn_difmiw     ! constant internal wave viscosity (m2/s)
-   REAL(wp) ::   rn_difsiw     ! constant internal wave diffusivity (m2/s)
-   REAL(wp) ::   rn_riinfty    ! local Richardson Number limit for shear instability
-   REAL(wp) ::   rn_difri      ! maximum shear mixing at Rig = 0    (m2/s)
-   REAL(wp) ::   rn_bvsqcon    ! Brunt-Vaisala squared (1/s**2) for maximum convection
-   REAL(wp) ::   rn_difcon     ! maximum mixing in interior convection (m2/s)
-   INTEGER  ::   nn_ave        ! = 0/1 flag for horizontal average on avt, avmu, avmv
-
-#if defined key_zdfddm
-   !                                        !!! ** Double diffusion Mixing
-   REAL(wp) ::   difssf  = 1.e-03_wp         ! maximum salt fingering mixing 
-   REAL(wp) ::   Rrho0   = 1.9_wp            ! limit for salt  fingering mixing 
-   REAL(wp) ::   difsdc  = 1.5e-06_wp        ! maximum diffusive convection mixing
-#endif
-   LOGICAL  ::   ln_kpprimix       ! Shear instability mixing 
-
-   !                                        !!! ** General constants  **
-   REAL(wp) ::   epsln   = 1.0e-20_wp        ! a small positive number    
-   REAL(wp) ::   pthird  = 1._wp/3._wp       ! 1/3
-   REAL(wp) ::   pfourth = 1._wp/4._wp       ! 1/4
-
-   !                                        !!! ** Boundary Layer Turbulence Parameters  **
-   REAL(wp) ::   vonk     = 0.4_wp           ! von Karman's constant
-   REAL(wp) ::   epsilon  = 0.1_wp           ! nondimensional extent of the surface layer
-   REAL(wp) ::   rconc1   = 5.0_wp           ! standard flux profile function parmaeters
-   REAL(wp) ::   rconc2   = 16.0_wp          !         "        "
-   REAL(wp) ::   rconcm   = 8.38_wp          ! momentum flux profile fit
-   REAL(wp) ::   rconam   = 1.26_wp          !         "       "
-   REAL(wp) ::   rzetam   = -.20_wp          !         "       "       
-   REAL(wp) ::   rconcs   = 98.96_wp         !  scalar  flux profile fit
-   REAL(wp) ::   rconas   = -28.86_wp        !         "       "
-   REAL(wp) ::   rzetas   = -1.0_wp          !         "       "  
-   
-   !                                        !!! ** Boundary Layer Depth Diagnostic  **
-   REAL(wp) ::   Ricr     = 0.3_wp           ! critical bulk Richardson Number
-   REAL(wp) ::   rcekman  = 0.7_wp           ! coefficient for ekman depth  
-   REAL(wp) ::   rcmonob  = 1.0_wp           ! coefficient for Monin-Obukhov depth 
-   REAL(wp) ::   rconcv   = 1.7_wp           ! ratio of interior buoyancy frequency to its value at entrainment depth
-   REAL(wp) ::   hbf      = 1.0_wp           ! fraction of bound. layer depth to which absorbed solar 
-      !                                      ! rad. and contributes to surf. buo. forcing
-   REAL(wp) ::   Vtc                         ! function of rconcv,rconcs,epsilon,vonk,Ricr
-   
-   !                                        !!! ** Nonlocal Boundary Layer Mixing **
-   REAL(wp) ::   rcstar   = 5.0_wp           ! coefficient for convective nonlocal transport
-   REAL(wp) ::   rcs      = 1.0e-3_wp        ! conversion: mm/s ==> m/s   
-   REAL(wp) ::   rcg                         ! non-dimensional coefficient for nonlocal transport
-
-#if ! defined key_kppcustom
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   del     ! array for reference mean values of vertical integration 
-#endif
-
-#if defined key_kpplktb
-   !                                         !!! ** Parameters for lookup table for turbulent velocity scales ** 
-   INTEGER, PARAMETER ::   nilktb   = 892     ! number of values for zehat in KPP lookup table
-   INTEGER, PARAMETER ::   njlktb   = 482     ! number of values for ustar in KPP lookup table
-   INTEGER, PARAMETER ::   nilktbm1 = nilktb-1   !
-   INTEGER, PARAMETER ::   njlktbm1 = njlktb-1   !
-
-   REAL(wp), DIMENSION(nilktb,njlktb) ::   wmlktb   ! lookup table for the turbulent vertical velocity scale (momentum)
-   REAL(wp), DIMENSION(nilktb,njlktb) ::   wslktb   ! lookup table for the turbulent vertical velocity scale (tracers)
-
-   REAL(wp) ::   dehatmin = -4.e-7_wp    ! minimum limit for zhat in lookup table (m3/s3) 
-   REAL(wp) ::   dehatmax = 0._wp        ! maximum limit for zhat in lookup table (m3/s3)
-   REAL(wp) ::   ustmin   = 0._wp        ! minimum limit for ustar in lookup table (m/s)
-   REAL(wp) ::   ustmax   = 0.04_wp      ! maximum limit for ustar in lookup table (m/s)    
-   REAL(wp) ::   dezehat                 ! delta zhat in lookup table
-   REAL(wp) ::   deustar                 ! delta ustar in lookup table
-#endif
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   ratt   ! attenuation coef  (already defines in module traqsr, 
-   !                                    ! but only if the solar radiation penetration is considered)
-   
-   !                                    !!! * penetrative solar radiation coefficient *
-   REAL(wp) ::   rabs = 0.58_wp          ! fraction associated with xsi1
-   REAL(wp) ::   xsi1 = 0.35_wp          ! first depth of extinction 
-   REAL(wp) ::   xsi2 = 23.0_wp          ! second depth of extinction 
-      !                           ! (default values: water type Ib) 
-
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   etmean, eumean, evmean   ! coeff. used for hor. smoothing at t-, u- & v-points
-        
-#if defined key_c1d
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rig    !: gradient Richardson number
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rib    !: bulk Richardson number
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   buof   !: buoyancy forcing
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mols   !: moning-Obukhov length scale 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ekdp   !: Ekman depth
-#endif
-
-   INTEGER  ::   jip = 62 , jjp = 111
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-#  include  "zdfddm_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION zdf_kpp_alloc()
-      !!----------------------------------------------------------------------
-      !!                 ***  FUNCTION zdf_kpp_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( ghats(jpi,jpj,jpk), wt0(jpi,jpj), ws0(jpi,jpj), hkpp(jpi,jpj), &
-#if ! defined key_kpplktb
-         &      del(jpk,jpk),                                                  &
-#endif
-         &      ratt(jpk),                                                     &
-         &      etmean(jpi,jpj,jpk), eumean(jpi,jpj,jpk), evmean(jpi,jpj,jpk), &
-#if defined key_c1d
-         &      rig (jpi,jpj,jpk), rib(jpi,jpj,jpk), buof(jpi,jpj,jpk),        &
-         &      mols(jpi,jpj,jpk), ekdp(jpi,jpj),                              &
-#endif
-         &      STAT= zdf_kpp_alloc )
-         !
-      IF( lk_mpp             )   CALL mpp_sum ( zdf_kpp_alloc )
-      IF( zdf_kpp_alloc /= 0 )   CALL ctl_warn('zdf_kpp_alloc: failed to allocate arrays')
-   END FUNCTION zdf_kpp_alloc
-
-
-   SUBROUTINE zdf_kpp( kt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE zdf_kpp  ***
-      !!
-      !! ** Purpose :   Compute the vertical eddy viscosity and diffusivity
-      !!      coefficients and non local mixing using K-profile parameterization
-      !!
-      !! ** Method :   The boundary layer depth hkpp is diagnosed at tracer points
-      !!      from profiles of buoyancy, and shear, and the surface forcing.
-      !!      Above hbl (sigma=-z/hbl <1) the mixing coefficients are computed from 
-      !!
-      !!                      Kx =  hkpp  Wx(sigma) G(sigma)  
-      !!
-      !!             and the non local term ghat = Cs / Ws(sigma) / hkpp
-      !!      Below hkpp  the coefficients are the sum of mixing due to internal waves
-      !!      shear instability and double diffusion.
-      !!
-      !!      -1- Compute the now interior vertical mixing coefficients at all depths. 
-      !!      -2- Diagnose the boundary layer depth. 
-      !!      -3- Compute the now boundary layer vertical mixing coefficients. 
-      !!      -4- Compute the now vertical eddy vicosity and diffusivity.
-      !!      -5- Smoothing
-      !!
-      !!        N.B. The computation is done from jk=2 to jpkm1 
-      !!             Surface value of avt avmu avmv are set once a time to zero
-      !!             in routine zdf_kpp_init.
-      !!
-      !! ** Action  :   update the non-local terms ghats
-      !!                update avt, avmu, avmv (before vertical eddy coef.)
-      !!
-      !! References : Large W.G., Mc Williams J.C. and Doney S.C.              
-      !!         Reviews of Geophysics, 32, 4, November 1994
-      !!         Comments in the code refer to this paper, particularly 
-      !!         the equation number. (LMD94, here after)
-      !!----------------------------------------------------------------------
-      USE oce     , zviscos => ua   ! temp. array for viscosities use ua as workspace
-      USE oce     , zdiffut => va   ! temp. array for diffusivities use sa as workspace
-      !!
-      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
-      !!
-      INTEGER ::   ji, jj, jk              ! dummy loop indices
-      INTEGER ::   ikbot, jkmax, jkm1, jkp2   !
-
-      REAL(wp) ::   ztx, zty, zflageos, zstabl, zbuofdep,zucube     !
-      REAL(wp) ::   zrhos, zalbet, zbeta, zthermal, zhalin, zatt1   !
-      REAL(wp) ::   zref, zt, zs, zh, zu, zv, zrh                   ! Bulk richardson number
-      REAL(wp) ::   zrib, zrinum, zdVsq, zVtsq                      !
-      REAL(wp) ::   zehat, zeta, zhrib, zsig, zscale, zwst, zws, zwm   ! Velocity scales
-#if defined key_kpplktb
-      INTEGER ::    il, jl                                          ! Lookup table or Analytical functions 
-      REAL(wp) ::   ud, zfrac, ufrac, zwam, zwbm, zwas, zwbs        !
-#else
-      REAL(wp) ::   zwsun, zwmun, zcons, zconm, zwcons, zwconm      !
-#endif
-      REAL(wp) ::   zsr, zbw, ze, zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zcomp , zrhd,zrhdr,zbvzed   ! In situ density
-#if ! defined key_kppcustom     
-      INTEGER  ::   jm                          ! dummy loop indices
-      REAL(wp) ::   zr1, zr2, zr3, zr4, zrhop   ! Compression terms
-#endif
-      REAL(wp) ::   zflag, ztemp, zrn2, zdep21, zdep32, zdep43
-      REAL(wp) ::   zdku2, zdkv2, ze3sqr, zsh2, zri, zfri          ! Interior richardson mixing
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zmoek                 ! Moning-Obukov limitation
-      REAL(wp), POINTER, DIMENSION(:)   ::   zmoa, zekman                
-      REAL(wp)                          ::   zmob, zek
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zdepw, zdift, zvisc   ! The pipe 
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zdept
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zriblk
-      REAL(wp), POINTER, DIMENSION(:)   ::   zhmax, zria, zhbl 
-      REAL(wp) ::   zflagri, zflagek, zflagmo, zflagh, zflagkb   !
-      REAL(wp), POINTER, DIMENSION(:)   ::   za2m, za3m, zkmpm, za2t, za3t, zkmpt   ! Shape function (G)
-      REAL(wp) ::   zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t
-#if defined key_zdfddm
-      REAL(wp) ::   zrw, zkm1s                    ! local scalars
-      REAL(wp) ::   zrrau, zdt, zds, zavdds, zavddt, zinr   ! double diffusion mixing
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdifs
-      REAL(wp), POINTER, DIMENSION(:)     ::   za2s, za3s, zkmps
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zblcs
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdiffus
-#endif
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zBo, zBosol, zustar         ! Surface buoyancy forcing, friction velocity
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask, zblcm, zblct
-      !!--------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('zdf_kpp')
-      !
-      CALL wrk_alloc( jpi, zmoa, zekman, zhmax, zria, zhbl )
-      CALL wrk_alloc( jpi, za2m, za3m, zkmpm, za2t, za3t, zkmpt )
-      CALL wrk_alloc( jpi,2, zriblk )
-      CALL wrk_alloc( jpi,3, zmoek, kjstart = 0 )
-      CALL wrk_alloc( jpi,3, zdept )
-      CALL wrk_alloc( jpi,4, zdepw, zdift, zvisc )
-      CALL wrk_alloc( jpi,jpj, zBo, zBosol, zustar )
-      CALL wrk_alloc( jpi,jpk, zmask, zblcm, zblct )
-#if defined key_zdfddm
-      CALL wrk_alloc( jpi,4, zdifs )
-      CALL wrk_alloc( jpi, zmoa, za2s, za3s, zkmps )
-      CALL wrk_alloc( jpi,jpk, zblcs )
-      CALL wrk_alloc( jpi,jpi,jpk, zdiffus )
-#endif
-
-      zviscos(:,:,:) = 0._wp
-      zblcm  (:,:  ) = 0._wp
-      zdiffut(:,:,:) = 0._wp
-      zblct  (:,:  ) = 0._wp 
-#if defined key_zdfddm
-      zdiffus(:,:,:) = 0._wp
-      zblcs  (:,:  ) = 0._wp 
-#endif
-      ghats  (:,:,:) = 0._wp
-      zBo    (:,:  ) = 0._wp
-      zBosol (:,:  ) = 0._wp
-      zustar (:,:  ) = 0._wp
-      !
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! I. Interior diffusivity and viscosity at w points ( T interfaces)
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1 
-               ! Mixing due to internal waves breaking
-               ! -------------------------------------
-               avmu(ji,jj,jk)  = rn_difmiw 
-               avt (ji,jj,jk)  = rn_difsiw             
-               ! Mixing due to vertical shear instability
-               ! -------------------------------------               
-               IF( ln_kpprimix ) THEN          
-                  ! Compute the gradient Richardson  number at interfaces (zri):
-                  ! LMD94, eq. 27 (is vertical smoothing needed : Rig=N^2 / (dz(u))^2 + (dz(v))^2
-                  zdku2 =   ( un(ji - 1,jj,jk - 1) - un(ji - 1,jj,jk) ) &
-                     &    * ( un(ji - 1,jj,jk - 1) - un(ji - 1,jj,jk) ) &
-                     &    + ( un(ji    ,jj,jk - 1) - un(ji    ,jj,jk) ) &
-                     &    * ( un(ji    ,jj,jk - 1) - un(ji    ,jj,jk) )  
-                  
-                  zdkv2 =   ( vn(ji,jj - 1,jk - 1) - vn(ji,jj - 1,jk) ) &
-                     &    * ( vn(ji,jj - 1,jk - 1) - vn(ji,jj - 1,jk) ) &
-                     &    + ( vn(ji,    jj,jk - 1) - vn(ji,    jj,jk) ) &
-                     &    * ( vn(ji,    jj,jk - 1) - vn(ji,    jj,jk) )  
-
-                  ze3sqr = 1. / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) )
-                  ! Square of vertical shear  at interfaces
-                  zsh2   = 0.5 * ( zdku2 + zdkv2 ) * ze3sqr
-                  zri    = MAX( rn2(ji,jj,jk), 0. ) / ( zsh2 + epsln ) 
-#if defined key_c1d
-                  ! save the gradient richardson number
-                  rig(ji,jj,jk) = zri * tmask(ji,jj,jk)
-#endif                  
-                  ! Evaluate f of Ri (zri) for shear instability store in zfri
-                  ! LMD94, eq. 28a,b,c, figure 3 ; Rem: p1 is 3, hard coded
-                  zfri  = MAX( zri , 0. )
-                  zfri  = MIN( zfri / rn_riinfty , 1.0 )
-                  zfri  = ( 1.0 - zfri * zfri )
-                  zfri  = zfri * zfri  * zfri
-                  ! add shear contribution to mixing coef. 
-                  avmu(ji,jj,jk) =  avmu(ji,jj,jk) + rn_difri * zfri   
-                  avt (ji,jj,jk) =  avt (ji,jj,jk) + rn_difri * zfri    
-               ENDIF
-               !
-#if defined key_zdfddm 
-               !
-               !  Double diffusion mixing ; NOT IN ROUTINE ZDFDDM.F90
-               ! -------------------------
-               avs (ji,jj,jk) =  avt (ji,jj,jk)   
-
-               ! R=zrau = (alpha / beta) (dk[t] / dk[s])
-               zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   &
-                  &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 
-               !
-               zaw = (  rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw  ) * tmask(ji,jj,jk)
-               zbw = (  rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw  ) * tmask(ji,jj,jk)
-               !
-               zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )
-               zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) 
-               IF( ABS( zds) <= 1.e-20_wp )   zds = 1.e-20_wp
-               zrrau = MAX(  epsln , zdt / zds  )    ! only retains positive value of zrau
-               !
-               IF( zrrau > 1. .AND. zds > 0.) THEN                        ! Salt fingering case.
-                  !                                                       !---------------------
-                  ! Compute interior diffusivity for double diffusive mixing of salinity. 
-                  ! Upper bound "zrrau" by "Rrho0"; (Rrho0=1.9, difcoefnuf=0.001).
-                  ! After that set interior diffusivity for double diffusive mixing of temperature
-                  zavdds = MIN( zrrau, Rrho0 )
-                  zavdds = ( zavdds - 1.0 ) / ( Rrho0 - 1.0 )
-                  zavdds = 1.0 - zavdds * zavdds 
-                  zavdds = zavdds * zavdds * zavdds 
-                  zavdds = difssf * zavdds 
-                  zavddt = 0.7 * zavdds
-                  !
-               ELSEIF( zrrau < 1. .AND. zrrau > 0. .AND. zds < 0.) THEN   ! Diffusive convection case.
-                  !                                                       !---------------------------
-                  ! Compute interior diffusivity for double diffusive mixing of temperature (Marmorino and Caldwell, 1976); 
-                  ! Compute interior diffusivity for double diffusive mixing of salinity 
-                  zinr   = 1. / zrrau
-                  zavddt = 0.909 * EXP( 4.6 * EXP( -0.54* ( zinr - 1. ) ) ) 
-                  zavddt = difsdc * zavddt
-                  IF( zrrau < 0.5) THEN   ;   zavdds = zavddt * 0.15 * zrrau
-                  ELSE                    ;   zavdds = zavddt * (1.85 * zrrau - 0.85 ) 
-                  ENDIF
-               ELSE
-                  zavddt = 0.
-                  zavdds = 0.
-               ENDIF 
-               ! Add double diffusion contribution to temperature and salinity  mixing coefficients.
-               avt (ji,jj,jk) =  avt (ji,jj,jk) +  zavddt 
-               avs (ji,jj,jk) =  avs (ji,jj,jk) +  zavdds         
-#endif                      
-            END DO
-         END DO
-      END DO
-
-
-      ! Radiative (zBosol) and non radiative (zBo) surface buoyancy
-      !JMM at the time zdfkpp is called, q still holds the sum q + qsr
-      !---------------------------------------------------------------------
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1           
-            zrhos    = rau0 * ( 1._wp + rhd(ji,jj,1) ) * tmask(ji,jj,1)
-            zthermal = rab_n(ji,jj,1,jp_tem) / ( rcp * zrhos + epsln )
-            zbeta    = rab_n(ji,jj,1,jp_sal)
-            zhalin   = zbeta * tsn(ji,jj,1,jp_sal) * rcs
-            !
-            ! Radiative surface buoyancy force
-            zBosol(ji,jj) = grav * zthermal * qsr(ji,jj)
-            ! Non radiative surface buoyancy force
-            zBo   (ji,jj) = grav * zthermal * qns(ji,jj) -  grav * zhalin * ( emp(ji,jj)-rnf(ji,jj) )  &
-               &                                         -  grav * zbeta * rcs * sfx(ji,jj)
-            ! Surface Temperature flux for non-local term
-            wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* r1_rau0_rcp * tmask(ji,jj,1)
-            ! Surface salinity flux for non-local term
-            ws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal)                          &
-               &             + sfx(ji,jj)                                     ) * rcs * tmask(ji,jj,1) 
-         END DO
-      END DO
-
-      zflageos = 0.5 + SIGN( 0.5, nn_eos - 1. ) 
-      !  Compute surface buoyancy forcing, Monin Obukhov and Ekman depths  
-      !------------------------------------------------------------------    
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            !  Reference surface density = density at first T point level   
-            zrhos         = rhop(ji,jj,1) + zflageos * rau0 * ( 1. - tmask(ji,jj,1) )  
-            ! Friction velocity (zustar), at T-point : LMD94 eq. 2
-            zustar(ji,jj) = SQRT( taum(ji,jj) / ( zrhos +  epsln ) )
-         END DO
-      END DO
-
-!CDIR NOVERRCHK  
-      !                                               ! ===============
-      DO jj = 2, jpjm1                                 !  Vertical slab
-         !                                             ! ===============
-         
-         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-         ! II Compute Boundary layer mixing coef. and diagnose the new boundary layer depth
-         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-         
-         ! Initialization
-         jkmax       = 0
-         zdept (:,:) = 0.
-         zdepw (:,:) = 0.
-         zriblk(:,:) = 0.
-         zmoek (:,:) = 0.
-         zvisc (:,:) = 0.
-         zdift (:,:) = 0.
-#if defined key_zdfddm
-         zdifs (:,:) = 0.
-#endif
-         zmask (:,:) = 0.
-         DO ji = fs_2, fs_jpim1
-            zria(ji ) = 0.
-            ! Maximum boundary layer depth
-            ikbot     = mbkt(ji,jj)    ! ikbot is the last T point in the water
-            zhmax(ji) = fsdept(ji,jj,ikbot) - 0.001      
-            ! Compute Monin obukhov length scale at the surface and Ekman depth:
-            zbuofdep   = zBo(ji,jj) + zBosol(ji,jj) * ratt(1)
-            zekman(ji) = rcekman * zustar(ji,jj) / ( ABS( ff(ji,jj) ) + epsln )
-            zucube     = zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) 
-            zmoa(ji)   = zucube / ( vonk * ( zbuofdep + epsln ) )   
-#if defined key_c1d
-            ! store the surface buoyancy forcing
-            zstabl        = 0.5 + SIGN( 0.5, zbuofdep )
-            buof(ji,jj,1) = zbuofdep * tmask(ji,jj,1)
-            ! store the moning-oboukov length scale at surface
-            zmob          = zstabl * zmoa(ji) + ( 1.0 - zstabl ) * fsdept(ji,jj,1)
-            mols(ji,jj,1) = MIN( zmob , zhmax(ji) ) * tmask(ji,jj,1)
-            ! store Ekman depth
-            zek           = zstabl * zekman(ji) + ( 1.0 - zstabl ) * fsdept(ji,jj,1)  
-            ekdp(ji,jj )  = MIN( zek , zhmax(ji) ) * tmask(ji,jj,1)  
-#endif 
-         END DO     
-         ! Compute the pipe
-         ! ---------------------
-         DO jk = 2, jpkm1
-            DO ji = fs_2, fs_jpim1
-               ! Compute bfsfc = Bo + radiative contribution down to hbf*depht
-               zbuofdep = zBo(ji,jj) + zBosol(ji,jj) * ratt(jk)
-               ! Flag (zstabl  = 1) if positive forcing
-               zstabl   =  0.5 + SIGN(  0.5, zbuofdep)
-
-               !   Compute bulk richardson number zrib at depht 
-               !-------------------------------------------------------
-               !                           [Br - B(d)] * d         zrinum
-               !             Rib(z) = ----------------------- = -------------
-               !                       |Vr - V(d)|^2 + Vt(d)^2   zdVsq + zVtsq
-               !
-               ! First compute zt,zs,zu,zv = means in the surface layer < epsilon*depht  
-               ! Else surface values are taken at the first T level.
-               ! For stability, resolved vertical shear is computed with "before velocities".
-               zref = epsilon * fsdept(ji,jj,jk)
-#if defined key_kppcustom
-               ! zref = gdept(1)
-               zref = fsdept(ji,jj,1)
-               zt   = tsn(ji,jj,1,jp_tem)
-               zs   = tsn(ji,jj,1,jp_sal)
-               zrh  = rhop(ji,jj,1)
-               zu   = ( ub(ji,jj,1) + ub(ji - 1,jj    ,1) ) / MAX( 1. , umask(ji,jj,1) + umask(ji - 1,jj   ,1) )
-               zv   = ( vb(ji,jj,1) + vb(ji    ,jj - 1,1) ) / MAX( 1. , vmask(ji,jj,1) + vmask(ji   ,jj - 1,1) )
-#else
-               zt   = 0.
-               zs   = 0.
-               zu   = 0.
-               zv   = 0.
-               zrh  = 0.
-               ! vertically integration over the upper epsilon*gdept(jk) ; del () array is computed once in zdf_kpp_init
-               DO jm = 1, jpkm1
-                  zt   = zt  + del(jk,jm) * tsn(ji,jj,jm,jp_tem)
-                  zs   = zs  + del(jk,jm) * tsn(ji,jj,jm,jp_sal)
-                  zu   = zu  + 0.5 * del(jk,jm) &
-                     &            * ( ub(ji,jj,jm) + ub(ji - 1,jj,jm) ) &
-                     &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) )
-                  zv   = zv  + 0.5 * del(jk,jm) &
-                     &            * ( vb(ji,jj,jm) + vb(ji,jj - 1,jm) ) &
-                     &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) )
-                  zrh  = zrh + del(jk,jm) * rhop(ji,jj,jm)
-               END DO
-#endif
-               zsr = SQRT( ABS( tsn(ji,jj,jk,jp_sal) ) )
-               ! depth
-               zh = fsdept(ji,jj,jk)
-               ! compute compression terms on density
-               ze  = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
-               zbw = (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
-               zb  = zbw + ze * zs
-               
-               zd  = -2.042967e-2
-               zc  =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
-               zaw = ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
-               za  = ( zd*zsr + zc ) *zs + zaw
-               
-               zb1 =   (-0.1909078*zt+7.390729 ) *zt-55.87545
-               za1 = ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
-               zkw = ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
-               zk0 = ( zb1*zsr + za1 )*zs + zkw
-               zcomp =   1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )
-               
-#if defined key_kppcustom
-               ! potential density of water(zrh = zt,zs at level jk):
-               zrhdr = zrh / zcomp
-#else
-               ! potential density of water(ztref,zsref at level jk):
-               ! compute volumic mass pure water at atm pressure
-               IF ( nn_eos < 1 ) THEN
-                  zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   &
-                     &       -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
-                  ! seawater volumic mass atm pressure
-                  zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt   &
-                     &   -4.0899e-3 ) *zt+0.824493
-                  zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
-                  zr4= 4.8314e-4              
-                  ! potential volumic mass (reference to the surface)
-                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1                 
-                  zrhdr = zrhop / zcomp
-               ELSE
-                  zrhdr = zrh / zcomp
-               ENDIF
-#endif
-               
-               ! potential density of ambiant water at level jk :
-               zrhd   = ( rhd(ji,jj,jk) * rau0 + rau0 )  
-               
-               ! And now the Rib number numerator .
-               zrinum = grav * ( zrhd - zrhdr ) / rau0
-               zrinum = zrinum * ( fsdept(ji,jj,jk) - zref ) * tmask(ji,jj,jk)
-           
-               ! Resolved shear contribution to Rib at depth T-point (zdVsq)
-               ztx    =   ( ub( ji , jj ,jk)   +  ub(ji - 1, jj ,jk) ) &
-                  &     / MAX( 1. , umask( ji , jj ,jk) + umask(ji - 1, jj ,jk) )   
-               zty    =   ( vb( ji , jj ,jk)   +  vb(ji  ,jj - 1,jk) ) &
-                  &     / MAX( 1., vmask( ji , jj ,jk) + vmask(ji  ,jj - 1,jk) ) 
-               
-               zdVsq  = ( zu - ztx ) * ( zu - ztx ) + ( zv - zty ) * ( zv - zty )
-               
-               ! Scalar turbulent velocity scale zws for hbl=gdept
-               zscale = zstabl + ( 1.0 - zstabl ) * epsilon
-               zehat  = vonk * zscale * fsdept(ji,jj,jk) * zbuofdep
-               zucube = zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj)              
-               zeta   = zehat / ( zucube + epsln )
-               
-               IF( zehat > 0. ) THEN
-                  ! Stable case
-                  zws  = vonk * zustar(ji,jj) / ( 1.0 + rconc1 * zeta )
-               ELSE
-                  ! Unstable case
-#if defined key_kpplktb
-                  ! use lookup table
-                  zd     = zehat - dehatmin
-                  il     = INT( zd / dezehat )
-                  il     = MIN( il, nilktbm1 )
-                  il     = MAX( il, 1 )
-                  
-                  ud     = zustar(ji,jj) - ustmin
-                  jl     = INT( ud / deustar )
-                  jl     = MIN( jl, njlktbm1 )
-                  jl     = MAX( jl, 1 )
-                  
-                  zfrac  = zd / dezehat - FLOAT( il )  
-                  ufrac  = ud / deustar - FLOAT( jl )
-                  zwas   = ( 1. - zfrac ) * wslktb(il,jl+1) + zfrac * wslktb(il+1,jl+1)
-                  zwbs   = ( 1. - zfrac ) * wslktb(il,jl  ) + zfrac * wslktb(il+1,jl  )
-                  !
-                  zws    = ( 1. - ufrac ) * zwbs + ufrac * zwas
-#else
-                  ! use analytical functions:
-                  zcons  = 0.5 + SIGN( 0.5 , ( rzetas - zeta ) )
-                  zwcons = vonk * zustar(ji,jj) * ( ( ABS( rconas - rconcs * zeta ) )**pthird ) 
-                  zwsun  = vonk * zustar(ji,jj) * SQRT( ABS ( 1.0 - rconc2 * zeta ) )
-                  !
-                  zws    = zcons * zwcons +  ( 1.0 - zcons) * zwsun
-#endif
-               ENDIF
-               
-               ! Turbulent shear contribution to Rib (zVtsq) bv frequency at levels  ( ie T-point jk)
-               zrn2   = 0.5 * ( rn2(ji,jj,jk) + rn2(ji,jj,jk+1) )   
-               zbvzed = SQRT( ABS( zrn2 ) ) 
-               zVtsq  = fsdept(ji,jj,jk) * zws * zbvzed  * Vtc
-               
-               ! Finally, the bulk Richardson number at depth fsdept(i,j,k) 
-               zrib  = zrinum   / ( zdVsq + zVtsq + epsln )
- 
-               ! Find subscripts around the boundary layer depth, build the pipe
-               ! ----------------------------------------------------------------
-
-               ! Flag (zflagri = 1) if zrib < Ricr  
-               zflagri = 0.5 + SIGN( 0.5, ( Ricr - zrib ) )
-               !  Flag (zflagh  = 1) if still within overall boundary layer
-               zflagh  = 0.5 + SIGN( 0.5, ( fsdept(ji,jj,1) - zdept(ji,2) ) )
-               
-               ! Ekman layer depth
-               zek     = zstabl * zekman(ji) + ( 1.0 - zstabl ) * zhmax(ji)
-               zflag   = 0.5 + SIGN( 0.5, ( zek - fsdept(ji,jj,jk-1) ) )
-               zek     = zflag * zek + ( 1.0 - zflag ) * zhmax(ji)
-               zflagek = 0.5 + SIGN( 0.5, ( zek - fsdept(ji,jj,jk) ) )
-               ! Flag (zflagmo = 1) if still within stable Monin-Obukhov and in water
-               zmob    = zucube / ( vonk * ( zbuofdep + epsln ) )  
-               ztemp   = zstabl * zmob + ( 1.0 - zstabl) * zhmax(ji)
-               ztemp   = MIN( ztemp , zhmax(ji) ) 
-               zflagmo = 0.5 + SIGN( 0.5, ( ztemp - fsdept(ji,jj,jk) ) )             
-
-               ! No limitation by Monin Obukhov or Ekman depths:
-!               zflagek = 1.0
-!               zflagmo = 0.5 + SIGN( 0.5, ( zhmax(ji) - fsdept(ji,jj,jk) ) )
-
-               ! Load  pipe via zflagkb  for later calculations
-               ! Flag (zflagkb = 1) if zflagh = 1 and (zflagri = 0 or zflagek = 0 or zflagmo = 0)
-               zflagkb = zflagh * ( 1.0 - ( zflagri * zflagek * zflagmo ) )
-
-               zmask(ji,jk) = zflagh
-               jkp2         = MIN( jk+2 , ikbot )
-               jkm1         = MAX( jk-1 , 2 )
-               jkmax        = MAX( jkmax, jk * INT( REAL( zflagh+epsln ) ) ) 
-
-               zdept(ji,1)  = zdept(ji,1) + zflagkb * fsdept(ji,jj,jk-1) 
-               zdept(ji,2)  = zdept(ji,2) + zflagkb * fsdept(ji,jj,jk  ) 
-               zdept(ji,3)  = zdept(ji,3) + zflagkb * fsdept(ji,jj,jk+1) 
-
-               zdepw(ji,1)  = zdepw(ji,1) + zflagkb * fsdepw(ji,jj,jk-1) 
-               zdepw(ji,2)  = zdepw(ji,2) + zflagkb * fsdepw(ji,jj,jk  ) 
-               zdepw(ji,3)  = zdepw(ji,3) + zflagkb * fsdepw(ji,jj,jk+1)
-               zdepw(ji,4)  = zdepw(ji,4) + zflagkb * fsdepw(ji,jj,jkp2)  
-
-               zriblk(ji,1) = zriblk(ji,1) + zflagkb * zria(ji)
-               zriblk(ji,2) = zriblk(ji,2) + zflagkb * zrib
-
-               zmoek (ji,0) = zmoek (ji,0) + zflagkb * zek
-               zmoek (ji,1) = zmoek (ji,1) + zflagkb * zmoa(ji)
-               zmoek (ji,2) = zmoek (ji,2) + zflagkb * ztemp  
-               ! Save Monin Obukhov depth
-               zmoa  (ji)   = zmob
-           
-               zvisc(ji,1) = zvisc(ji,1) + zflagkb * avmu(ji,jj,jkm1)
-               zvisc(ji,2) = zvisc(ji,2) + zflagkb * avmu(ji,jj,jk  )
-               zvisc(ji,3) = zvisc(ji,3) + zflagkb * avmu(ji,jj,jk+1)
-               zvisc(ji,4) = zvisc(ji,4) + zflagkb * avmu(ji,jj,jkp2)
-               
-               zdift(ji,1) = zdift(ji,1) + zflagkb * avt (ji,jj,jkm1)
-               zdift(ji,2) = zdift(ji,2) + zflagkb * avt (ji,jj,jk  )
-               zdift(ji,3) = zdift(ji,3) + zflagkb * avt (ji,jj,jk+1)
-               zdift(ji,4) = zdift(ji,4) + zflagkb * avt (ji,jj,jkp2)
-
-#if defined key_zdfddm
-               zdifs(ji,1) = zdifs(ji,1) + zflagkb * avs (ji,jj,jkm1)
-               zdifs(ji,2) = zdifs(ji,2) + zflagkb * avs (ji,jj,jk  )
-               zdifs(ji,3) = zdifs(ji,3) + zflagkb * avs (ji,jj,jk+1)
-               zdifs(ji,4) = zdifs(ji,4) + zflagkb * avs (ji,jj,jkp2)
-#endif               
-               ! Save the Richardson number 
-               zria  (ji)   = zrib  
-#if defined key_c1d
-               ! store buoyancy length scale
-               buof(ji,jj,jk) = zbuofdep * tmask(ji,jj,jk) 
-               ! store Monin Obukhov
-               zmob           = zstabl * zmob + ( 1.0 - zstabl) * fsdept(ji,jj,1)
-               mols(ji,jj,jk) = MIN( zmob , zhmax(ji) ) * tmask(ji,jj,jk) 
-               ! Bulk Richardson number
-               rib(ji,jj,jk)  = zrib * tmask(ji,jj,jk)             
-#endif               
-            END DO
-         END DO
-         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-         ! III PROCESS THE PIPE
-         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-         
-         DO ji = fs_2, fs_jpim1 
-            
-            ! Find the boundary layer depth zhbl
-            ! ----------------------------------------
-            
-            ! Interpolate monin Obukhov and critical Ri mumber depths   
-            ztemp = zdept(ji,2) - zdept(ji,1)
-            zflag = ( Ricr - zriblk(ji,1) ) / ( zriblk(ji,2) - zriblk(ji,1)  + epsln )
-            zhrib = zdept(ji,1) + zflag * ztemp      
-
-            IF( zriblk(ji,2) < Ricr ) zhrib = zhmax(ji) 
-         
-            IF( zmoek(ji,2) < zdept(ji,2) ) THEN
-               IF ( zmoek(ji,1) < 0. ) THEN
-                  zmob = zdept(ji,2) - epsln
-               ELSE
-                  zmob = ztemp + zmoek(ji,1) - zmoek(ji,2)
-                  zmob = ( zmoek(ji,1) * zdept(ji,2) - zmoek(ji,2) * zdept(ji,1) ) / zmob
-                  zmob = MAX( zmob , zdept(ji,1) + epsln )                
-               ENDIF
-            ELSE           
-               zmob = zhmax(ji) 
-            ENDIF
-            ztemp   = MIN( zmob , zmoek(ji,0) )
-                         
-            ! Finally, the boundary layer depth, zhbl 
-            zhbl(ji) = MAX( fsdept(ji,jj,1) + epsln, MIN( zhrib , ztemp ) )
-            
-            ! Save hkpp for further diagnostics (optional)
-            hkpp(ji,jj) = zhbl(ji) * tmask(ji,jj,1) 
-          
-            ! Correct mask if zhbl < fsdepw(ji,jj,2) for no viscosity/diffusivity enhancement at fsdepw(ji,jj,2)
-            !     zflag = 1 if zhbl(ji) > fsdepw(ji,jj,2)
-            IF( zhbl(ji) < fsdepw(ji,jj,2) ) zmask(ji,2) = 0.
-          
-            
-            !  Velocity scales at depth zhbl
-            ! -----------------------------------
-            
-            !  Compute bouyancy forcing down to zhbl
-            ztemp    = -hbf * zhbl(ji)
-            zatt1    = 1.0 - ( rabs * EXP( ztemp / xsi1 ) + ( 1.0 - rabs ) * EXP( ztemp / xsi2 ) )
-            zbuofdep = zBo(ji,jj) + zBosol(ji,jj) * zatt1
-            zstabl   = 0.5 + SIGN( 0.5 , zbuofdep ) 
-
-            zbuofdep = zbuofdep + zstabl * epsln
-
-            zscale = zstabl + ( 1.0 - zstabl ) * epsilon          
-            zehat  = vonk * zscale * zhbl(ji) * zbuofdep
-            zucube = zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj)              
-            zeta   = zehat / ( zucube + epsln )
-            
-            IF( zehat > 0. ) THEN
-               ! Stable case
-               zws  = vonk * zustar(ji,jj) / ( 1.0 + rconc1 * zeta )
-               zwm  = zws
-            ELSE
-               ! Unstable case
-#if defined key_kpplktb
-               ! use lookup table
-               zd     = zehat - dehatmin
-               il     = INT( zd / dezehat )
-               il     = MIN( il, nilktbm1 )
-               il     = MAX( il, 1 )
-               
-               ud     = zustar(ji,jj) - ustmin
-               jl     = INT( ud / deustar )
-               jl     = MIN( jl, njlktbm1 )
-               jl     = MAX( jl, 1 )
-               
-               zfrac  = zd / dezehat - FLOAT( il )  
-               ufrac  = ud / deustar - FLOAT( jl )
-               zwas   = ( 1. - zfrac ) * wslktb(il,jl+1) + zfrac * wslktb(il+1,jl+1)
-               zwbs   = ( 1. - zfrac ) * wslktb(il,jl  ) + zfrac * wslktb(il+1,jl  )
-               zwam   = ( 1. - zfrac ) * wmlktb(il,jl+1) + zfrac * wmlktb(il+1,jl+1)
-               zwbm   = ( 1. - zfrac ) * wmlktb(il,jl  ) + zfrac * wmlktb(il+1,jl  )
-               !
-               zws    = ( 1. - ufrac ) * zwbs + ufrac * zwas
-               zwm    = ( 1. - ufrac ) * zwbm + ufrac * zwam
-#else
-               ! use analytical functions
-               zconm  = 0.5 + SIGN( 0.5, ( rzetam - zeta) )
-               zcons  = 0.5 + SIGN( 0.5, ( rzetas - zeta) )
-               
-               ! Momentum : zeta < rzetam (zconm = 1)
-               ! Scalars  : zeta < rzetas (zcons = 1) 
-               zwconm = zustar(ji,jj) * vonk * ( ( ABS( rconam - rconcm * zeta) )**pthird )
-               zwcons = zustar(ji,jj) * vonk * ( ( ABS( rconas - rconcs * zeta) )**pthird )
-               
-               ! Momentum : rzetam <= zeta < 0 (zconm = 0)
-               ! Scalars  : rzetas <= zeta < 0 (zcons = 0)	
-               zwmun  = SQRT( ABS( 1.0 - rconc2 * zeta ) )
-               zwsun  = vonk * zustar(ji,jj) * zwmun
-               zwmun  = vonk * zustar(ji,jj) * SQRT(zwmun)
-               !
-               zwm    = zconm * zwconm + ( 1.0 - zconm ) * zwmun
-               zws    = zcons * zwcons + ( 1.0 - zcons ) * zwsun
-               
-#endif
-            ENDIF
-            
-            
-            ! Viscosity, diffusivity values and derivatives at h
-            ! --------------------------------------------------------
-            
-            ! check between at which interfaces is located zhbl(ji)
-            ! ztemp = 1, zdepw(ji,2) < zhbl <  zdepw(ji,3)
-            ! ztemp = 0, zdepw(ji,1) < zhbl <  zdepw(ji,2)
-            ztemp  =  0.5 + SIGN( 0.5, ( zhbl(ji) - zdepw(ji,2) ) )  
-            zdep21 =   zdepw(ji,2) - zdepw(ji,1) + epsln
-            zdep32 =   zdepw(ji,3) - zdepw(ji,2) + epsln
-            zdep43 =   zdepw(ji,4) - zdepw(ji,3) + epsln  
-            
-            ! Compute R as in LMD94, eq D5b
-            zdelta =  ( zhbl(ji) - zdepw(ji,2) ) *         ztemp   / zdep32   &
-               &    + ( zhbl(ji) - zdepw(ji,1) ) * ( 1.0 - ztemp ) / zdep21 
-            
-            ! Compute the vertical derivative of viscosities (zdzh) at z=zhbl(ji)
-            zdzup  =  ( zvisc(ji,2) - zvisc(ji,3) ) *         ztemp   / zdep32 &
-               &    + ( zvisc(ji,1) - zvisc(ji,2) ) * ( 1.0 - ztemp ) / zdep21
-            
-            zdzdn  =  ( zvisc(ji,3) - zvisc(ji,4) ) *         ztemp   / zdep43 &
-               &    + ( zvisc(ji,2) - zvisc(ji,3) ) * ( 1.0 - ztemp ) / zdep32
-            
-            ! LMD94, eq D5b :          
-            zdzh   = ( 1.0 - zdelta ) * zdzup + zdelta * zdzdn
-            zdzh   = MAX( zdzh , 0. )
-            
-            ! Compute viscosities (zvath) at z=zhbl(ji), LMD94 eq D5a
-            zvath  =          ztemp   * ( zvisc(ji,3) + zdzh * ( zdepw(ji,3) - zhbl(ji) ) ) &
-               &    + ( 1.0 - ztemp ) * ( zvisc(ji,2) + zdzh * ( zdepw(ji,2) - zhbl(ji) ) )
-            
-            ! Compute G (zgat1) and its derivative (zdat1) at z=hbl(ji), LMD94 eq 18
-            
-            ! Vertical derivative of velocity scale divided by velocity scale squared at z=hbl(ji) 
-            ! (non zero only in stable conditions)
-            zflag  =  -zstabl * rconc1 * zbuofdep / ( zucube * zustar(ji,jj) + epsln )
-            
-            ! G at its derivative at z=hbl:
-            zgat1  = zvath  / ( zhbl(ji) * ( zwm + epsln )  )
-            zdat1  = -zdzh  / ( zwm + epsln ) -  zflag * zvath / zhbl(ji)
-            
-            ! G coefficients, LMD94 eq 17
-            za2m(ji) = -2.0 + 3.0 * zgat1 - zdat1
-            za3m(ji) =  1.0 - 2.0 * zgat1 + zdat1
-
-            
-            ! Compute the vertical derivative of temperature diffusivities (zdzh) at z=zhbl(ji)
-            zdzup  =  ( zdift(ji,2) - zdift(ji,3) ) *         ztemp   / zdep32 &
-               &    + ( zdift(ji,1) - zdift(ji,2) ) * ( 1.0 - ztemp ) / zdep21
-            
-            zdzdn  =  ( zdift(ji,3) - zdift(ji,4) ) *         ztemp   / zdep43 &
-               &    + ( zdift(ji,2) - zdift(ji,3) ) * ( 1.0 - ztemp ) / zdep32
-            
-            ! LMD94, eq D5b :          
-            zdzh   = ( 1.0 - zdelta ) * zdzup + zdelta * zdzdn
-            zdzh   = MAX( zdzh , 0. )
-            
-            
-            ! Compute diffusivities (zvath) at z=zhbl(ji), LMD94 eq D5a
-            zvath  =          ztemp   * ( zdift(ji,3) + zdzh * ( zdepw(ji,3) - zhbl(ji) ) ) &
-               &    + ( 1.0 - ztemp ) * ( zdift(ji,2) + zdzh * ( zdepw(ji,2) - zhbl(ji) ) )
-                        
-            ! G at its derivative at z=hbl:
-            zgat1  = zvath  / ( zhbl(ji) * ( zws + epsln )  )
-            zdat1  = -zdzh  / ( zws + epsln ) -  zflag * zvath / zhbl(ji)
-            
-            ! G coefficients, LMD94 eq 17
-            za2t(ji) = -2.0 + 3.0 * zgat1 - zdat1
-            za3t(ji) =  1.0 - 2.0 * zgat1 + zdat1
-
-#if defined key_zdfddm
-            ! Compute the vertical derivative of salinities diffusivities (zdzh) at z=zhbl(ji)
-            zdzup  =  ( zdifs(ji,2) - zdifs(ji,3) ) *         ztemp   / zdep32 &
-               &    + ( zdifs(ji,1) - zdifs(ji,2) ) * ( 1.0 - ztemp ) / zdep21
-            
-            zdzdn  =  ( zdifs(ji,3) - zdifs(ji,4) ) *         ztemp   / zdep43 &
-               &    + ( zdifs(ji,2) - zdifs(ji,3) ) * ( 1.0 - ztemp ) / zdep32
-            
-            ! LMD94, eq D5b :          
-            zdzh   = ( 1.0 - zdelta ) * zdzup + zdelta * zdzdn
-            zdzh   = MAX( zdzh , 0. )           
-            
-            ! Compute diffusivities (zvath) at z=zhbl(ji), LMD94 eq D5a
-            zvath  =          ztemp   * ( zdifs(ji,3) + zdzh * ( zdepw(ji,3) - zhbl(ji) ) ) &
-               &    + ( 1.0 - ztemp ) * ( zdifs(ji,2) + zdzh * ( zdepw(ji,2) - zhbl(ji) ) )
-                        
-            ! G at its derivative at z=hbl:
-            zgat1  = zvath  / ( zhbl(ji) * ( zws + epsln )  )
-            zdat1  = -zdzh  / ( zws + epsln ) -  zflag * zvath / zhbl(ji)
-            
-            ! G coefficients, LMD94 eq 17
-            za2s(ji) = -2.0 + 3.0 * zgat1 - zdat1
-            za3s(ji) =  1.0 - 2.0 * zgat1 + zdat1
-#endif
-
-            !-------------------turn off interior matching here------
-            !          za2(ji,1) = -2.0
-            !          za3(ji,1) =  1.0
-            !          za2(ji,2) = -2.0
-            !          za3(ji,2) =  1.0
-            !--------------------------------------------------------
-            
-            !  Compute Enhanced Mixing Coefficients (LMD94,eq D6)
-            ! ---------------------------------------------------------------
-            
-            ! Delta 
-            zdelta  = ( zhbl(ji)  - zdept(ji,1) ) / ( zdept(ji,2) - zdept(ji,1) + epsln )
-            zdelta2 = zdelta * zdelta
-            
-            !  Mixing coefficients at first level above h (zdept(ji,1)) 
-            ! and at first interface in the pipe (zdepw(ji,2))
-            
-            ! At first T level above h (zdept(ji,1)) (always in the boundary layer)
-            zsig    = zdept(ji,1) / zhbl(ji)
-            ztemp   = zstabl * zsig  + ( 1.0 - zstabl ) * MIN( zsig , epsilon )
-            zehat   = vonk * ztemp * zhbl(ji) * zbuofdep
-            zeta    = zehat / ( zucube + epsln)
-            zwst    = vonk * zustar(ji,jj) / ( ABS( 1.0 + rconc1 * zeta ) + epsln)
-            zwm     = zstabl * zwst + ( 1.0 - zstabl ) * zwm
-            zws     = zstabl * zwst + ( 1.0 - zstabl ) * zws
-
-            zkm1m  = zhbl(ji) * zwm * zsig * ( 1.0 + zsig * ( za2m(ji) + zsig * za3m(ji) ) )
-            zkm1t  = zhbl(ji) * zws * zsig * ( 1.0 + zsig * ( za2t(ji) + zsig * za3t(ji) ) )
-#if defined key_zdfddm
-            zkm1s  = zhbl(ji) * zws * zsig * ( 1.0 + zsig * ( za2s(ji) + zsig * za3s(ji) ) )
-#endif                        
-            ! At first W level in the pipe (zdepw(ji,2)) (not always in the boundary layer ):
-            zsig    = MIN( zdepw(ji,2) / zhbl(ji) , 1.0 )
-            ztemp   = zstabl * zsig + ( 1.0 - zstabl ) * MIN( zsig , epsilon )
-            zehat   = vonk * ztemp * zhbl(ji) * zbuofdep
-            zeta    = zehat / ( zucube + epsln )
-            zwst    = vonk * zustar(ji,jj) / ( ABS( 1.0 + rconc1 * zeta ) + epsln)
-            zws     = zstabl * zws + ( 1.0 - zstabl ) * zws
-            zwm     = zstabl * zws + ( 1.0 - zstabl ) * zwm
-
-            zkmpm(ji) = zhbl(ji) * zwm * zsig * ( 1.0 + zsig * ( za2m(ji) + zsig * za3m(ji) ) )
-            zkmpt(ji) = zhbl(ji) * zws * zsig * ( 1.0 + zsig * ( za2t(ji) + zsig * za3t(ji) ) )
-#if defined key_zdfddm
-            zkmps(ji) = zhbl(ji) * zws * zsig * ( 1.0 + zsig * ( za2s(ji) + zsig * za3s(ji) ) )
-#endif  
-      
-            ! check if this point is in the boundary layer,else take interior viscosity/diffusivity:
-            zflag       = 0.5 + SIGN( 0.5, ( zhbl(ji) - zdepw(ji,2) ) )
-            zkmpm(ji) = zkmpm(ji) * zflag + ( 1.0 - zflag ) * zvisc(ji,2)
-            zkmpt(ji) = zkmpt(ji) * zflag + ( 1.0 - zflag ) * zdift(ji,2)
-#if defined key_zdfddm
-            zkmps(ji) = zkmps(ji) * zflag + ( 1.0 - zflag ) * zdifs(ji,2)
-#endif
-
-            ! Enhanced viscosity/diffusivity at zdepw(ji,2)
-            ztemp     = ( 1.0 - 2.0 * zdelta + zdelta2 ) * zkm1m + zdelta2 * zkmpm(ji)
-            zkmpm(ji) = ( 1.0 - zdelta ) * zvisc(ji,2) + zdelta * ztemp
-            ztemp     = ( 1.0 - 2.0 * zdelta + zdelta2 ) * zkm1t + zdelta2 * zkmpt(ji)
-            zkmpt(ji) = ( 1.0 - zdelta ) * zdift(ji,2) + zdelta * ztemp
-#if defined key_zdfddm
-            ztemp     = ( 1.0 - 2.0 * zdelta + zdelta2 ) * zkm1s + zdelta2 * zkmps(ji)
-            zkmps(ji) = ( 1.0 - zdelta ) * zdifs(ji,2) + zdelta * ztemp
-#endif            
-
-         END DO
-         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-         ! IV. Compute vertical eddy viscosity and diffusivity coefficients
-         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-         
-         DO jk  = 2, jkmax
-            
-            ! Compute turbulent velocity scales on the interfaces
-            ! --------------------------------------------------------
-            DO  ji = fs_2, fs_jpim1
-               zbuofdep = zBo(ji,jj) + zBosol(ji,jj) * zatt1
-               zstabl   = 0.5 + SIGN( 0.5 , zbuofdep ) 
-               zbuofdep = zbuofdep + zstabl * epsln          
-               zsig    = fsdepw(ji,jj,jk) / zhbl(ji)
-               ztemp   = zstabl * zsig + ( 1. - zstabl ) * MIN( zsig , epsilon )
-               zehat   = vonk * ztemp * zhbl(ji) * zbuofdep
-               zucube  = zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj)
-               zeta    = zehat / ( zucube + epsln )
-
-               IF( zehat > 0. ) THEN
-                  ! Stable case
-                  zws  = vonk * zustar(ji,jj) / ( 1.0 + rconc1 * zeta )
-                  zwm  = zws
-               ELSE
-                  ! Unstable case
-#if defined key_kpplktb
-                  ! use lookup table
-                  zd     = zehat - dehatmin
-                  il     = INT( zd / dezehat )
-                  il     = MIN( il, nilktbm1 )
-                  il     = MAX( il, 1 )
-                  
-                  ud     = zustar(ji,jj) - ustmin
-                  jl     = INT( ud / deustar )
-                  jl     = MIN( jl, njlktbm1 )
-                  jl     = MAX( jl, 1 )
-                  
-                  zfrac  = zd / dezehat - FLOAT( il )  
-                  ufrac  = ud / deustar - FLOAT( jl )
-                  zwas   = ( 1. - zfrac ) * wslktb(il,jl+1) + zfrac * wslktb(il+1,jl+1)
-                  zwbs   = ( 1. - zfrac ) * wslktb(il,jl  ) + zfrac * wslktb(il+1,jl  )
-                  zwam   = ( 1. - zfrac ) * wmlktb(il,jl+1) + zfrac * wmlktb(il+1,jl+1)
-                  zwbm   = ( 1. - zfrac ) * wmlktb(il,jl  ) + zfrac * wmlktb(il+1,jl  )
-                  !
-                  zws    = ( 1. - ufrac ) * zwbs + ufrac * zwas
-                  zwm    = ( 1. - ufrac ) * zwbm + ufrac * zwam
-#else
-                  ! use analytical functions
-                  zconm  = 0.5 + SIGN( 0.5, ( rzetam - zeta) )
-                  zcons  = 0.5 + SIGN( 0.5, ( rzetas - zeta) )
-                  
-                  ! Momentum : zeta < rzetam (zconm = 1)
-                  ! Scalars  : zeta < rzetas (zcons = 1) 
-                  zwconm = zustar(ji,jj) * vonk * ( ( ABS( rconam - rconcm * zeta) )**pthird )
-                  zwcons = zustar(ji,jj) * vonk * ( ( ABS( rconas - rconcs * zeta) )**pthird )
-                  
-                  ! Momentum : rzetam <= zeta < 0 (zconm = 0)
-                  ! Scalars  : rzetas <= zeta < 0 (zcons = 0)	
-                  zwmun  = SQRT( ABS( 1.0 - rconc2 * zeta ) )
-                  zwsun  = vonk * zustar(ji,jj) * zwmun
-                  zwmun  = vonk * zustar(ji,jj) * SQRT(zwmun)
-                  !
-                  zwm    = zconm * zwconm + ( 1.0 - zconm ) * zwmun
-                  zws    = zcons * zwcons + ( 1.0 - zcons ) * zwsun
-                  
-#endif
-               ENDIF
-               
-               zblcm(ji,jk) = zhbl(ji) * zwm * zsig  * ( 1.0 + zsig * ( za2m(ji) + zsig * za3m(ji) ) )
-               zblct(ji,jk) = zhbl(ji) * zws * zsig  * ( 1.0 + zsig * ( za2t(ji) + zsig * za3t(ji) ) )
-#if defined key_zdfddm
-               zblcs(ji,jk) = zhbl(ji) * zws * zsig  * ( 1.0 + zsig * ( za2s(ji) + zsig * za3s(ji) ) )
-#endif              
-               !  Compute Nonlocal transport term = ghats * <ws>o
-               ! ----------------------------------------------------
-               ghats(ji,jj,jk-1) = ( 1. - zstabl ) * rcg / ( zws * zhbl(ji) + epsln ) * tmask(ji,jj,jk)
-
-            END DO
-         END DO     
-         !  Combine interior and boundary layer coefficients and nonlocal term
-         ! -----------------------------------------------------------------------
-         DO jk = 2, jpkm1   
-            DO ji = fs_2, fs_jpim1
-               zflag = zmask(ji,jk) * zmask(ji,jk+1)
-               zviscos(ji,jj,jk) = ( 1.0 - zmask(ji,jk) )         * avmu (ji,jj,jk) & ! interior viscosities
-                  &              +                        zflag   * zblcm(ji,jk    ) & ! boundary layer viscosities
-                  &              + zmask(ji,jk) * ( 1.0 - zflag ) * zkmpm(ji       )   ! viscosity enhancement at W_level near zhbl
-               
-               zviscos(ji,jj,jk) = zviscos(ji,jj,jk) * tmask(ji,jj,jk)   
-
-            
-               zdiffut(ji,jj,jk) = ( 1.0 - zmask(ji,jk) )          * avt (ji,jj,jk) & ! interior diffusivities 
-                  &              +                        zflag   * zblct(ji,jk   ) & ! boundary layer diffusivities
-                  &              + zmask(ji,jk) * ( 1.0 - zflag ) * zkmpt(ji      )   ! diffusivity enhancement at W_level near zhbl
-                       
-               zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) * tmask(ji,jj,jk) 
-#if defined key_zdfddm
-               zdiffus(ji,jj,jk) = ( 1.0 - zmask(ji,jk) )         * avs (ji,jj,jk) & ! interior diffusivities 
-                  &              +                        zflag   * zblcs(ji,jk   ) & ! boundary layer diffusivities
-                  &              + zmask(ji,jk) * ( 1.0 - zflag ) * zkmps(ji      )   ! diffusivity enhancement at W_level near zhbl
-               zdiffus(ji,jj,jk) = zdiffus(ji,jj,jk) * tmask(ji,jj,jk) 
-#endif               
-               ! Non local flux in the boundary layer only
-               ghats(ji,jj,jk-1) = zmask(ji,jk) * ghats(ji,jj,jk-1)
-
-            ENDDO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      ! Lateral boundary conditions on zvicos and zdiffus  (sign unchanged)
-      CALL lbc_lnk( zviscos(:,:,:), 'U', 1. )  ; CALL lbc_lnk( zdiffut(:,:,:), 'W', 1. )  
-#if defined key_zdfddm  
-      CALL lbc_lnk( zdiffus(:,:,:), 'W', 1. ) 
-#endif
-
-      SELECT CASE ( nn_ave )
-         !
-         CASE ( 0 )             ! no viscosity and diffusivity smoothing
-
-            DO jk = 2, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     avmu(ji,jj,jk) = ( zviscos(ji,jj,jk) + zviscos(ji+1,jj,jk) ) &
-                        &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk)
-                     
-                     avmv(ji,jj,jk) = ( zviscos(ji,jj,jk) + zviscos(ji,jj+1,jk) ) &
-                        &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk)
-                     
-                     avt (ji,jj,jk) =  zdiffut(ji,jj,jk) * tmask(ji,jj,jk)  
-#if defined key_zdfddm     
-                     avs (ji,jj,jk) =  zdiffus(ji,jj,jk) * tmask(ji,jj,jk)  
-#endif
-                  END DO
-               END DO
-            END DO
-            
-         CASE ( 1 )                ! viscosity and diffusivity smoothing
-            !                      
-            !           ( 1/2  1  1/2 )              ( 1/2  1/2 )             ( 1/2  1  1/2 )
-            ! avt = 1/8 ( 1    2  1   )   avmu = 1/4 ( 1    1   )   avmv= 1/4 ( 1/2  1  1/2 )
-            !           ( 1/2  1  1/2 )              ( 1/2  1/2 )
-  
-            DO jk = 2, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-
-                     avmu(ji,jj,jk) = (      zviscos(ji  ,jj  ,jk) + zviscos(ji+1,jj  ,jk)   &
-                        &              +.5*( zviscos(ji  ,jj-1,jk) + zviscos(ji+1,jj-1,jk)   &
-                        &                   +zviscos(ji  ,jj+1,jk) + zviscos(ji+1,jj+1,jk) ) ) * eumean(ji,jj,jk)
-                     
-                     avmv(ji,jj,jk) = (      zviscos(ji  ,jj  ,jk) + zviscos(ji  ,jj+1,jk)   &
-                        &              +.5*( zviscos(ji-1,jj  ,jk) + zviscos(ji-1,jj+1,jk)   &
-                        &                   +zviscos(ji+1,jj  ,jk) + zviscos(ji+1,jj+1,jk) ) ) * evmean(ji,jj,jk)
- 
-                     avt (ji,jj,jk) = ( .5*( zdiffut(ji-1,jj+1,jk) + zdiffut(ji-1,jj-1,jk)    &
-                        &                   +zdiffut(ji+1,jj+1,jk) + zdiffut(ji+1,jj-1,jk) )  &
-                        &              +1.*( zdiffut(ji-1,jj  ,jk) + zdiffut(ji  ,jj+1,jk)    &
-                        &                   +zdiffut(ji  ,jj-1,jk) + zdiffut(ji+1,jj  ,jk) )  &
-                        &              +2.*  zdiffut(ji  ,jj  ,jk)                          ) * etmean(ji,jj,jk)
-#if defined key_zdfddm   
-                     avs (ji,jj,jk) = ( .5*( zdiffus(ji-1,jj+1,jk) + zdiffus(ji-1,jj-1,jk)    &
-                        &                   +zdiffus(ji+1,jj+1,jk) + zdiffus(ji+1,jj-1,jk) )  &
-                        &              +1.*( zdiffus(ji-1,jj  ,jk) + zdiffus(ji  ,jj+1,jk)    &
-                        &                   +zdiffus(ji  ,jj-1,jk) + zdiffus(ji+1,jj  ,jk) )  &
-                        &              +2.*  zdiffus(ji  ,jj  ,jk)                          ) * etmean(ji,jj,jk)  
-#endif                
-                  END DO
-               END DO
-            END DO
-         
-         END SELECT
-
-         DO jk = 2, jpkm1                       ! vertical slab
-            !
-            !  Minimum value on the eddy diffusivity
-            ! ----------------------------------------
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  avt(ji,jj,jk) = MAX( avt(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
-#if defined key_zdfddm  
-                  avs(ji,jj,jk) = MAX( avs(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
-#endif
-               END DO
-            END DO
-
-            !
-            ! Minimum value on the eddy viscosity
-            ! ----------------------------------------
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), avmb(jk) ) * umask(ji,jj,jk)
-                  avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), avmb(jk) ) * vmask(ji,jj,jk)
-               END DO
-            END DO
-            !
-         END DO
-
-         ! Lateral boundary conditions on avt  (sign unchanged)
-         CALL lbc_lnk( hkpp(:,:), 'T', 1. )
-
-         ! Lateral boundary conditions on avt  (sign unchanged)
-         CALL lbc_lnk( avt(:,:,:), 'W', 1. )
-#if defined key_zdfddm  
-         CALL lbc_lnk( avs(:,:,:), 'W', 1. )  
-#endif
-         ! Lateral boundary conditions (avmu,avmv) (U- and V- points, sign unchanged)
-         CALL lbc_lnk( avmu(:,:,:), 'U', 1. )   ;    CALL lbc_lnk( avmv(:,:,:), 'V', 1. )  
- 
-         IF(ln_ctl) THEN
-#if defined key_zdfddm
-            CALL prt_ctl(tab3d_1=avt , clinfo1=' kpp - t: ', tab3d_2=avs , clinfo2=' s: ', ovlap=1, kdim=jpk)
-#else
-            CALL prt_ctl(tab3d_1=avt , clinfo1=' kpp - t: ', ovlap=1, kdim=jpk)
-#endif
-            CALL prt_ctl(tab3d_1=avmu, clinfo1=' kpp - u: ', mask1=umask,  &
-               &         tab3d_2=avmv, clinfo2=      ' v: ', mask2=vmask, ovlap=1, kdim=jpk)
-         ENDIF
-
-      CALL wrk_dealloc( jpi, zmoa, zekman, zhmax, zria, zhbl )
-      CALL wrk_dealloc( jpi, za2m, za3m, zkmpm, za2t, za3t, zkmpt )
-      CALL wrk_dealloc( jpi,2, zriblk )
-      CALL wrk_dealloc( jpi,3, zmoek, kjstart = 0 )
-      CALL wrk_dealloc( jpi,3, zdept )
-      CALL wrk_dealloc( jpi,4, zdepw, zdift, zvisc )
-      CALL wrk_dealloc( jpi,jpj, zBo, zBosol, zustar )
-      CALL wrk_dealloc( jpi,jpk, zmask, zblcm, zblct )
-#if defined key_zdfddm
-      CALL wrk_dealloc( jpi,4, zdifs )
-      CALL wrk_dealloc( jpi, zmoa, za2s, za3s, zkmps )
-      CALL wrk_dealloc( jpi,jpk, zblcs )
-      CALL wrk_dealloc( jpi,jpi,jpk, zdiffus )
-#endif
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('zdf_kpp')
-      !
-   END SUBROUTINE zdf_kpp
-
-
-   SUBROUTINE tra_kpp( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_kpp  ***
-      !!
-      !! ** Purpose :   compute and add to the tracer trend the non-local tracer flux
-      !!
-      !! ** Method  :   ???
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kt
-      INTEGER :: ji, jj, jk
-      !
-      IF( nn_timing == 1 )  CALL timing_start('tra_kpp')
-      !
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*) 
-         IF(lwp) WRITE(numout,*) 'tra_kpp : KPP non-local tracer fluxes'
-         IF(lwp) WRITE(numout,*) '~~~~~~~   '
-      ENDIF
-
-      IF( l_trdtra )   THEN                    !* Save ta and sa trends
-         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
-         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
-      ENDIF
-
-      ! add non-local temperature and salinity flux ( in convective case only)
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1 
-            DO ji = fs_2, fs_jpim1
-               tsa(ji,jj,jk,jp_tem) =  tsa(ji,jj,jk,jp_tem)                      &
-                  &                 - (  ghats(ji,jj,jk  ) * avt  (ji,jj,jk  )   & 
-                  &                    - ghats(ji,jj,jk+1) * avt  (ji,jj,jk+1) ) * wt0(ji,jj) / fse3t(ji,jj,jk)
-               tsa(ji,jj,jk,jp_sal) =  tsa(ji,jj,jk,jp_sal)                      &
-                  &                 - (  ghats(ji,jj,jk  ) * fsavs(ji,jj,jk  )   & 
-                  &                    - ghats(ji,jj,jk+1) * fsavs(ji,jj,jk+1) ) * ws0(ji,jj) / fse3t(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! save the non-local tracer flux trends for diagnostic
-      IF( l_trdtra )   THEN
-         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
-         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
-!!bug gm jpttdzdf ==> jpttkpp
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt )
-         CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds )
-         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )
-      ENDIF
-
-      IF(ln_ctl) THEN
-         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' kpp  - Ta: ', mask1=tmask,   &
-         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-      ENDIF
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_kpp')
-      !
-   END SUBROUTINE tra_kpp
-
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   SUBROUTINE trc_kpp( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_kpp  ***
-      !!
-      !! ** Purpose :   compute and add to the tracer trend the non-local
-      !!                tracer flux
-      !!
-      !! ** Method  :   ???
-      !!
-      !! history :
-      !!            9.0  ! 2005-11 (G. Madec)  Original code
-      !!       NEMO 3.3  ! 2010-06 (C. Ethe )  Adapted to passive tracers
-      !!----------------------------------------------------------------------
-      USE trc
-      USE prtctl_trc          ! Print control
-      !
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !
-      INTEGER  ::   ji, jj, jk, jn      ! Dummy loop indices
-      CHARACTER (len=35) :: charout
-      REAL(wp) ::   ztra, zflx
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*) 
-         IF(lwp) WRITE(numout,*) 'trc_kpp : KPP non-local tracer fluxes'
-         IF(lwp) WRITE(numout,*) '~~~~~~~   '
-      ENDIF
-
-      IF( l_trdtrc )  ALLOCATE( ztrtrd(jpi,jpj,jpk) )
-      !
-      DO jn = 1, jptra
-         !
-         IF( l_trdtrc )  ztrtrd(:,:,:)  = tra(:,:,:,jn)
-         ! add non-local on passive tracer flux ( in convective case only)
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1
-                  ! Surface tracer flux for non-local term 
-                  zflx = - ( sfx (ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1)
-                  ! compute the trend
-                  ztra = - ( ghats(ji,jj,jk  ) * fsavs(ji,jj,jk  )   &
-                  &        - ghats(ji,jj,jk+1) * fsavs(ji,jj,jk+1) ) * zflx / fse3t(ji,jj,jk)
-                  ! add the trend to the general trend
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)  + ztra
-               END DO
-            END DO
-         END DO
-         !
-         IF( l_trdtrc ) THEN         ! save the non-local tracer flux trends for diagnostic
-            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
-            CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:) )
-         ENDIF
-         !
-      END DO
-      IF( l_trdtrc )  DEALLOCATE( ztrtrd )
-      IF( ln_ctl )   THEN
-         WRITE(charout, FMT="(' kpp')")  ;  CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
-      ENDIF
-      !
-   END SUBROUTINE trc_kpp
-
-#else
-   !!----------------------------------------------------------------------
-   !!   NO 'key_top'           DUMMY routine                  No TOP models
-   !!----------------------------------------------------------------------
-   SUBROUTINE trc_kpp( kt )         ! Dummy routine
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      WRITE(*,*) 'tra_kpp: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_kpp
-#endif
-
-   SUBROUTINE zdf_kpp_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE zdf_kpp_init  ***
-      !!                     
-      !! ** Purpose :   Initialization of the vertical eddy diffivity and 
-      !!      viscosity when using a kpp turbulent closure scheme
-      !!
-      !! ** Method  :   Read the namkpp namelist and check the parameters
-      !!      called at the first timestep (nit000)
-      !!
-      !! ** input   :   Namlist namkpp
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk     ! dummy loop indices
-      INTEGER  ::   ios            ! local integer
-#if ! defined key_kppcustom
-      INTEGER  ::   jm             ! dummy loop indices     
-      REAL(wp) ::   zref, zdist    ! tempory scalars
-#endif
-#if defined key_kpplktb
-      REAL(wp) ::   zustar, zucube, zustvk, zeta, zehat   ! tempory scalars
-#endif
-      REAL(wp) ::   zhbf           ! tempory scalars
-      LOGICAL  ::   ll_kppcustom   ! 1st ocean level taken as surface layer
-      LOGICAL  ::   ll_kpplktb     ! Lookup table for turbul. velocity scales 
-      !!
-      NAMELIST/namzdf_kpp/ ln_kpprimix, rn_difmiw, rn_difsiw, rn_riinfty, rn_difri, rn_bvsqcon, rn_difcon, nn_ave
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('zdf_kpp_init')
-      !
-      REWIND( numnam_ref )              ! Namelist namzdf_kpp in reference namelist : Vertical eddy diffivity and viscosity using kpp turbulent closure scheme
-      READ  ( numnam_ref, namzdf_kpp, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_kpp in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namzdf_kpp in configuration namelist : Vertical eddy diffivity and viscosity using kpp turbulent closure scheme
-      READ  ( numnam_cfg, namzdf_kpp, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_kpp in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namzdf_kpp )
-
-      IF(lwp) THEN                    ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'zdf_kpp_init : K-Profile Parameterisation'
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namzdf_kpp : set tke mixing parameters'
-         WRITE(numout,*) '     Shear instability mixing                      ln_kpprimix = ', ln_kpprimix
-         WRITE(numout,*) '     max. internal wave viscosity                  rn_difmiw   = ', rn_difmiw
-         WRITE(numout,*) '     max. internal wave diffusivity                rn_difsiw   = ', rn_difsiw
-         WRITE(numout,*) '     Richardson Number limit for shear instability rn_riinfty  = ', rn_riinfty
-         WRITE(numout,*) '     max. shear mixing at Rig = 0                  rn_difri    = ', rn_difri
-         WRITE(numout,*) '     Brunt-Vaisala squared for max. convection     rn_bvsqcon  = ', rn_bvsqcon
-         WRITE(numout,*) '     max. mix. in interior convec.                 rn_difcon   = ', rn_difcon
-         WRITE(numout,*) '     horizontal average flag                       nn_ave      = ', nn_ave
-      ENDIF
-
-      !                              ! allocate zdfkpp arrays
-      IF( zdf_kpp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_kpp_init : unable to allocate arrays' )
-
-      ll_kppcustom = .FALSE.
-      ll_kpplktb   = .FALSE.
-
-#if defined key_kppcustom
-      ll_kppcustom = .TRUE.
-#endif
-#if defined key_kpplktb
-      ll_kpplktb   = .TRUE.
-#endif
-      IF(lwp) THEN
-         WRITE(numout,*) '     Lookup table for turbul. velocity scales ll_kpplktb   = ', ll_kpplktb
-         WRITE(numout,*) '     1st ocean level taken as surface layer   ll_kppcustom = ', ll_kppcustom
-      ENDIF
-      
-      IF( lk_zdfddm) THEN
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) '    Double diffusion mixing on temperature and salinity '
-            WRITE(numout,*) '    CAUTION : done in routine zdfkpp, not in routine zdfddm '
-         ENDIF
-      ENDIF
-      
-
-      !set constants not in namelist
-      !-----------------------------
-      Vtc  = rconcv * SQRT( 0.2 / ( rconcs * epsilon ) ) / ( vonk * vonk * Ricr )
-      rcg  = rcstar * vonk * ( rconcs * vonk * epsilon )**pthird
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '     Constant value for unreso. turbul. velocity shear Vtc = ', Vtc
-         WRITE(numout,*) '     Non-dimensional coef. for nonlocal transport      rcg = ', rcg
-       ENDIF
-
-      ! ratt is the attenuation coefficient for solar flux
-      ! Should be different is s_coordinate
-      DO jk = 1, jpk
-         zhbf     = - fsdept(1,1,jk) * hbf
-         ratt(jk) = 1.0 - ( rabs * EXP( zhbf / xsi1 ) + ( 1.0 - rabs ) * EXP( zhbf / xsi2 ) )        
-      ENDDO
-
-      ! Horizontal average : initialization of weighting arrays 
-      ! -------------------
-      
-      SELECT CASE ( nn_ave )
-
-      CASE ( 0 )                ! no horizontal average
-         IF(lwp) WRITE(numout,*) '          no horizontal average on avt, avmu, avmv'
-         IF(lwp) WRITE(numout,*) '          only in very high horizontal resolution !'
-         ! weighting mean arrays etmean, eumean and evmean
-         !           ( 1  1 )                                          ( 1 )
-         ! avt = 1/4 ( 1  1 )     avmu = 1/2 ( 1  1 )       avmv=  1/2 ( 1 )
-         !                          
-         etmean(:,:,:) = 0.e0
-         eumean(:,:,:) = 0.e0
-         evmean(:,:,:) = 0.e0
-         
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1   ! vector opt.
-                  etmean(ji,jj,jk) = tmask(ji,jj,jk)                     &
-                  &  / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   &
-                  &            + vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)  )
-                  
-                  eumean(ji,jj,jk) = umask(ji,jj,jk)                     &
-                  &  / MAX( 1.,  tmask(ji,jj,jk) + tmask(ji+1,jj  ,jk)  )
-
-                  evmean(ji,jj,jk) = vmask(ji,jj,jk)                     &
-                  &  / MAX( 1.,  tmask(ji,jj,jk) + tmask(ji  ,jj+1,jk)  )
-               END DO
-            END DO
-         END DO
-
-      CASE ( 1 )                ! horizontal average 
-         IF(lwp) WRITE(numout,*) '          horizontal average on avt, avmu, avmv'
-         ! weighting mean arrays etmean, eumean and evmean
-         !           ( 1/2  1  1/2 )              ( 1/2  1/2 )             ( 1/2  1  1/2 )
-         ! avt = 1/8 ( 1    2  1   )   avmu = 1/4 ( 1    1   )   avmv= 1/4 ( 1/2  1  1/2 )
-         !           ( 1/2  1  1/2 )              ( 1/2  1/2 )
-         etmean(:,:,:) = 0.e0
-         eumean(:,:,:) = 0.e0
-         evmean(:,:,:) = 0.e0
-         
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  etmean(ji,jj,jk) = tmask(ji, jj,jk)                           &
-                     & / MAX( 1., 2.* tmask(ji,jj,jk)                           &
-                     &      +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk)   &
-                     &             +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) &
-                     &      +1. * ( tmask(ji-1,jj  ,jk) + tmask(ji  ,jj+1,jk)   &
-                     &             +tmask(ji  ,jj-1,jk) + tmask(ji+1,jj  ,jk) ) )
-                  
-                  eumean(ji,jj,jk) = umask(ji,jj,jk)                        &
-                     &  / MAX( 1.,   tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk)   &
-                     &       +.5 * ( tmask(ji,jj-1,jk) + tmask(ji+1,jj-1,jk)   &
-                     &              +tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) )  )
-                  
-                  evmean(ji,jj,jk) = vmask(ji,jj,jk)                        &
-                     &  / MAX( 1.,   tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   &
-                     &       +.5 * ( tmask(ji-1,jj,jk) + tmask(ji-1,jj+1,jk)   &
-                     &              +tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk) )  )
-               END DO
-            END DO
-         END DO
-
-      CASE DEFAULT
-         WRITE(ctmp1,*) '          bad flag value for nn_ave = ', nn_ave
-         CALL ctl_stop( ctmp1 )
-
-      END SELECT
- 
-      ! Initialization of vertical eddy coef. to the background value
-      ! -------------------------------------------------------------
-      DO jk = 1, jpk
-         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
-         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
-         avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
-      END DO
-
-      ! zero the surface flux for non local term and kpp mixed layer depth
-      ! ------------------------------------------------------------------
-      ghats(:,:,:) = 0.
-      wt0  (:,:  ) = 0.
-      ws0  (:,:  ) = 0.
-      hkpp (:,:  ) = 0. ! just a diagnostic (not essential)
-
-#if ! defined key_kppcustom
-      ! compute arrays (del, wz) for reference mean values 
-      ! (increase speed for vectorization key_kppcustom not defined)
-      del(1:jpk, 1:jpk) = 0.
-      DO jk = 1, jpk
-         zref = epsilon * fsdept(1,1,jk)    
-         DO jm = 1 , jpk
-            zdist = zref - fsdepw(1,1,jm)   
-            IF( zdist > 0.  ) THEN
-               del(jk,jm) = MIN( zdist, fse3t(1,1,jm) ) / zref   
-            ELSE
-               del(jk,jm) = 0.
-            ENDIF
-         ENDDO
-      ENDDO
-#endif
-
-#if defined key_kpplktb
-      ! build lookup table for turbulent velocity scales
-      dezehat = ( dehatmax - dehatmin ) / nilktbm1
-      deustar = ( ustmax   - ustmin   ) / njlktbm1
- 
-      DO jj = 1, njlktb
-         zustar = ( jj - 1) * deustar + ustmin
-         zustvk = vonk * zustar 
-         zucube = zustar * zustar * zustar 
-         DO ji = 1 , nilktb
-            zehat = ( ji - 1 ) * dezehat + dehatmin
-            zeta   = zehat / ( zucube + epsln )
-            IF( zehat >= 0 ) THEN             ! Stable case
-               wmlktb(ji,jj) = zustvk / ABS( 1.0 + rconc1 * zeta + epsln )                        
-               wslktb(ji,jj) = wmlktb(ji,jj)
-            ELSE                                ! Unstable case 
-               IF( zeta > rzetam ) THEN
-                  wmlktb(ji,jj) = zustvk * ABS( 1.0    - rconc2 * zeta )**pfourth
-               ELSE
-                  wmlktb(ji,jj) = zustvk * ABS( rconam - rconcm * zeta )**pthird
-               ENDIF
-               
-               IF( zeta > rzetas ) THEN
-                  wslktb(ji,jj) = zustvk * SQRT( ABS( 1.0 - rconc2 * zeta ) )
-               ELSE
-                  wslktb(ji,jj) = zustvk * ABS( rconas - rconcs * zeta )**pthird
-               ENDIF
-            ENDIF
-         END DO
-      END DO
-#endif
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('zdf_kpp_init')
-      !
-   END SUBROUTINE zdf_kpp_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                                        NO KPP scheme
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfkpp = .FALSE.   !: KPP flag
-CONTAINS
-   SUBROUTINE zdf_kpp_init           ! Dummy routine
-      WRITE(*,*) 'zdf_kpp_init: You should not have seen this print! error?'
-   END SUBROUTINE zdf_kpp_init
-   SUBROUTINE zdf_kpp( kt )          ! Dummy routine
-      WRITE(*,*) 'zdf_kpp: You should not have seen this print! error?', kt
-   END SUBROUTINE zdf_kpp
-   SUBROUTINE tra_kpp( kt )          ! Dummy routine
-      WRITE(*,*) 'tra_kpp: You should not have seen this print! error?', kt
-   END SUBROUTINE tra_kpp
-   SUBROUTINE trc_kpp( kt )          ! Dummy routine
-      WRITE(*,*) 'trc_kpp: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_kpp
-#endif
-
-   !!======================================================================
-END MODULE zdfkpp
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 6808)
@@ -31,11 +31,9 @@
    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, SAVE, DIMENSION(:,:) ::   hmlpt   !: depth of the last T-point inside the mixed layer
 
    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
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
@@ -105,5 +103,5 @@
             DO ji = 1, jpi
                ikt = mbkt(ji,jj)
-               hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * fse3w(ji,jj,jk)
+               hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk)
                IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
             END DO
@@ -111,11 +109,10 @@
       END DO
       !
-      ! w-level of the turbocline
+      ! w-level of the turbocline and mixing layer (iom_use)
       imld(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point
       DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10 
          DO jj = 1, jpj
             DO ji = 1, jpi
-               imkt = mikt(ji,jj)
-               IF( avt (ji,jj,jk) < avt_c )   imld(ji,jj) = MAX( imkt, jk )      ! Turbocline 
+               IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline 
             END DO
          END DO
@@ -127,12 +124,18 @@
             iikn = nmln(ji,jj)
             imkt = mikt(ji,jj)
-            hmld (ji,jj) = ( fsdepw(ji,jj,iiki  ) - fsdepw(ji,jj,imkt )            )   * ssmask(ji,jj)    ! Turbocline depth 
-            hmlp (ji,jj) = ( fsdepw(ji,jj,iikn  ) - fsdepw(ji,jj,MAX( imkt,nla10 ) ) ) * ssmask(ji,jj)    ! Mixed layer depth
-            hmlpt(ji,jj) = ( fsdept(ji,jj,iikn-1) - fsdepw(ji,jj,imkt )            )   * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer
+            hmld (ji,jj) = gdepw_n(ji,jj,iiki  ) * ssmask(ji,jj)    ! Turbocline depth 
+            hmlp (ji,jj) = gdepw_n(ji,jj,iikn  ) * ssmask(ji,jj)    ! Mixed layer depth
+            hmlpt(ji,jj) = gdept_n(ji,jj,iikn-1) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer
          END DO
       END DO
       IF( .NOT.lk_offline ) THEN            ! no need to output in offline mode
-         CALL iom_put( "mldr10_1", hmlp )   ! mixed layer depth
-         CALL iom_put( "mldkz5"  , hmld )   ! turbocline depth
+         IF ( iom_use("mldr10_1") ) THEN
+            IF( .NOT. ln_isfcav ) CALL iom_put( "mldr10_1", hmlp )            ! mixed layer depth
+            IF(       ln_isfcav ) CALL iom_put( "mldr10_1", hmlp - risfdep)   ! mixed layer thickness
+         END IF
+         IF ( iom_use("mldkz5") ) THEN
+            IF( .NOT. ln_isfcav ) CALL iom_put( "mldkz5"  , hmld )             ! turbocline depth
+            IF(       ln_isfcav ) CALL iom_put( "mldkz5"  , hmld - risfdep )   ! turbocline thickness
+         END IF
       ENDIF
       
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 6808)
@@ -13,5 +13,5 @@
    !!            3.3.1! 2011-09  (P. Oddo) Mixed layer depth parameterization
    !!----------------------------------------------------------------------
-#if defined key_zdfric   ||   defined key_esopa
+#if defined key_zdfric
    !!----------------------------------------------------------------------
    !!   'key_zdfric'                                             Kz = f(Ri)
@@ -55,5 +55,5 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
@@ -133,6 +133,6 @@
          ! -----------------
          DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               zcoef = 0.5 / fse3w(ji,jj,jk)
+            DO ji = fs_2, fs_jpim1
+               zcoef = 0.5 / e3w_n(ji,jj,jk)
                !                                            ! shear of horizontal velocity
                zdku = zcoef * (  ub(ji-1,jj,jk-1) + ub(ji,jj,jk-1)   &
@@ -151,5 +151,5 @@
          z05alp = 0.5_wp * rn_alp
          DO jj = 1, jpjm1                                   ! Eddy viscosity coefficients (avm)
-            DO ji = 1, jpim1
+            DO ji = 1, fs_jpim1
                avmu(ji,jj,jk) = umask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji+1,jj)+zwx(ji,jj) ) )**nn_ric
                avmv(ji,jj,jk) = vmask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji,jj+1)+zwx(ji,jj) ) )**nn_ric
@@ -157,5 +157,5 @@
          END DO
          DO jj = 2, jpjm1                                   ! Eddy diffusivity coefficients (avt)
-            DO ji = 2, jpim1
+            DO ji = fs_2, fs_jpim1
                avt(ji,jj,jk) = tmric(ji,jj,jk) / ( 1._wp + rn_alp * zwx(ji,jj) )           &
                   &                            * (  avmu(ji,jj,jk) + avmu(ji-1,jj,jk)      &
@@ -176,6 +176,6 @@
       ! -------------------------------------------------------
       zflageos = ( 0.5 + SIGN( 0.5, nn_eos - 1. ) ) * rau0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
+      DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
             zrhos          = rhop(ji,jj,1) + zflageos * ( 1. - tmask(ji,jj,1) )
             zustar         = SQRT( taum(ji,jj) / ( zrhos +  rsmall ) )
@@ -189,6 +189,6 @@
       ! are always equal to the namelist values rn_wtmix/rn_wvmix
       ! -------------------------------------------------------
-      DO jj = 1, jpj
-         DO ji = 1, jpi
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
             avmv(ji,jj,1) = MAX( avmv(ji,jj,1), rn_wvmix )
             avmu(ji,jj,1) = MAX( avmu(ji,jj,1), rn_wvmix )
@@ -200,6 +200,6 @@
       ! -------------------------------------------------------
       DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
                IF( fsdept(ji,jj,jk) < ekm_dep(ji,jj) ) THEN
                   avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), rn_wvmix )
@@ -212,6 +212,6 @@
 
       DO jk = 1, jpkm1                
-         DO jj = 1, jpj
-            DO ji = 1, jpi
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
                avmv(ji,jj,jk) = avmv(ji,jj,jk) * vmask(ji,jj,jk)
                avmu(ji,jj,jk) = avmu(ji,jj,jk) * umask(ji,jj,jk)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 6808)
@@ -28,5 +28,5 @@
    !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability
    !!----------------------------------------------------------------------
-#if defined key_zdftke   ||   defined key_esopa
+#if defined key_zdftke
    !!----------------------------------------------------------------------
    !!   'key_zdftke'                                   TKE vertical physics
@@ -53,4 +53,8 @@
    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
@@ -85,9 +89,7 @@
    REAL(wp) ::   rhftau_scl = 1.0_wp       ! scale factor applied to HF part of taum  (nn_etau=3)
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en             !: now turbulent kinetic energy   [m2/s2]
    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau)
    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   apdlr          ! now mixing lenght of dissipation
 #if defined key_c1d
    !                                                                        !!** 1D cfg only  **   ('key_c1d')
@@ -97,8 +99,7 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -115,7 +116,6 @@
          &      e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) ,                          &
 #endif
-         &      en    (jpi,jpj,jpk) , htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     & 
-         &      avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk),                          &
-         &      avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), STAT= zdf_tke_alloc      )
+         &      htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     & 
+         &      apdlr(jpi,jpj,jpk) ,                                           STAT= zdf_tke_alloc      )
          !
       IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc )
@@ -173,4 +173,9 @@
       !!----------------------------------------------------------------------
       !
+#if defined key_agrif 
+      ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2)
+      IF( .NOT.Agrif_Root() )   CALL Agrif_Tke
+#endif
+      !
       IF( kt /= nit000 ) THEN   ! restore before value to compute tke
          avt (:,:,:) = avt_k (:,:,:) 
@@ -189,5 +194,10 @@
       avmv_k(:,:,:) = avmv(:,:,:) 
       !
-   END SUBROUTINE zdf_tke
+#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
 
 
@@ -221,14 +231,15 @@
       REAL(wp) ::   zzd_up, zzd_lw                  !    -         -
 !!bfr      REAL(wp) ::   zebot                           !    -         -
-      INTEGER , POINTER, DIMENSION(:,:  ) :: imlc
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zhlc
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw
+      INTEGER , POINTER, DIMENSION(:,:  ) ::   imlc
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhlc
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zpelc, zdiag, zd_up, zd_lw, z3du, z3dv
+      REAL(wp)                            ::   zri  !   local Richardson number
       !!--------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('tke_tke')
       !
-      CALL wrk_alloc( jpi,jpj, imlc )    ! integer
-      CALL wrk_alloc( jpi,jpj, zhlc ) 
-      CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 
+      CALL wrk_alloc( jpi,jpj,       imlc )    ! integer
+      CALL wrk_alloc( jpi,jpj,       zhlc ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 
       !
       zbbrau = rn_ebb / rau0       ! Local constant initialisation
@@ -244,5 +255,5 @@
          DO jj = 2, jpjm1            ! en(mikt(ji,jj))   = rn_emin
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               en(ji,jj,mikt(ji,jj))=rn_emin * tmask(ji,jj,1)
+               en(ji,jj,mikt(ji,jj)) = rn_emin * tmask(ji,jj,1)
             END DO
          END DO
@@ -265,7 +276,5 @@
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       !                     en(bot)   = (rn_ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin)
-!CDIR NOVERRCHK
 !!    DO jj = 2, jpjm1
-!CDIR NOVERRCHK
 !!       DO ji = fs_2, fs_jpim1   ! vector opt.
 !!          ztx2 = bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) + &
@@ -284,7 +293,7 @@
          !
          !                        !* total energy produce by LC : cumulative sum over jk
-         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * fsdepw(:,:,1) * fse3w(:,:,1)
+         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * gdepw_n(:,:,1) * e3w_n(:,:,1)
          DO jk = 2, jpk
-            zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * fsdepw(:,:,jk) * fse3w(:,:,jk)
+            zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw_n(:,:,jk) * e3w_n(:,:,jk)
          END DO
          !                        !* finite Langmuir Circulation depth
@@ -302,20 +311,17 @@
          DO jj = 1, jpj 
             DO ji = 1, jpi
-               zhlc(ji,jj) = fsdepw(ji,jj,imlc(ji,jj))
+               zhlc(ji,jj) = gdepw_n(ji,jj,imlc(ji,jj))
             END DO
          END DO
          zcof = 0.016 / SQRT( zrhoa * zcdrag )
-!CDIR NOVERRCHK
          DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en
-!CDIR NOVERRCHK
-            DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+            DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift
                   !                                           ! vertical velocity due to LC
-                  zind = 0.5 - SIGN( 0.5, fsdepw(ji,jj,jk) - zhlc(ji,jj) )
-                  zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) )
+                  zind = 0.5 - SIGN( 0.5, gdepw_n(ji,jj,jk) - zhlc(ji,jj) )
+                  zwlc = zind * rn_lc * zus * SIN( rpi * gdepw_n(ji,jj,jk) / zhlc(ji,jj) )
                   !                                           ! TKE Langmuir circulation source term
-                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1)
+                  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)
                END DO
             END DO
@@ -332,18 +338,37 @@
       !
       DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form)
-         DO jj = 1, jpj                 ! here avmu, avmv used as workspace
-            DO ji = 1, jpi
-               avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   &
-                  &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   & 
-                  &                            / (  fse3uw_n(ji,jj,jk)               &
-                  &                              *  fse3uw_b(ji,jj,jk)  )
-               avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )   &
-                  &                            * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )   &
-                  &                            / (  fse3vw_n(ji,jj,jk)               &
-                  &                              *  fse3vw_b(ji,jj,jk)  )
-            END DO
-         END DO
-      END DO
-      !
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               z3du(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji+1,jj,jk) )   &
+                  &                 * (  un(ji,jj,jk-1) -  un(ji  ,jj,jk) )   &
+                  &                 * (  ub(ji,jj,jk-1) -  ub(ji  ,jj,jk) ) * wumask(ji,jj,jk) &
+                  &                 / (  e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) )
+               z3dv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji,jj+1,jk) )   &
+                  &                 * (  vn(ji,jj,jk-1) -  vn(ji,jj  ,jk) )   &
+                  &                 * (  vb(ji,jj,jk-1) -  vb(ji,jj  ,jk) ) * wvmask(ji,jj,jk) &
+                  &                 / (  e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      !
+      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: compute apdlr
+         ! Note that zesh2 is also computed in the next loop.
+         ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !                                          ! shear prod. at w-point weightened by mask
+                  zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                     &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
+                  !                                          ! local Richardson number
+                  zri   = MAX( rn2b(ji,jj,jk), 0._wp ) * avm(ji,jj,jk) / ( zesh2 + rn_bshear )
+                  apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  )
+                  
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      !         
       DO jk = 2, jpkm1           !* Matrix and right hand side in en
          DO jj = 2, jpjm1
@@ -351,11 +376,11 @@
                zcof   = zfact1 * tmask(ji,jj,jk)
                zzd_up = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &  ! upper diagonal
-                  &          / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk  ) )
+                  &          / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk  ) )
                zzd_lw = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &  ! lower diagonal
-                  &          / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
-                  !                                                           ! shear prod. at w-point weightened by mask
-               zesh2  =  ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
-                  &    + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
-                  !
+                  &          / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  ) )
+               !                                   ! shear prod. at w-point weightened by mask
+               zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                  &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
+               !
                zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw)
                zd_lw(ji,jj,jk) = zzd_lw
@@ -377,7 +402,5 @@
          END DO
       END DO
-      !
-      ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
-      DO jj = 2, jpjm1
+      DO jj = 2, jpjm1                             ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
          DO ji = fs_2, fs_jpim1   ! vector opt.
             zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke
@@ -391,7 +414,5 @@
          END DO
       END DO
-      !
-      ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
-      DO jj = 2, jpjm1
+      DO jj = 2, jpjm1                             ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
          DO ji = fs_2, fs_jpim1   ! vector opt.
             en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1)
@@ -416,9 +437,12 @@
       !                            !  TKE due to surface and internal wave breaking
       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+!!gm BUG : in the exp  remove the depth of ssh !!!
+      
+      
       IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction)
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
+                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   &
                      &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
                END DO
@@ -429,14 +453,11 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                jk = nmln(ji,jj)
-               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
+               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   &
                   &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
             END DO
          END DO
       ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability)
-!CDIR NOVERRCHK
          DO jk = 2, jpkm1
-!CDIR NOVERRCHK
-            DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+            DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
@@ -445,5 +466,5 @@
                   zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean 
                   zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications...
-                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
+                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   &
                      &                        * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
                END DO
@@ -453,7 +474,7 @@
       CALL lbc_lnk( en, 'W', 1. )      ! Lateral boundary conditions (sign unchanged)
       !
-      CALL wrk_dealloc( jpi,jpj, imlc )    ! integer
-      CALL wrk_dealloc( jpi,jpj, zhlc ) 
-      CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 
+      CALL wrk_dealloc( jpi,jpj,       imlc )    ! integer
+      CALL wrk_dealloc( jpi,jpj,       zhlc ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,   zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tke_tke')
@@ -499,5 +520,5 @@
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   zrn2, zraug, zcoef, zav     ! local scalars
-      REAL(wp) ::   zdku, zpdlr, zri, zsqen     !   -      -
+      REAL(wp) ::   zdku, zri, zsqen            !   -      -
       REAL(wp) ::   zdkv, zemxl, zemlm, zemlp   !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zmpdl, zmxlm, zmxld
@@ -529,12 +550,9 @@
       ENDIF
       !
-!CDIR NOVERRCHK
       DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2)
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zrn2 = MAX( rn2(ji,jj,jk), rsmall )
-               zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) )
+               zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  )
             END DO
          END DO
@@ -543,19 +561,20 @@
       !                     !* Physical limits for the mixing length
       !
-      zmxld(:,:,1  ) = zmxlm(:,:,1)   ! surface set to the minimum value 
+      zmxld(:,:, 1 ) = zmxlm(:,:,1)   ! surface set to the minimum value 
       zmxld(:,:,jpk) = rmxl_min       ! last level  set to the minimum value
       !
       SELECT CASE ( nn_mxl )
       !
-      ! where wmask = 0 set zmxlm == fse3w
+ !!gm Not sure of that coding for ISF....
+      ! where wmask = 0 set zmxlm == e3w_n
       CASE ( 0 )           ! bounded by the distance to surface and bottom
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zemxl = MIN( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk),   &
-                  &            fsdepw(ji,jj,mbkt(ji,jj)+1) - fsdepw(ji,jj,jk) )
+                  zemxl = MIN( gdepw_n(ji,jj,jk) - gdepw_n(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk),   &
+                  &            gdepw_n(ji,jj,mbkt(ji,jj)+1) - gdepw_n(ji,jj,jk) )
                   ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj)
-                  zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),fse3w(ji,jj,jk)) * (1 - wmask(ji,jj,jk))
-                  zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),fse3w(ji,jj,jk)) * (1 - wmask(ji,jj,jk))
+                  zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),e3w_n(ji,jj,jk)) * (1 - wmask(ji,jj,jk))
+                  zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),e3w_n(ji,jj,jk)) * (1 - wmask(ji,jj,jk))
                END DO
             END DO
@@ -566,5 +585,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zemxl = MIN( fse3w(ji,jj,jk), zmxlm(ji,jj,jk) )
+                  zemxl = MIN( e3w_n(ji,jj,jk), zmxlm(ji,jj,jk) )
                   zmxlm(ji,jj,jk) = zemxl
                   zmxld(ji,jj,jk) = zemxl
@@ -577,5 +596,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + e3t_n(ji,jj,jk-1), zmxlm(ji,jj,jk) )
                END DO
             END DO
@@ -584,5 +603,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zemxl = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+                  zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t_n(ji,jj,jk+1), zmxlm(ji,jj,jk) )
                   zmxlm(ji,jj,jk) = zemxl
                   zmxld(ji,jj,jk) = zemxl
@@ -595,5 +614,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+                  zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + e3t_n(ji,jj,jk-1), zmxlm(ji,jj,jk) )
                END DO
             END DO
@@ -602,13 +621,10 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
-!CDIR NOVERRCHK
+                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + e3t_n(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
          DO jk = 2, jpkm1
-!CDIR NOVERRCHK
-            DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+            DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) )
@@ -630,9 +646,6 @@
       !                     !  Vertical eddy viscosity and diffusivity  (avmu, avmv, avt)
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-!CDIR NOVERRCHK
       DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zsqen = SQRT( en(ji,jj,jk) )
@@ -660,19 +673,10 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zcoef = avm(ji,jj,jk) * 2._wp * fse3w(ji,jj,jk) * fse3w(ji,jj,jk)
-                  !                                          ! shear
-                  zdku = avmu(ji-1,jj,jk) * ( un(ji-1,jj,jk-1) - un(ji-1,jj,jk) ) * ( ub(ji-1,jj,jk-1) - ub(ji-1,jj,jk) )   &
-                    &  + avmu(ji  ,jj,jk) * ( un(ji  ,jj,jk-1) - un(ji  ,jj,jk) ) * ( ub(ji  ,jj,jk-1) - ub(ji  ,jj,jk) )
-                  zdkv = avmv(ji,jj-1,jk) * ( vn(ji,jj-1,jk-1) - vn(ji,jj-1,jk) ) * ( vb(ji,jj-1,jk-1) - vb(ji,jj-1,jk) )   &
-                    &  + avmv(ji,jj  ,jk) * ( vn(ji,jj  ,jk-1) - vn(ji,jj  ,jk) ) * ( vb(ji,jj  ,jk-1) - vb(ji,jj  ,jk) )
-                  !                                          ! local Richardson number
-                  zri   = MAX( rn2b(ji,jj,jk), 0._wp ) * zcoef / (zdku + zdkv + rn_bshear )
-                  zpdlr = MAX(  0.1_wp,  0.2 / MAX( 0.2 , zri )  )
-!!gm and even better with the use of the "true" ri_crit=0.22222...  (this change the results!)
-!!gm              zpdlr = MAX(  0.1_wp,  ri_crit / MAX( ri_crit , zri )  )
-                  avt(ji,jj,jk)   = MAX( zpdlr * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
+                  avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
 # if defined key_c1d
-                  e_pdl(ji,jj,jk) = zpdlr * wmask(ji,jj,jk)  ! c1d configuration : save masked Prandlt number
-                  e_ric(ji,jj,jk) = zri   * wmask(ji,jj,jk)  ! c1d config. : save Ri
+                  e_pdl(ji,jj,jk) = apdlr(ji,jj,jk) * wmask(ji,jj,jk)    ! c1d configuration : save masked Prandlt number
+!!gm bug NO zri here....
+!!gm remove the specific diag for c1d !
+                  e_ric(ji,jj,jk) = zri * wmask(ji,jj,jk)                            ! c1d config. : save Ri
 # endif
               END DO
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 6808)
@@ -8,5 +8,5 @@
    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
-#if defined key_zdftmx   ||   defined key_esopa
+#if defined key_zdftmx
    !!----------------------------------------------------------------------
    !!   'key_zdftmx'                                  Tidal vertical mixing
@@ -51,8 +51,7 @@
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -105,17 +104,17 @@
       !!              Koch-Larrouy et al. 2007, GRL.
       !!----------------------------------------------------------------------
-      USE oce, zav_tide  =>   ua    ! use ua as workspace
-      !!
       INTEGER, INTENT(in) ::   kt   ! ocean time-step 
-      !!
+      !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   ztpc         ! scalar workspace
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zkz
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zkz
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zav_tide
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('zdf_tmx')
       !
-      CALL wrk_alloc( jpi,jpj, zkz )
-
+      CALL wrk_alloc( jpi,jpj,       zkz )
+      CALL wrk_alloc( jpi,jpj,jpk,   zav_tide )
+      !
       !                          ! ----------------------- !
       !                          !  Standard tidal mixing  !  (compute zav_tide)
@@ -126,5 +125,5 @@
       zkz(:,:) = 0.e0               !* Associated potential energy consummed over the whole water column
       DO jk = 2, jpkm1
-         zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk)
+         zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk)
       END DO
 
@@ -136,22 +135,19 @@
 
       DO jk = 2, jpkm1     !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s
-         DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
-            DO ji = 1, jpi
-               zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk)  !kz max = 300 cm2/s
-            END DO
-         END DO
+         zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s
       END DO
 
       IF( kt == nit000 ) THEN       !* check at first time-step: diagnose the energy consumed by zav_tide
-         ztpc = 0.e0
+         ztpc = 0._wp
          DO jk= 1, jpk
             DO jj= 1, jpj
                DO ji= 1, jpi
-                  ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj)   &
-                     &         * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj)                  &
+                     &        * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
                END DO
             END DO
          END DO
          ztpc= rau0 / ( rn_tfe * rn_me ) * ztpc
+         IF( lk_mpp )   CALL mpp_sum( ztpc )
          IF(lwp) WRITE(numout,*) 
          IF(lwp) WRITE(numout,*) '          N Total power consumption by av_tide    : ztpc = ', ztpc * 1.e-12 ,'TW'
@@ -167,13 +163,6 @@
       !                          ! ----------------------- !
       DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing
-         DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
-            DO ji = 1, jpi
-               avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk)
-               avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      
-      DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing
+         avt(:,:,jk) = avt(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk)
+         avm(:,:,jk) = avm(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1  ! vector opt.
@@ -190,5 +179,6 @@
       IF(ln_ctl)   CALL prt_ctl(tab3d_1=zav_tide , clinfo1=' tmx - av_tide: ', tab3d_2=avt, clinfo2=' avt: ', ovlap=1, kdim=jpk)
       !
-      CALL wrk_dealloc( jpi,jpj, zkz )
+      CALL wrk_dealloc( jpi,jpj,       zkz )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zav_tide )
       !
       IF( nn_timing == 1 )  CALL timing_stop('zdf_tmx')
@@ -239,5 +229,4 @@
       DO jk = 1, jpkm1             
          zdn2dz     (:,:,jk) = rn2(:,:,jk) - rn2(:,:,jk+1)           ! Vertical profile of dN2/dz
-!CDIR NOVERRCHK
          zempba_3d_1(:,:,jk) = SQRT(  MAX( 0.e0, rn2(:,:,jk) )  )    !    -        -    of N
          zempba_3d_2(:,:,jk) =        MAX( 0.e0, rn2(:,:,jk) )       !    -        -    of N^2
@@ -248,6 +237,6 @@
       zsum2(:,:) = 0.e0
       DO jk= 2, jpk
-         zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * fse3w(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1)
-         zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * fse3w(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1)               
+         zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk)
+         zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk)               
       END DO
       DO jj = 1, jpj
@@ -266,5 +255,5 @@
                !
                zempba_3d(ji,jj,jk) =               ztpc 
-               zsum     (ji,jj)    = zsum(ji,jj) + ztpc * fse3w(ji,jj,jk)
+               zsum     (ji,jj)    = zsum(ji,jj) + ztpc * e3w_n(ji,jj,jk)
             END DO
          END DO
@@ -285,5 +274,5 @@
       zkz(:,:) = 0.e0               ! Associated potential energy consummed over the whole water column
       DO jk = 2, jpkm1
-         zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1)
+         zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk)
       END DO
 
@@ -295,5 +284,5 @@
 
       DO jk = 2, jpkm1              ! Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zavt_itf bound by 300 cm2/s
-         zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * tmask(:,:,jk) * tmask(:,:,jk-1)   ! kz max = 120 cm2/s
+         zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * wmask(:,:,jk)   ! kz max = 120 cm2/s
       END DO
 
@@ -303,9 +292,10 @@
             DO jj= 1, jpj
                DO ji= 1, jpi
-                  ztpc = ztpc + e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) )   &
-                     &                     * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  ztpc = ztpc + e1e2t(ji,jj) * e3w_n(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) )   &
+                     &                       * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
                END DO
             END DO
          END DO
+         IF( lk_mpp )   CALL mpp_sum( ztpc )
          ztpc= rau0 * ztpc / ( rn_me * rn_tfe_itf )
          IF(lwp) WRITE(numout,*) '          N Total power consumption by zavt_itf: ztpc = ', ztpc * 1.e-12 ,'TW'
@@ -361,15 +351,13 @@
       !!              Koch-Larrouy et al. 2007, GRL.
       !!----------------------------------------------------------------------
-      USE oce     ,         zav_tide =>  ua         ! ua used as workspace
-      !!
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       INTEGER  ::   inum         ! local integer
       INTEGER  ::   ios
       REAL(wp) ::   ztpc, ze_z   ! local scalars
-      REAL(wp), DIMENSION(:,:)  , POINTER ::  zem2, zek1   ! read M2 and K1 tidal energy
-      REAL(wp), DIMENSION(:,:)  , POINTER ::  zkz          ! total M2, K1 and S2 tidal energy
-      REAL(wp), DIMENSION(:,:)  , POINTER ::  zfact        ! used for vertical structure function
-      REAL(wp), DIMENSION(:,:)  , POINTER ::  zhdep        ! Ocean depth 
-      REAL(wp), DIMENSION(:,:,:), POINTER ::  zpc      ! power consumption
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zem2, zek1     ! read M2 and K1 tidal energy
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zkz            ! total M2, K1 and S2 tidal energy
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zfact          ! used for vertical structure function
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zhdep          ! Ocean depth 
+      REAL(wp), DIMENSION(:,:,:), POINTER ::  zpc, zav_tide  ! power consumption
       !!
       NAMELIST/namzdf_tmx/ rn_htmx, rn_n2min, rn_tfe, rn_me, ln_tmx_itf, rn_tfe_itf
@@ -378,17 +366,17 @@
       IF( nn_timing == 1 )  CALL timing_start('zdf_tmx_init')
       !
-      CALL wrk_alloc( jpi,jpj, zem2, zek1, zkz, zfact, zhdep )
-      CALL wrk_alloc( jpi,jpj,jpk, zpc )
-      
-      REWIND( numnam_ref )              ! Namelist namzdf_tmx in reference namelist : Tidal Mixing
+      CALL wrk_alloc( jpi,jpj,       zem2, zek1, zkz, zfact, zhdep )
+      CALL wrk_alloc( jpi,jpj,jpk,   zpc, zav_tide )
+      !
+      REWIND( numnam_ref )             ! Namelist namzdf_tmx in reference namelist : Tidal Mixing
       READ  ( numnam_ref, namzdf_tmx, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namzdf_tmx in configuration namelist : Tidal Mixing
+      !
+      REWIND( numnam_cfg )             ! Namelist namzdf_tmx in configuration namelist : Tidal Mixing
       READ  ( numnam_cfg, namzdf_tmx, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namzdf_tmx )
-
-      IF(lwp) THEN                   ! Control print
+      !
+      IF(lwp) THEN                     ! Control print
          WRITE(numout,*)
          WRITE(numout,*) 'zdf_tmx_init : tidal mixing'
@@ -402,33 +390,31 @@
          WRITE(numout,*) '      ITF tidal dissipation efficiency      = ', rn_tfe_itf
       ENDIF
-
-      !                              ! allocate tmx arrays
+      !                                ! allocate tmx arrays
       IF( zdf_tmx_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_tmx_init : unable to allocate tmx arrays' )
 
-      IF( ln_tmx_itf ) THEN          ! read the Indonesian Through Flow mask
+      IF( ln_tmx_itf ) THEN            ! read the Indonesian Through Flow mask
          CALL iom_open('mask_itf',inum)
          CALL iom_get (inum, jpdom_data, 'tmaskitf',mask_itf,1) ! 
          CALL iom_close(inum)
       ENDIF
-
-      ! read M2 tidal energy flux : W/m2  ( zem2 < 0 )
+      !                                ! read M2 tidal energy flux : W/m2  ( zem2 < 0 )
       CALL iom_open('M2rowdrg',inum)
       CALL iom_get (inum, jpdom_data, 'field',zem2,1) ! 
       CALL iom_close(inum)
-
-      ! read K1 tidal energy flux : W/m2  ( zek1 < 0 )
+      !                                ! read K1 tidal energy flux : W/m2  ( zek1 < 0 )
       CALL iom_open('K1rowdrg',inum)
       CALL iom_get (inum, jpdom_data, 'field',zek1,1) ! 
       CALL iom_close(inum)
- 
-      ! Total tidal energy ( M2, S2 and K1  with S2=(1/2)^2 * M2 )
-      ! only the energy available for mixing is taken into account,
-      ! (mixing efficiency tidal dissipation efficiency)
+      !                                ! Total tidal energy ( M2, S2 and K1  with S2=(1/2)^2 * M2 )
+      !                                ! only the energy available for mixing is taken into account,
+      !                                ! (mixing efficiency tidal dissipation efficiency)
       en_tmx(:,:) = - rn_tfe * rn_me * ( zem2(:,:) * 1.25 + zek1(:,:) ) * ssmask(:,:)
 
 !============
 !TG: Bug for VVL? Should this section be moved out of _init and be updated at every timestep?
-      ! Vertical structure (az_tmx)
-      DO jj = 1, jpj                ! part independent of the level
+!!gm : you are right, but tidal mixing acts in deep ocean (H>500m) where e3 is O(100m)
+!!     the error is thus ~1% which I feel comfortable with, compared to uncertainties in tidal energy dissipation.
+      !                                ! Vertical structure (az_tmx)
+      DO jj = 1, jpj                         ! part independent of the level
          DO ji = 1, jpi
             zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean
@@ -437,5 +423,5 @@
          END DO
       END DO
-      DO jk= 1, jpk                 ! complete with the level-dependent part
+      DO jk= 1, jpk                          ! complete with the level-dependent part
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -445,5 +431,5 @@
       END DO
 !===========
-
+      !
       IF( nprint == 1 .AND. lwp ) THEN
          ! Control print
@@ -454,29 +440,25 @@
             zav_tide(:,:,jk) = az_tmx(:,:,jk) / MAX( rn_n2min, rn2(:,:,jk) )
          END DO
-
-         ztpc = 0.e0
+         !
+         ztpc = 0._wp
          zpc(:,:,:) = MAX(rn_n2min,rn2(:,:,:)) * zav_tide(:,:,:)
          DO jk= 2, jpkm1
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
+                  ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
                END DO
             END DO
          END DO
+         IF( lk_mpp )   CALL mpp_sum( ztpc )
          ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc
-
+         !
          WRITE(numout,*) 
          WRITE(numout,*) '          Total power consumption of the tidally driven part of Kz : ztpc = ', ztpc * 1.e-12 ,'TW'
-
-
+         !
          ! control print 2
          zav_tide(:,:,:) = MIN( zav_tide(:,:,:), 60.e-4 )   
-         zkz(:,:) = 0.e0
+         zkz(:,:) = 0._wp
          DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk) * MAX(0.e0, rn2(ji,jj,jk)) * rau0 * zav_tide(ji,jj,jk) * wmask(ji,jj,jk)
-               END DO
-            END DO
+               zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk)
          END DO
          ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz
@@ -497,31 +479,28 @@
          END DO
          WRITE(numout,*) '          Min de zkz ', ztpc, ' Max = ', maxval(zkz(:,:) )
-
+         !
          DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk)  !kz max = 300 cm2/s
-               END DO
-            END DO
-         END DO
-         ztpc = 0.e0
+            zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s
+         END DO
+         ztpc = 0._wp
          zpc(:,:,:) = Max(0.e0,rn2(:,:,:)) * zav_tide(:,:,:)
          DO jk= 1, jpk
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
+                  ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
                END DO
             END DO
          END DO
+         IF( lk_mpp )   CALL mpp_sum( ztpc )
          ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc
          WRITE(numout,*) '          2 Total power consumption of the tidally driven part of Kz : ztpc = ', ztpc * 1.e-12 ,'TW'
-
+!!gm bug mpp  in these diagnostics
          DO jk = 1, jpk
-            ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zav_tide(:,:,jk)     * tmask_i(:,:) )   &
-               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) )
-            ztpc = 1.E50
+            ze_z =                  SUM( e1e2t(:,:) * zav_tide(:,:,jk) * tmask_i(:,:) )   &
+               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask   (:,:,jk) * tmask_i(:,:) ) )
+            ztpc = 1.e50
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  IF( zav_tide(ji,jj,jk) /= 0.e0 )   ztpc =Min( ztpc, zav_tide(ji,jj,jk) )
+                  IF( zav_tide(ji,jj,jk) /= 0.e0 )   ztpc = MIN( ztpc, zav_tide(ji,jj,jk) )
                END DO
             END DO
@@ -530,5 +509,5 @@
          END DO
 
-         WRITE(numout,*) '          e_tide : ', SUM( e1t*e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW'
+         WRITE(numout,*) '          e_tide : ', SUM( e1e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW'
          WRITE(numout,*) 
          WRITE(numout,*) '          Initial profile of tidal vertical mixing'
@@ -539,16 +518,17 @@
                END DO
             END DO
-            ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zkz(:,:)     * tmask_i(:,:) )   &
-               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) )
+            ze_z =                  SUM( e1e2t(:,:) * zkz  (:,:)    * tmask_i(:,:) )   &
+               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) )
             WRITE(numout,*) '                jk= ', jk,'   ', ze_z * 1.e4,' cm2/s'
          END DO
          DO jk = 1, jpk
             zkz(:,:) = az_tmx(:,:,jk) /rn_n2min
-            ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zkz(:,:)     * tmask_i(:,:) )   &
-               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) )
+            ze_z =                  SUM( e1e2t(:,:) * zkz  (:,:)    * tmask_i(:,:) )   &
+               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) )
             WRITE(numout,*) 
             WRITE(numout,*) '          N2 min - jk= ', jk,'   ', ze_z * 1.e4,' cm2/s min= ',MINVAL(zkz)*1.e4,   &
                &       'max= ', MAXVAL(zkz)*1.e4, ' cm2/s'
          END DO
+!!gm  end bug mpp
          !
       ENDIF
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90	(revision 6808)
@@ -24,6 +24,7 @@
    PRIVATE
 
-   PUBLIC   glob_sum   ! used in many places
-   PUBLIC   DDPDD      ! also used in closea module
+   PUBLIC   glob_sum      ! used in many places (masked with tmask_i)
+   PUBLIC   glob_sum_full ! used in many places (masked with tmask_h, ie omly over the halos)
+   PUBLIC   DDPDD         ! also used in closea module
    PUBLIC   glob_min, glob_max
 #if defined key_nosignedzero
@@ -34,4 +35,7 @@
       MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d, &
          &             glob_sum_2d_a, glob_sum_3d_a
+   END INTERFACE
+   INTERFACE glob_sum_full
+      MODULE PROCEDURE glob_sum_full_2d, glob_sum_full_3d
    END INTERFACE
    INTERFACE glob_min
@@ -156,4 +160,44 @@
       !
    END FUNCTION glob_sum_3d_a
+
+   FUNCTION glob_sum_full_2d( ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_full_2d ***
+      !!
+      !! ** Purpose : perform a sum in calling DDPDD routine (nomask)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab
+      REAL(wp)                             ::   glob_sum_full_2d   ! global sum
+      !!
+      !!-----------------------------------------------------------------------
+      !
+      glob_sum_full_2d = SUM( ptab(:,:) * tmask_h(:,:) )
+      IF( lk_mpp )   CALL mpp_sum( glob_sum_full_2d )
+      !
+   END FUNCTION glob_sum_full_2d
+
+   FUNCTION glob_sum_full_3d( ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_full_3d ***
+      !!
+      !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine (nomask)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab
+      REAL(wp)                               ::   glob_sum_full_3d   ! global sum
+      !!
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      INTEGER    ::   ijpk ! local variables: size of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab,3)
+      !
+      glob_sum_full_3d = 0.e0
+      DO jk = 1, ijpk
+         glob_sum_full_3d = glob_sum_full_3d + SUM( ptab(:,:,jk) * tmask_h(:,:) )
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( glob_sum_full_3d )
+      !
+   END FUNCTION glob_sum_full_3d
+
 
 #else  
@@ -314,4 +358,65 @@
    END FUNCTION glob_sum_3d_a   
 
+   FUNCTION glob_sum_full_2d( ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_full_2d ***
+      !!
+      !! ** Purpose : perform a sum in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab
+      REAL(wp)                             ::   glob_sum_full_2d   ! global sum (nomask)
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      DO jj = 1, jpj
+         DO ji =1, jpi
+         ztmp =  ptab(ji,jj) * tmask_h(ji,jj) 
+         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum_full_2d = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_full_2d
+
+   FUNCTION glob_sum_full_3d( ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_full_3d ***
+      !!
+      !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab
+      REAL(wp)                               ::   glob_sum_full_3d   ! global sum (nomask)
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      INTEGER    ::   ijpk ! local variables: size of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab,3)
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      DO jk = 1, ijpk
+         DO jj = 1, jpj
+            DO ji =1, jpi
+            ztmp =  ptab(ji,jj,jk) * tmask_h(ji,jj)
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            END DO
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum_full_3d = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_full_3d
+
+
+
 #endif
 
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/lib_print.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/lib_print.f90	(revision 6807)
+++ 	(revision )
@@ -1,262 +1,0 @@
-MODULE lib_print
-   !!======================================================================
-   !!                    ***  MODULE  lib_print  ***
-   !! print librairy :  formated real and integer array print
-   !!=====================================================================
-      
-   !!----------------------------------------------------------------------
-   !!   prihin       : print an integer 2D horizontal field
-   !!   prihre       : print an real 2D horizontal field
-   !!   prizre       : print an real 2D vertical field
-   !!----------------------------------------------------------------------
-   USE par_kind      ! kind parameters
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   prihin, prihre, prizre
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE prihin( ktab, ki   , kj   , kideb, kifin ,   &
-                      kind, kjdeb, kjfin, kjnd , kscale, kumout )
-      !!----------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  prihre  ***
-      !!  
-      !! ** purpose :   Print an integer field
-      !!
-      !! ** method :   format of print is selected with the dummy argument kscale
-      !!
-      !! History :
-      !!        !  90-04 (0. Marti)  Original code
-      !!        !  92-02 (M. Imbard)
-      !!        !  03-07 (G. Madec)  F90, free form
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   &
-         ki, kj,                 &  ! array dimensions
-         kideb, kifin, kind,     &  ! first and last index, increment for i 
-         kjdeb, kjfin, kjnd,     &  ! first and last index, increment for j
-         kscale,                 &  ! kscale=0 or > 5  print ktab with format i8
-      !                             !         kscale=1 print ktab with format i1
-      !                             !         kscale=2 print ktab with format i2
-      !                             !         kscale=3 print ktab with format i3
-      !                             !         kscale=4 print ktab with format i4
-      !                             !         kscale=5 print ktab with format i5
-         kumout                     ! unit in which print
-      INTEGER, DIMENSION(ki,kj), INTENT( in ) ::   &
-         ktab                       ! integer 2D array to be print
-
-      !! * local declarations
-      INTEGER ::   ji, jj, jn       ! dummy loop indices
-      INTEGER ::   isca, il1, il2   ! temporary integers
-      INTEGER ::   iind, ijnd       ! temporary integers
-
-      isca = 10
-      IF( kscale == 0 )   isca = 10
-      IF( kscale == 1 )   isca = 100
-      IF( kscale == 2 )   isca = 60
-      IF( kscale == 3 )   isca = 40
-      IF( kscale == 4 )   isca = 30
-      IF( kscale == 5 )   isca = 20
-
-      iind = MAX( 1, kind )
-      ijnd = MAX( 1, kjnd )
-
-      il1 = kideb
-
-      DO jn = 1, (kifin-kideb+1)/(iind*isca) + 1
-
-        IF( il1 > kifin ) RETURN
-        WRITE(kumout,'(/)')
-        il2 = il1+iind*(isca-1)
-        IF( il2 > kifin )   il2 = kifin
-
-        IF( kscale == 1 ) THEN
-            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)') il1, il2, iind
-            DO jj = kjfin, kjdeb, -ijnd
-              WRITE (kumout,'(1x,i3,100i1)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
-            END DO  
-        ELSEIF( kscale == 2 ) THEN
-            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)')il1, il2, iind
-            DO jj = kjfin, kjdeb, -ijnd
-              WRITE (kumout,'(1x,i3,60i2)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
-            END DO  
-        ELSEIF( kscale == 3 ) THEN
-            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)')il1, il2, iind
-            DO jj = kjfin, kjdeb, -ijnd
-              WRITE (kumout,'(1x,i3,40i3)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
-            END DO  
-        ELSEIF( kscale == 4 ) THEN
-            WRITE(kumout,'(4x,30i4,/)') ( ji, ji = il1, il2, iind )
-            DO jj = kjfin, kjdeb, -ijnd
-              WRITE (kumout,'(1x,i3,30i4)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
-            END DO  
-        ELSEIF( kscale == 5 ) THEN
-            WRITE(kumout,'(4x,20i5,/)') ( ji, ji = il1, il2, iind )
-            DO jj = kjfin, kjdeb, -ijnd
-              WRITE (kumout,'(1x,i3,20i5)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
-            END DO  
-        ELSE
-            WRITE(kumout,'(4x,10i8,/)') ( ji, ji = il1, il2, iind )
-            DO jj = kjfin, kjdeb, -ijnd
-              WRITE (kumout,'(1x,i3,10i8)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
-            END DO  
-        ENDIF
-
-        il1 = il1 + iind * isca
-      END DO  
-
-   END SUBROUTINE prihin
-
-
-   SUBROUTINE prihre( ptab, ki   , kj   , kideb, kifin ,   &
-                      kind, kjdeb, kjfin, kjnd , pscale, kumout )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE prihre  ***
-      !!      
-      !! ** purpose :   Print a real field with the format 10e12.4 or 20f6.2
-      !!
-      !! ** method  :   the print format is selected with the pscale argument
-      !!
-      !! History :
-      !!   1.0  !  86-01  (P. Andrich)  Original code
-      !!        !  89-11  (C. Levy)
-      !!        !  92-02  (M. Imbard)
-      !!        !  92-06  (M. Imbard)
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   &
-         ki, kj,                 &  ! array dimensions
-         kideb, kifin, kind,     &  ! first and last index, increment for i
-         kjdeb, kjfin, kjnd,     &  ! first and last index, increment for j
-         kumout                     ! unit in which print
-      REAL(wp), INTENT( in ) ::   &
-         pscale                     ! = 0  print        ptab with e13.5 format
-         !                          ! else print pscale*ptab with f6.2 format
-      REAL(wp), DIMENSION(ki,kj), INTENT( in ) ::   &
-         ptab                       ! integer 2D array to be print
-
-      !! * Local variables
-      INTEGER ::   ji, jj, jn       ! dummy loop indices
-      INTEGER ::   isca, il1, il2   ! temporary integers
-
-      isca = 10
-      IF( pscale /= 0. )   isca=20
-
-      il1 = kideb
-
-      DO jn = 1, (kifin-kideb+1)/(kind*isca) + 1
-
-        IF( il1 > kifin )   RETURN
-
-        WRITE(kumout,9100)
-
-        il2 = il1+kind*(isca-1)
-        IF(il2 > kifin) il2 = kifin
-        IF( pscale == 0.) THEN
-            WRITE(kumout,9101) ( ji, ji = il1, il2, kind )
-            DO jj = kjfin, kjdeb, -kjnd
-              WRITE(kumout,9102) jj, ( ptab(ji,jj), ji = il1, il2, kind )
-            END DO  
-        ELSE
-            WRITE(kumout,9103) ( ji, ji = il1, il2, kind )
-            DO jj = kjfin, kjdeb, -kjnd
-              WRITE(kumout,9104) jj, ( pscale*ptab(ji,jj), ji = il1, il2, kind )
-            END DO  
-        ENDIF
-        il1 = il1+kind*isca
-
-      END DO  
-
-      ! formats
- 9100 FORMAT(/)
- 9101 FORMAT(10i12, /)
- 9102 FORMAT(1x, i3, 10(1pe12.4))
- 9103 FORMAT(3x, 20i6, /)
- 9104 FORMAT(1x, i3, 1x, 20f6.2)
-
-   END SUBROUTINE prihre
-
-
-   SUBROUTINE prizre( ptab , ki   , kj   , kk   , kjcut ,   &
-                      kideb, kifin, kid  , kkdeb, kkfin ,   &
-                      kkd  , pscale, kumout )
-      !!----------------------------------------------------------------------
-      !!                      ***  ROUTINE prizre  ***
-      !!
-      !! ** purpose :   Print a vertical slab from a tridimentional real field
-      !!
-      !!   METHOD :
-      !! ** method  :   the print format is selected with the argument pscale
-      !!
-      !! History :
-      !!      original : 86-01 (o. Marti)
-      !!      addition : 92-02 (M. Imbard)
-      !!      addition : 92-06 (M. Imbard)
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   &
-         ki, kj, kk,             &  ! array dimensions
-         kjcut,                  &  ! index j for the vertical slab
-         kideb, kifin, kid,      &  ! first and last index, increment for i
-         kkdeb, kkfin, kkd,      &  ! first and last index, increment for k
-         kumout                     ! unit in which print
-      REAL(wp), INTENT( in ) ::   &
-         pscale                     ! = 0  print        ptab with e12.4 format
-         !                          ! else print pscale*ptab with f6.2 format
-      REAL(wp), DIMENSION(ki,kj,kk), INTENT( in ) ::   &
-         ptab                       ! integer 3D array to be print
-
-      !! * Local variables
-      INTEGER ::   ji, jn, jk       ! dummy loop indices
-      INTEGER ::   isca, il1, il2   ! temporary integers
-      INTEGER ::   iind, iknd       !    "          "
-
-
-      iind = kid
-      iknd = kkd
-      isca = 10
-      IF( pscale /= 0.) isca = 20
-
-      IF (iind == 0) iind = 1
-      IF (iknd == 0) iknd = 1
-
-      il1 = kideb
-
-      DO jn = 1, (kifin-kideb+1)/(iind*isca) + 1
-
-        IF(il1 > kifin) RETURN
-        WRITE(kumout,9100)
-        il2 = il1+iind*(isca-1)
-        IF(il2 > kifin) il2 = kifin
-
-        IF( pscale == 0.) THEN
-            WRITE(kumout,9101) ( ji, ji = il1, il2, iind )
-            DO jk = kkdeb, kkfin, iknd
-              WRITE (kumout,9102) jk, ( ptab(ji,kjcut,jk), ji = il1, il2, iind )
-            END DO  
-        ELSE
-            WRITE (kumout,9103) ( ji, ji = il1, il2, iind )
-            DO jk = kkdeb, kkfin, iknd
-              WRITE(kumout,9104)jk, ( pscale*ptab(ji,kjcut,jk), ji = il1, il2, iind )
-            END DO  
-        ENDIF
-
-        il1 = il1+iind*isca
-      END DO      
-
- 9100 FORMAT(/)
- 9101 FORMAT(10i12, /)
- 9102 FORMAT(1x, i3, 10(1pe12.4))
- 9103 FORMAT(3x, 20i6, /)
- 9104 FORMAT(1x, i3, 1x, 20f6.1)
-
-      END SUBROUTINE prizre
-
-   !!======================================================================
-END MODULE lib_print
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 6808)
@@ -28,61 +28,69 @@
    !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
-   !!            3.4  ! 2011-11  (C. Harris) decomposition changes for running with CICE
-   !!                 ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
+   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms
+   !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE
+   !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
+   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 
+   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla)
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   nemo_gcm       : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
-   !!   nemo_init      : initialization of the NEMO system
-   !!   nemo_ctl       : initialisation of the contol print
-   !!   nemo_closefile : close remaining open files
-   !!   nemo_alloc     : dynamical allocation
-   !!   nemo_partition : calculate MPP domain decomposition
-   !!   factorise      : calculate the factors of the no. of MPI processes
+   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
+   !!   nemo_init     : initialization of the NEMO system
+   !!   nemo_ctl      : initialisation of the contol print
+   !!   nemo_closefile: close remaining open files
+   !!   nemo_alloc    : dynamical allocation
+   !!   nemo_partition: calculate MPP domain decomposition
+   !!   factorise     : calculate the factors of the no. of MPI processes
    !!----------------------------------------------------------------------
-   USE step_oce        ! module used in the ocean time stepping module
-   USE cla             ! cross land advection               (tra_cla routine)
-   USE domcfg          ! domain configuration               (dom_cfg routine)
-   USE mppini          ! shared/distributed memory setting (mpp_init routine)
-   USE domain          ! domain initialization             (dom_init routine)
+   USE step_oce       ! module used in the ocean time stepping module (step.F90)
+   USE domcfg         ! domain configuration               (dom_cfg routine)
+   USE mppini         ! shared/distributed memory setting (mpp_init routine)
+   USE domain         ! domain initialization             (dom_init routine)
 #if defined key_nemocice_decomp
    USE ice_domain_size, only: nx_global, ny_global
 #endif
-   USE tideini         ! tidal components initialization   (tide_ini routine)
-   USE bdyini          ! open boundary cond. setting       (bdy_init routine)
-   USE bdydta          ! open boundary cond. setting   (bdy_dta_init routine)
-   USE bdytides        ! open boundary cond. setting   (bdytide_init routine)
-   USE istate          ! initial state setting          (istate_init routine)
-   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine)
-   USE ldftra          ! lateral diffusivity setting    (ldftra_init routine)
-   USE zdfini          ! vertical physics setting          (zdf_init routine)
-   USE phycst          ! physical constant                  (par_cst routine)
-   USE trdini          ! dyn/tra trends initialization     (trd_init routine)
-   USE asminc          ! assimilation increments     
-   USE asmbkg          ! writing out state trajectory
-   USE diaptr          ! poleward transports           (dia_ptr_init routine)
-   USE diadct          ! sections transports           (dia_dct_init routine)
-   USE diaobs          ! Observation diagnostics       (dia_obs_init routine)
-   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
-   USE step            ! NEMO time-stepping                 (stp     routine)
-   USE icbini          ! handle bergs, initialisation
-   USE icbstp          ! handle bergs, calving, themodynamics and transport
-   USE cpl_oasis3      ! OASIS3 coupling
-   USE c1d             ! 1D configuration
-   USE step_c1d        ! Time stepping loop for the 1D configuration
-   USE dyndmp          ! Momentum damping
+   USE tideini        ! tidal components initialization   (tide_ini routine)
+   USE bdyini         ! open boundary cond. setting       (bdy_init routine)
+   USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine)
+   USE bdytides       ! open boundary cond. setting   (bdytide_init routine)
+   USE sbctide, ONLY  : lk_tide
+   USE istate         ! initial state setting          (istate_init routine)
+   USE ldfdyn         ! lateral viscosity setting      (ldfdyn_init routine)
+   USE ldftra         ! lateral diffusivity setting    (ldftra_init routine)
+   USE zdfini         ! vertical physics setting          (zdf_init routine)
+   USE phycst         ! physical constant                  (par_cst routine)
+   USE trdini         ! dyn/tra trends initialization     (trd_init routine)
+   USE asminc         ! assimilation increments     
+   USE asmbkg         ! writing out state trajectory
+   USE diaptr         ! poleward transports           (dia_ptr_init routine)
+   USE diadct         ! sections transports           (dia_dct_init routine)
+   USE diaobs         ! Observation diagnostics       (dia_obs_init routine)
+   USE diacfl         ! CFL diagnostics               (dia_cfl_init routine)
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE step           ! NEMO time-stepping                 (stp     routine)
+   USE icbini         ! handle bergs, initialisation
+   USE icbstp         ! handle bergs, calving, themodynamics and transport
+   USE cpl_oasis3     ! OASIS3 coupling
+   USE c1d            ! 1D configuration
+   USE step_c1d       ! Time stepping loop for the 1D configuration
+   USE dyndmp         ! Momentum damping
+   USE stopar         ! Stochastic param.: ???
+   USE stopts         ! Stochastic param.: ???
 #if defined key_top
-   USE trcini          ! passive tracer initialisation
-#endif
-   USE lib_mpp         ! distributed memory computing
+   USE trcini         ! passive tracer initialisation
+#endif
+   USE lib_mpp        ! distributed memory computing
+   USE diurnal_bulk    ! diurnal bulk SST 
+   USE step_diu        ! diurnal bulk SST timestepping (called from here if run offline)
 #if defined key_iomput
-   USE xios
-#endif
-   USE sbctide, ONLY: lk_tide
-   USE crsini          ! initialise grid coarsening utility
-   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
-   USE sbc_oce, ONLY: lk_oasis
-   USE stopar
-   USE stopts
+   USE xios           ! xIOserver
+#endif
+   USE crsini         ! initialise grid coarsening utility
+   USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
+   USE sbc_oce, ONLY  : lk_oasis
+   USE diatmb          ! Top,middle,bottom output
+   USE dia25h          ! 25h mean output
+   USE wet_dry         ! Wetting and drying setting   (wad_init routine)
 
    IMPLICIT NONE
@@ -96,5 +104,5 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -161,9 +169,17 @@
           ENDIF
 
+#if defined key_agrif
+          CALL Agrif_Regrid()
+#endif
+
          DO WHILE ( istp <= nitend .AND. nstop == 0 )
 #if defined key_agrif
-            CALL Agrif_Step( stp )           ! AGRIF: time stepping
+            CALL stp                         ! AGRIF: time stepping
 #else
-            CALL stp( istp )                 ! standard time stepping
+            IF ( .NOT. ln_diurnal_only ) THEN 
+               CALL stp( istp )                 ! standard time stepping 
+            ELSE 
+               CALL stp_diurnal( istp )        ! time step only the diurnal SST 
+            ENDIF 
 #endif
             istp = istp + 1
@@ -172,5 +188,5 @@
 #endif
 
-      IF( lk_diaobs   )   CALL dia_obs_wri
+      IF( ln_diaobs   )   CALL dia_obs_wri
       !
       IF( ln_icebergs )   CALL icb_end( nitend )
@@ -187,9 +203,9 @@
       !
 #if defined key_agrif
-      IF ( Agrif_Level() < Agrif_MaxLevel() ) THEN 
-         CALL Agrif_ParentGrid_To_ChildGrid()
-         IF( lk_diaobs ) CALL dia_obs_wri
+      IF( .NOT. Agrif_Root() ) THEN
+                         CALL Agrif_ParentGrid_To_ChildGrid()
+         IF( ln_diaobs ) CALL dia_obs_wri
          IF( nn_timing == 1 )   CALL timing_finalize
-         CALL Agrif_ChildGrid_To_ParentGrid()
+                                CALL Agrif_ChildGrid_To_ParentGrid()
       ENDIF
 #endif
@@ -199,6 +215,6 @@
       !
 #if defined key_iomput
-      CALL xios_finalize                ! end mpp communications with xios
-      IF( lk_oasis ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS
+      CALL xios_finalize                  ! end mpp communications with xios
+      IF( lk_oasis )   CALL cpl_finalize  ! end coupling and mpp communications with OASIS
 #else
       IF( lk_oasis ) THEN 
@@ -225,5 +241,5 @@
       NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
          &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
-         &             nn_bench, nn_timing
+         &             nn_bench, nn_timing, nn_diacfl
       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
          &             jpizoom, jpjzoom, jperio, ln_use_jattr
@@ -315,7 +331,7 @@
       ! If dimensions of processor grid weren't specified in the namelist file
       ! then we calculate them here now that we have our communicator size
-      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
+      IF( jpni < 1 .OR. jpnj < 1 ) THEN
 #if   defined key_mpp_mpi
-         IF( Agrif_Root() ) CALL nemo_partition(mppsize)
+         IF( Agrif_Root() )   CALL nemo_partition( mppsize )
 #else
          jpni  = 1
@@ -323,19 +339,24 @@
          jpnij = jpni*jpnj
 #endif
-      END IF
+      ENDIF
 
       ! Calculate domain dimensions given calculated jpni and jpnj
-      ! This used to be done in par_oce.F90 when they were parameters rather
-      ! than variables
+      ! This used to be done in par_oce.F90 when they were parameters rather than variables
       IF( Agrif_Root() ) THEN
 #if defined key_nemocice_decomp
-         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim.
-         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 
+         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
+         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim. 
 #else
-         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim.
-         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
-#endif
-      ENDIF
+         jpi = ( jpiglo     -2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
+         jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim.
+#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                                            !   "           "
@@ -351,5 +372,5 @@
          WRITE(numout,*) '                       NEMO team'
          WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.6  (2015) '
+         WRITE(numout,*) '                  version 3.7  (2015) '
          WRITE(numout,*)
          WRITE(numout,*)
@@ -382,27 +403,43 @@
                             CALL     eos_init   ! Equation of state
       IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration
+                            CALL     wad_init   ! Wetting and drying options
                             CALL     dom_cfg    ! Domain configuration
                             CALL     dom_init   ! Domain
-
-      IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined)
-
+      IF( ln_crs        )   CALL     crs_init   ! coarsened grid: domain initialization 
+      IF( ln_nnogather )    CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined)
       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
-
+      
+      CALL diurnal_sst_bulk_init            ! diurnal sst
+      IF ( ln_diurnal ) CALL diurnal_sst_coolskin_init   ! cool skin   
+      
+      ! IF ln_diurnal_only, then we only want a subset of the initialisation routines
+      IF ( ln_diurnal_only ) THEN
+         CALL  istate_init   ! ocean initial state (Dynamics and tracers)
+         CALL     sbc_init   ! Forcings : surface module
+         CALL tra_qsr_init   ! penetrative solar radiation qsr
+         IF( ln_diaobs     ) THEN                  ! Observation & model comparison
+            CALL dia_obs_init            ! Initialize observational data
+            CALL dia_obs( nit000 - 1 )   ! Observation operator for restart
+         ENDIF     
+         !                                     ! Assimilation increments
+         IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments
+                 
+         IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
+         RETURN
+      ENDIF
+      
                             CALL  istate_init   ! ocean initial state (Dynamics and tracers)
 
-      IF( lk_tide       )   CALL    tide_init( nit000 )    ! Initialisation of the tidal harmonics
-
-                            CALL     sbc_init   ! Forcings : surface module (clem: moved here for bdy purpose)
-
+      !                                      ! external forcing 
+!!gm to be added : creation and call of sbc_apr_init
+      IF( lk_tide       )   CALL    tide_init   ! tidal harmonics
+                            CALL     sbc_init   ! surface boundary conditions (including sea-ice)
+!!gm ==>> bdy_init should call bdy_dta_init and bdytide_init  NOT in nemogcm !!!
       IF( lk_bdy        )   CALL     bdy_init   ! Open boundaries initialisation
       IF( lk_bdy        )   CALL bdy_dta_init   ! Open boundaries initialisation of external data arrays
       IF( lk_bdy .AND. lk_tide )   &
          &                  CALL bdytide_init   ! Open boundaries initialisation of tidal harmonic forcing
-
-                            CALL dyn_nept_init  ! simplified form of Neptune effect
-      !     
-      IF( ln_crs        )   CALL     crs_init   ! Domain initialization of coarsened grid
-      !
-                                ! Ocean physics
+         
+      !                                      ! Ocean physics
       !                                         ! Vertical physics
                             CALL     zdf_init      ! namelist read
@@ -411,43 +448,46 @@
       IF( lk_zdftke     )   CALL zdf_tke_init      ! TKE closure scheme
       IF( lk_zdfgls     )   CALL zdf_gls_init      ! GLS closure scheme
-      IF( lk_zdfkpp     )   CALL zdf_kpp_init      ! KPP closure scheme
       IF( lk_zdftmx     )   CALL zdf_tmx_init      ! tidal vertical mixing
-      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   &
-         &                  CALL zdf_ddm_init      ! double diffusive mixing
+      IF( lk_zdfddm     )   CALL zdf_ddm_init      ! double diffusive mixing
+         
       !                                         ! Lateral physics
                             CALL ldf_tra_init      ! Lateral ocean tracer physics
+                            CALL ldf_eiv_init      ! eddy induced velocity param.
                             CALL ldf_dyn_init      ! Lateral ocean momentum physics
-      IF( lk_ldfslp     )   CALL ldf_slp_init      ! slope of lateral mixing
-
-      !                                     ! Active tracers
-                            CALL tra_qsr_init   ! penetrative solar radiation qsr
-                            CALL tra_bbc_init   ! bottom heat flux
-      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme
-                            CALL tra_dmp_init   ! internal damping trends- tracers
-                            CALL tra_adv_init   ! horizontal & vertical advection
-                            CALL tra_ldf_init   ! lateral mixing
-                            CALL tra_zdf_init   ! vertical mixing and after tracer fields
-
-      !                                     ! Dynamics
-      IF( lk_c1d        )   CALL dyn_dmp_init   ! internal damping trends- momentum
-                            CALL dyn_adv_init   ! advection (vector or flux form)
-                            CALL dyn_vor_init   ! vorticity term including Coriolis
-                            CALL dyn_ldf_init   ! lateral mixing
-                            CALL dyn_hpg_init   ! horizontal gradient of Hydrostatic pressure
-                            CALL dyn_zdf_init   ! vertical diffusion
-                            CALL dyn_spg_init   ! surface pressure gradient
-
-      !                                     ! Misc. options
-      IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_init       ! Cross Land Advection
+
+      !                                         ! Active tracers
+                            CALL tra_qsr_init      ! penetrative solar radiation qsr
+                            CALL tra_bbc_init      ! bottom heat flux
+      IF( lk_trabbl     )   CALL tra_bbl_init      ! advective (and/or diffusive) bottom boundary layer scheme
+                            CALL tra_dmp_init      ! internal tracer damping
+                            CALL tra_adv_init      ! horizontal & vertical advection
+                            CALL tra_ldf_init      ! lateral mixing
+                            CALL tra_zdf_init      ! vertical mixing and after tracer fields
+
+      !                                         ! Dynamics
+      IF( lk_c1d        )   CALL dyn_dmp_init      ! internal momentum damping
+                            CALL dyn_adv_init      ! advection (vector or flux form)
+                            CALL dyn_vor_init      ! vorticity term including Coriolis
+                            CALL dyn_ldf_init      ! lateral mixing
+                            CALL dyn_hpg_init      ! horizontal gradient of Hydrostatic pressure
+                            CALL dyn_zdf_init      ! vertical diffusion
+                            CALL dyn_spg_init      ! surface pressure gradient
+
+#if defined key_top
+      !                                      ! Passive tracers
+                            CALL     trc_init
+#endif
+      IF( l_ldfslp      )   CALL ldf_slp_init   ! slope of lateral mixing
+
+      !                                      ! Icebergs
                             CALL icb_init( rdt, nit000)   ! initialise icebergs instance
+
+      !                                      ! Misc. options
                             CALL sto_par_init   ! Stochastic parametrization
       IF( ln_sto_eos     )  CALL sto_pts_init   ! RRandom T/S fluctuations
      
-#if defined key_top
-      !                                     ! Passive tracers
-                            CALL     trc_init
-#endif
-      !                                     ! Diagnostics
+      !                                      ! Diagnostics
       IF( lk_floats     )   CALL     flo_init   ! drifting Floats
+                            CALL dia_cfl_init   ! Initialise CFL diagnostics
       IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag
                             CALL dia_ptr_init   ! Poleward TRansports initialization
@@ -455,12 +495,13 @@
                             CALL dia_hsb_init   ! heat content, salt content and volume budgets
                             CALL     trd_init   ! Mixed-layer/Vorticity/Integral constraints trends
-      IF( lk_diaobs     ) THEN                  ! Observation & model comparison
                             CALL dia_obs_init            ! Initialize observational data
-                            CALL dia_obs( nit000 - 1 )   ! Observation operator for restart
-      ENDIF
-
-      !                                     ! Assimilation increments
+      IF( ln_diaobs     )   CALL dia_obs( nit000 - 1 )   ! Observation operator for restart
+
+      !                                         ! Assimilation increments
       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
+
       !
    END SUBROUTINE nemo_init
@@ -507,15 +548,15 @@
          WRITE(numout,*) '~~~~~~~ '
          WRITE(numout,*) '   Namelist namcfg'
-         WRITE(numout,*) '      configuration name              cp_cfg      = ', TRIM(cp_cfg)
-         WRITE(numout,*) '      configuration zoom name         cp_cfz      = ', TRIM(cp_cfz)
-         WRITE(numout,*) '      configuration resolution        jp_cfg      = ', jp_cfg
-         WRITE(numout,*) '      1st lateral dimension ( >= jpi ) jpidta     = ', jpidta
-         WRITE(numout,*) '      2nd    "         "    ( >= jpj ) jpjdta     = ', jpjdta
-         WRITE(numout,*) '      3nd    "         "               jpkdta     = ', jpkdta
-         WRITE(numout,*) '      1st dimension of global domain in i jpiglo  = ', jpiglo
-         WRITE(numout,*) '      2nd    -                  -    in j jpjglo  = ', jpjglo
+         WRITE(numout,*) '      configuration name                               cp_cfg  = ', TRIM(cp_cfg)
+         WRITE(numout,*) '      configuration zoom name                          cp_cfz  = ', TRIM(cp_cfz)
+         WRITE(numout,*) '      configuration resolution                         jp_cfg  = ', jp_cfg
+         WRITE(numout,*) '      1st lateral dimension ( >= jpiglo )              jpidta  = ', jpidta
+         WRITE(numout,*) '      2nd    "         "    ( >= jpjglo )              jpjdta  = ', jpjdta
+         WRITE(numout,*) '      3nd    "         "                               jpkdta  = ', jpkdta
+         WRITE(numout,*) '      1st dimension of global domain in i              jpiglo  = ', jpiglo
+         WRITE(numout,*) '      2nd    -                  -    in j              jpjglo  = ', jpjglo
          WRITE(numout,*) '      left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom
          WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
-         WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio   
+         WRITE(numout,*) '      lateral cond. type (between 0 and 6)             jperio  = ', jperio   
          WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
       ENDIF
@@ -598,5 +639,4 @@
       IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
       IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
-
       !
       numout = 6                                     ! redefine numout in case it is used after this point...
@@ -615,6 +655,4 @@
       USE diawri    , ONLY: dia_wri_alloc
       USE dom_oce   , ONLY: dom_oce_alloc
-      USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc
-      USE ldftra_oce, ONLY: ldftra_oce_alloc
       USE trc_oce   , ONLY: trc_oce_alloc
 #if defined key_diadct 
@@ -631,6 +669,4 @@
       ierr = ierr + dia_wri_alloc   ()
       ierr = ierr + dom_oce_alloc   ()          ! ocean domain
-      ierr = ierr + ldfdyn_oce_alloc()          ! ocean lateral  physics : dynamics
-      ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers
       ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
       !
@@ -712,16 +748,15 @@
       INTEGER :: ifac, jl, inu
       INTEGER, PARAMETER :: ntest = 14
-      INTEGER :: ilfax(ntest)
+      INTEGER, DIMENSION(ntest) ::   ilfax
+      !!----------------------------------------------------------------------
       !
       ! 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  /
-      !!----------------------------------------------------------------------
-
+      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
+      !
       ! Clear the error flag and initialise output vars
-      kerr = 0
-      kfax = 1
+      kerr  = 0
+      kfax  = 1
       knfax = 0
-
+      !
       ! Find the factors of n.
       IF( kn == 1 )   GOTO 20
@@ -731,8 +766,8 @@
       ! l points to the allowed factor list.
       ! ifac holds the current factor.
-
+      !
       inu   = kn
       knfax = 0
-
+      !
       DO jl = ntest, 1, -1
          !
@@ -758,5 +793,5 @@
          !
       END DO
-
+      !
    20 CONTINUE      ! Label 20 is the exit point from the factor search loop.
       !
@@ -766,26 +801,24 @@
 
    SUBROUTINE nemo_northcomms
-      !!======================================================================
+      !!----------------------------------------------------------------------
       !!                     ***  ROUTINE  nemo_northcomms  ***
-      !! nemo_northcomms    :  Setup for north fold exchanges with explicit 
-      !!                       point-to-point messaging
-      !!=====================================================================
-      !!----------------------------------------------------------------------
-      !!
-      !! ** Purpose :   Initialization of the northern neighbours lists.
+      !! ** Purpose :   Setup for north fold exchanges with explicit 
+      !!                point-to-point messaging
+      !!
+      !! ** Method :   Initialization of the northern neighbours lists.
       !!----------------------------------------------------------------------
       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
       !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
       !!----------------------------------------------------------------------
-
       INTEGER  ::   sxM, dxM, sxT, dxT, jn
       INTEGER  ::   njmppmax
-
+      !!----------------------------------------------------------------------
+      !
       njmppmax = MAXVAL( njmppt )
-    
+      !
       !initializes the north-fold communication variables
       isendto(:) = 0
-      nsndto = 0
-
+      nsndto     = 0
+      !
       !if I am a process in the north
       IF ( njmpp == njmppmax ) THEN
@@ -834,4 +867,5 @@
       l_north_nogather = .TRUE.
    END SUBROUTINE nemo_northcomms
+
 #else
    SUBROUTINE nemo_northcomms      ! Dummy routine
@@ -843,3 +877,2 @@
 END MODULE nemogcm
 
-
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 6808)
@@ -7,4 +7,5 @@
    !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z* coordinate
    !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays
+   !!            3.7  !  2014-01  (G. Madec) suppression of curl and before hdiv from in-core memory
    !!----------------------------------------------------------------------
    USE par_oce        ! ocean parameters
@@ -16,14 +17,10 @@
    PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90
 
-   LOGICAL, PUBLIC ::   l_traldf_rot = .FALSE.  !: rotated laplacian operator for lateral diffusion
-
    !! dynamics and tracer fields                            ! before ! now    ! after  ! the after trends becomes the fields
    !! --------------------------                            ! fields ! fields ! trends ! only after tra_zdf and dyn_spg
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity          [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity          [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ua_sv,  va_sv          !: Saved trends (time spliting)   [m/s2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity              [m/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rotb ,  rotn           !: relative vorticity             [s-1]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hdivb,  hdivn          !: horizontal divergence          [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity            [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           hdivn          !: horizontal divergence        [s-1]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields                  [Celcius,psu] 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celcius-1,psu-1]
@@ -38,4 +35,17 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vb_b   ,  vn_b  ,  va_b  !: Barotropic velocities at v-point [m/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshb   ,  sshn  ,  ssha  !: sea surface height at t-point [m]
+
+   !! Arrays at barotropic time step:                   ! befbefore! before !  now   ! after  !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubb_e  ,  ub_e  ,  un_e  , ua_e   !: u-external velocity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vbb_e  ,  vb_e  ,  vn_e  , va_e   !: v-external velocity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshbb_e,  sshb_e,  sshn_e, ssha_e !: external ssh
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hu_e   !: external u-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hv_e   !: external v-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hur_e  !: inverse of u-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hvr_e  !: inverse of v-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b  , vb2_b           !: Half step fluxes (ln_bt_fw=T)
+#if defined key_agrif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_i_b, vb2_i_b         !: Half step time integrated fluxes 
+#endif
    !
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   spgu, spgv               !: horizontal surface pressure gradient
@@ -45,7 +55,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtsu, gtsv   !: horizontal gradient of T, S bottom u-point 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gru , grv    !: horizontal gradient of rd at bottom u-point
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   aru , arv    
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gzu , gzv    
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ge3ru, ge3rv   !: horizontal gradient of T, S and rd at top v-point  
 
    !! (ISF) interpolated gradient (only used for ice shelf case) 
@@ -53,7 +60,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtui, gtvi   !: horizontal gradient of T, S and rd at top u-point 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   grui, grvi   !: horizontal gradient of T, S and rd at top v-point  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   arui, arvi   !: horizontal average  of rd          at top v-point  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gzui, gzvi   !: horizontal gradient of z           at top v-point  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ge3rui, ge3rvi   !: horizontal gradient of T, S and rd at top v-point  
    !! (ISF) ice load
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riceload
@@ -73,5 +77,5 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -83,20 +87,17 @@
       !!                   ***  FUNCTION oce_alloc  ***
       !!----------------------------------------------------------------------
-      INTEGER :: ierr(4)
+      INTEGER :: ierr(7)
       !!----------------------------------------------------------------------
       !
+      ierr(:) = 0 
       ALLOCATE( ub   (jpi,jpj,jpk)      , un   (jpi,jpj,jpk)      , ua(jpi,jpj,jpk)       ,     &
-         &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &      
-         &      ua_sv(jpi,jpj,jpk)      , va_sv(jpi,jpj,jpk)      ,                             &      
-         &      wn   (jpi,jpj,jpk)      ,                                                       &
-         &      rotb (jpi,jpj,jpk)      , rotn (jpi,jpj,jpk)      ,                             &   
-         &      hdivb(jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             &
+         &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &          
+         &      wn   (jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             &
          &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     &
          &      rab_b(jpi,jpj,jpk,jpts) , rab_n(jpi,jpj,jpk,jpts) ,                             &
-         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) )
+         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)      ,                             &
+         &      rhd  (jpi,jpj,jpk)      , rhop (jpi,jpj,jpk)                              , STAT=ierr(1) )
          !
-      ALLOCATE(rhd (jpi,jpj,jpk) ,                                         &
-         &     rhop(jpi,jpj,jpk) ,                                         &
-         &     rke(jpi,jpj,jpk)  ,                                         &
+      ALLOCATE(rke(jpi,jpj,jpk)  ,                                         &
          &     sshb(jpi,jpj)     , sshn(jpi,jpj)   , ssha(jpi,jpj)   ,     &
          &     ub_b(jpi,jpj)     , un_b(jpi,jpj)   , ua_b(jpi,jpj)   ,     &
@@ -104,12 +105,6 @@
          &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       &
          &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     &
-         &     aru(jpi,jpj)      , arv(jpi,jpj)      ,                     &
-         &     gzu(jpi,jpj)      , gzv(jpi,jpj)      ,                     &
          &     gru(jpi,jpj)      , grv(jpi,jpj)      ,                     &
-         &     ge3ru(jpi,jpj)    , ge3rv(jpi,jpj)    ,                     &
          &     gtui(jpi,jpj,jpts), gtvi(jpi,jpj,jpts),                     &
-         &     arui(jpi,jpj)     , arvi(jpi,jpj)     ,                     &
-         &     gzui(jpi,jpj)     , gzvi(jpi,jpj)     ,                     &
-         &     ge3rui(jpi,jpj)   , ge3rvi(jpi,jpj)   ,                     &
          &     grui(jpi,jpj)     , grvi(jpi,jpj)     ,                     &
          &     riceload(jpi,jpj),                             STAT=ierr(2) )
@@ -118,4 +113,14 @@
          !
       ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) )
+         !
+      ALLOCATE( ssha_e(jpi,jpj),  sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), &
+         &        ua_e(jpi,jpj),    un_e(jpi,jpj),   ub_e(jpi,jpj),   ubb_e(jpi,jpj), &
+         &        va_e(jpi,jpj),    vn_e(jpi,jpj),   vb_e(jpi,jpj),   vbb_e(jpi,jpj), &
+         &        hu_e(jpi,jpj),   hur_e(jpi,jpj),   hv_e(jpi,jpj),   hvr_e(jpi,jpj), STAT=ierr(5) )
+         !
+      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj)                                      , STAT=ierr(6) )
+#if defined key_agrif
+      ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                                  , STAT=ierr(7) )
+#endif
          !
       oce_alloc = MAXVAL( ierr )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 6808)
@@ -92,13 +92,4 @@
    INTEGER, PUBLIC  ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj
 
-   !!---------------------------------------------------------------------
-   !! Optimization/control flags
-   !!---------------------------------------------------------------------
-#if defined key_esopa
-   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .TRUE.   !: flag to activate the all options
-#else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .FALSE.  !: flag to activate the all options
-#endif
-
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 6808)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                       ***  MODULE step  ***
-   !! Time-stepping    : manager of the ocean, tracer and ice time stepping
+   !! Time-stepping   : manager of the ocean, tracer and ice time stepping
    !!======================================================================
    !! History :  OPA  !  1991-03  (G. Madec)  Original code
@@ -24,6 +24,9 @@
    !!             -   !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
    !!            3.4  !  2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal
-   !!                 !  2012-07  (J. Simeon, G. Madec, C. Ethe) Online coarsening of outputs
-   !!            3.7  !  2014-04  (F. Roquet, G. Madec) New equations of state
+   !!            3.6  !  2012-07  (J. Simeon, G. Madec. C. Ethe)  Online coarsening of outputs
+   !!            3.6  !  2014-04  (F. Roquet, G. Madec) New equations of state
+   !!            3.7  !  2014-10  (G. Madec)  LDF simplication 
+   !!             -   !  2014-12  (G. Madec) remove KPP scheme
+   !!             -   !  2015-11  (J. Chanut) free surface simplification
    !!----------------------------------------------------------------------
 
@@ -32,16 +35,14 @@
    !!----------------------------------------------------------------------
    USE step_oce         ! time stepping definition modules
-   USE iom
+   !
+   USE iom              ! xIOs server
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   stp   ! called by opa.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-!!gm   #  include "zdfddm_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   PUBLIC   stp   ! called by nemogcm.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -50,5 +51,5 @@
 
 #if defined key_agrif
-   SUBROUTINE stp( )
+   RECURSIVE SUBROUTINE stp( )
       INTEGER             ::   kstp   ! ocean time-step index
 #else
@@ -69,5 +70,5 @@
       !!              -5- Compute the momentum trends
       !!              -6- Update the horizontal velocity
-      !!              -7- Compute the diagnostics variables (rd,N2, div,cur,w)
+      !!              -7- Compute the diagnostics variables (rd,N2, hdiv,w)
       !!              -8- Outputs and diagnostics
       !!----------------------------------------------------------------------
@@ -76,39 +77,40 @@
       INTEGER ::   kcall    ! optional integer argument (dom_vvl_sf_nxt)
       !! ---------------------------------------------------------------------
-
 #if defined key_agrif
       kstp = nit000 + Agrif_Nb_Step()
-!      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( 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( kstp == nit000 + 1 )   lk_agrif_fstep = .FALSE.
 # if defined key_iomput
       IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context )
 # endif
 #endif
-                             indic = 0           ! reset to no error condition
-      IF( kstp == nit000 ) THEN
-         ! must be done after nemo_init for AGRIF+XIOS+OASIS
-                      CALL iom_init(      cxios_context          )  ! iom_put initialization
-         IF( ln_crs ) CALL iom_init( TRIM(cxios_context)//"_crs" )  ! initialize context for coarse grid
-      ENDIF
-
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! update I/O and calendar 
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                             indic = 0                ! reset to no error condition
+                             
+      IF( kstp == nit000 ) THEN                       ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS)
+                             CALL iom_init(      cxios_context          )  ! for model grid (including passible AGRIF zoom)
+         IF( ln_crs      )   CALL iom_init( TRIM(cxios_context)//"_crs" )  ! for coarse grid
+      ENDIF
       IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
-                             CALL iom_setkt( kstp - nit000 + 1,      cxios_context          )   ! tell iom we are at time step kstp
-      IF( ln_crs     )       CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell iom we are at time step kstp
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Update data, open boundaries, surface boundary condition (including sea-ice)
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( lk_tide    )   CALL sbc_tide( kstp )
-      IF( lk_bdy     )  THEN
-         IF( ln_apr_dyn) CALL sbc_apr( kstp )   ! bdy_dta needs ssh_ib 
-                         CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries
-      ENDIF
-                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
-                                                      ! clem: moved here for bdy ice purpose
+                             CALL iom_setkt( kstp - nit000 + 1,      cxios_context          )   ! tell IOM we are at time step kstp
+      IF( ln_crs         )   CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell IOM we are at time step kstp
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Update external forcing (tides, open boundaries, and surface boundary condition (including sea-ice)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( lk_tide    )   CALL sbc_tide( kstp )                   ! update tide potential
+      IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                   ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib) 
+      IF( lk_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries
+                         CALL sbc     ( kstp )                   ! Sea Boundary Condition (including sea-ice)
+
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Update stochastic parameters and random T/S fluctuations
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-                        CALL sto_par( kstp )          ! Stochastic parameters
+                         CALL sto_par( kstp )          ! Stochastic parameters
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -120,4 +122,5 @@
                          CALL bn2    ( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency
                          CALL bn2    ( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency
+
       !
       !  VERTICAL PHYSICS
@@ -127,5 +130,4 @@
       IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz
       IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz
-      IF( lk_zdfkpp  )   CALL zdf_kpp( kstp )            ! KPP closure scheme for Kz
       IF( lk_zdfcst  ) THEN                              ! Constant Kz (reset avt, avm[uv] to the background value)
          avt (:,:,:) = rn_avt0 * wmask (:,:,:)
@@ -133,6 +135,7 @@
          avmv(:,:,:) = rn_avm0 * wvmask(:,:,:)
       ENDIF
+
       IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths
-         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO
+         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO
       ENDIF
       IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity
@@ -140,6 +143,5 @@
       IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing
 
-      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   &
-         &               CALL zdf_ddm( kstp )         ! double diffusive mixing
+      IF( lk_zdfddm  )   CALL zdf_ddm( kstp )         ! double diffusive mixing
 
                          CALL zdf_mxl( kstp )         ! mixed layer depth
@@ -151,211 +153,193 @@
       !  LATERAL  PHYSICS
       !
-      IF( lk_ldfslp ) THEN                            ! slope of lateral mixing
+      IF( l_ldfslp ) THEN                             ! slope of lateral mixing
+!!gm : why this here ????
          IF(ln_sto_eos ) CALL sto_pts( tsn )          ! Random T/S fluctuations
+!!gm
                          CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density
+
          IF( ln_zps .AND. .NOT. ln_isfcav)                               &
             &            CALL zps_hde    ( kstp, jpts, tsb, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient
             &                                          rhd, gru , grv    )  ! of t, s, rd at the last ocean level
+
          IF( ln_zps .AND.       ln_isfcav)                               &
-            &            CALL zps_hde_isf( kstp, jpts, tsb, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
-            &                                          rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
-            &                                   gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the first ocean level
-         IF( ln_traldf_grif ) THEN                           ! before slope for Griffies operator
-                         CALL ldf_slp_grif( kstp )
-         ELSE
-                         CALL ldf_slp( kstp, rhd, rn2b )     ! before slope for Madec operator
+            &            CALL zps_hde_isf( kstp, jpts, tsb, gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF)
+            &                                          rhd, gru , grv , grui, grvi   )  ! of t, s, rd at the first ocean level
+         IF( ln_traldf_triad ) THEN 
+                         CALL ldf_slp_triad( kstp )                       ! before slope for triad operator
+         ELSE     
+                         CALL ldf_slp     ( kstp, rhd, rn2b )             ! before slope for standard operator
          ENDIF
       ENDIF
-#if defined key_traldf_c2d
-      IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )      ! eddy induced velocity coefficient
-#endif
-#if defined key_traldf_c3d && defined key_traldf_smag
-                          CALL ldf_tra_smag( kstp )      ! eddy induced velocity coefficient
-#  endif
-#if defined key_dynldf_c3d && defined key_dynldf_smag
-                          CALL ldf_dyn_smag( kstp )      ! eddy induced velocity coefficient
-#  endif
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      !  Ocean dynamics : hdiv, rot, ssh, e3, wn
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                         CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_cur)
-      IF( lk_vvl     )   CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors 
-                         CALL wzv           ( kstp )  ! now cross-level velocity 
-
-      IF( lk_dynspg_ts ) THEN 
-          ! In case the time splitting case, update almost all momentum trends here:
-          ! 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)                               &
-               &            CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
-               &                                          rhd, gru , grv    )  ! of t, s, rd at the last ocean level
-            IF( ln_zps .AND.       ln_isfcav)                               &
-               &            CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
-               &                                          rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
-               &                                   gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
-
-                                  ua(:,:,:) = 0.e0             ! set dynamics trends to zero
-                                  va(:,:,:) = 0.e0
-          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)
-          IF( lk_bdy           )  CALL bdy_dyn3d_dmp( kstp )   ! bdy damping trends
-                                  CALL dyn_adv      ( kstp )   ! advection (vector or flux form)
-                                  CALL dyn_vor      ( kstp )   ! vorticity term including Coriolis
-                                  CALL dyn_ldf      ( kstp )   ! lateral mixing
-          IF( ln_neptsimp )       CALL dyn_nept_cor ( kstp )   ! add Neptune velocities (simplified)
-#if defined key_agrif
-          IF(.NOT. Agrif_Root())  CALL Agrif_Sponge_dyn        ! momentum sponge
-#endif
-                                  CALL dyn_hpg( kstp )         ! horizontal gradient of Hydrostatic pressure
-                                  CALL dyn_spg( kstp, indic )  ! surface pressure gradient
-
-                                  ua_sv(:,:,:) = ua(:,:,:)     ! Save trends (barotropic trend has been fully updated at this stage)
-                                  va_sv(:,:,:) = va(:,:,:)
-
-                                  CALL div_cur( kstp )         ! Horizontal divergence & Relative vorticity (2nd call in time-split case)
-          IF( lk_vvl     )        CALL dom_vvl_sf_nxt( kstp, kcall=2 )  ! after vertical scale factors (update depth average component)
-                                  CALL wzv           ( kstp )  ! now cross-level velocity 
-      ENDIF
-
+      !                                               ! eddy diffusivity coeff. and/or eiv coeff.
+      IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kstp ) 
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      !  Ocean dynamics : hdiv, ssh, e3, u, v, w
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+                            CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_hor)
+      IF(.NOT.ln_linssh )   CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors 
+                            CALL wzv           ( kstp )  ! now cross-level velocity 
+!!gm : why also here ????
+      IF( ln_sto_eos    )   CALL sto_pts( tsn )                             ! Random T/S fluctuations
+!!gm
+                            CALL eos    ( tsn, rhd, rhop, gdept_n(:,:,:) )  ! now in situ density for hpg computation
+                            
+!!jc: fs simplification
+!!jc: lines below are useless if ln_linssh=F. Keep them here (which maintains a bug if ln_linssh=T and ln_zps=T, cf ticket #1636) 
+!!                                         but ensures reproductible results
+!!                                         with previous versions using split-explicit free surface          
+            IF( ln_zps .AND. .NOT. ln_isfcav )                               &
+               &            CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,   &  ! Partial steps: before horizontal gradient
+               &                                          rhd, gru , grv     )  ! of t, s, rd at the last ocean level
+            IF( ln_zps .AND.       ln_isfcav )                                          &
+               &            CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF)
+               &                                          rhd, gru , grv , grui, grvi   )  ! of t, s, rd at the first ocean level
+!!jc: fs simplification
+                            
+                         ua(:,:,:) = 0._wp            ! set dynamics trends to zero
+                         va(:,:,:) = 0._wp
+
+      IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   &
+                         CALL dyn_asm_inc   ( kstp )  ! apply dynamics assimilation increment
+      IF( lk_bdy     )   CALL bdy_dyn3d_dmp ( kstp )  ! bdy damping trends
+#if defined key_agrif
+      IF(.NOT. Agrif_Root())  & 
+               &         CALL Agrif_Sponge_dyn        ! momentum sponge
+#endif
+                         CALL dyn_adv       ( kstp )  ! advection (vector or flux form)
+                         CALL dyn_vor       ( kstp )  ! vorticity term including Coriolis
+                         CALL dyn_ldf       ( kstp )  ! lateral mixing
+                         CALL dyn_hpg       ( kstp )  ! horizontal gradient of Hydrostatic pressure
+                         CALL dyn_spg       ( kstp )  ! surface pressure gradient
+
+                                                      ! With split-explicit free surface, since now transports have been updated and ssha as well
+      IF( ln_dynspg_ts ) THEN                         ! vertical scale factors and vertical velocity need to be updated
+                            CALL div_hor    ( kstp )              ! Horizontal divergence  (2nd call in time-split case)
+         IF(.NOT.ln_linssh) CALL dom_vvl_sf_nxt( kstp, kcall=2 )  ! after vertical scale factors (update depth average component)
+                            CALL wzv        ( kstp )              ! now cross-level velocity 
+      ENDIF
+
+                         CALL dyn_bfr       ( kstp )  ! bottom friction
+                         CALL dyn_zdf       ( kstp )  ! vertical diffusion
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! cool skin
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
+      IF ( ln_diurnal )  CALL stp_diurnal( kstp )
+      
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! diagnostics and outputs             (ua, va, tsa used as workspace)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( lk_floats  )      CALL flo_stp( kstp )         ! drifting Floats
-      IF( lk_diahth  )      CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth)
-      IF( .NOT. ln_cpl )    CALL dia_fwb( kstp )         ! Fresh water budget diagnostics
-      IF( lk_diadct  )      CALL dia_dct( kstp )         ! Transports
-      IF( lk_diaar5  )      CALL dia_ar5( kstp )         ! ar5 diag
-      IF( lk_diaharm )      CALL dia_harm( kstp )        ! Tidal harmonic analysis
-                            CALL dia_wri( kstp )         ! ocean model: outputs
-      !
-      IF( ln_crs     )      CALL crs_fld( kstp )         ! ocean model: online field coarsening & output
-
+      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats
+      IF( nn_diacfl == 1 )   CALL dia_cfl( kstp )         ! Courant number diagnostics
+      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth)
+      IF(.NOT.ln_cpl )   CALL dia_fwb( kstp )         ! Fresh water budget diagnostics
+      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports
+      IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag
+      IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis
+                         CALL dia_wri( kstp )         ! ocean model: outputs
+      !
+      IF( ln_crs     )   CALL crs_fld       ( kstp )  ! ocean model: online field coarsening & output
+      
 #if defined key_top
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Passive Tracer Model
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                         CALL trc_stp( kstp )         ! time-stepping
-#endif
-
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Active tracers                              (ua, va used as workspace)
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                             tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero
-
-      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_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux
-      IF( lk_trabbl      )   CALL tra_bbl    ( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme
-      IF( ln_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends
-      IF( lk_bdy         )   CALL bdy_tra_dmp( kstp )       ! bdy damping trends
-                             CALL tra_adv    ( kstp )       ! horizontal & vertical advection
-      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes
-                             CALL tra_ldf    ( kstp )       ! lateral mixing
-
-      IF( ln_diaptr      )   CALL dia_ptr                   ! Poleward adv/ldf TRansports diagnostics
-
-#if defined key_agrif
-      IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge
-#endif
-                             CALL tra_zdf    ( kstp )       ! vertical mixing and after tracer fields
-
-      IF( ln_dynhpg_imp  ) THEN                             ! semi-implicit hpg (time stepping then eos)
-         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)                                &
-               &             CALL zps_hde    ( kstp, jpts, tsa, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
-               &                                           rhd, gru , grv    )  ! of t, s, rd at the last ocean level
-            IF( ln_zps .AND.       ln_isfcav)                                &
-               &             CALL zps_hde_isf( kstp, jpts, tsa, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
-               &                                           rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
-               &                                    gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
-      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)                                   &
-               &             CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
-               &                                           rhd, gru , grv    )  ! of t, s, rd at the last ocean level
-         IF( ln_zps .AND.       ln_isfcav)                                   & 
-               &             CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
-               &                                           rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
-               &                                    gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
-         ENDIF
-         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection
-                             CALL tra_nxt( kstp )                ! tracer fields at next time step
-      ENDIF
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Dynamics                                    (tsa used as workspace)
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( lk_dynspg_ts   )  THEN
-                                                             ! revert to previously computed momentum tendencies
-                                                             ! (not using ua, va as temporary arrays during tracers' update could avoid that)
-                               ua(:,:,:) = ua_sv(:,:,:)
-                               va(:,:,:) = va_sv(:,:,:)
-                                                             ! Revert now divergence and rotational to previously computed ones 
-                                                             !(needed because of the time swap in div_cur, at the beginning of each time step)
-                               hdivn(:,:,:) = hdivb(:,:,:)
-                               rotn(:,:,:)  = rotb(:,:,:) 
-
-                               CALL dyn_bfr( kstp )         ! bottom friction
-                               CALL dyn_zdf( kstp )         ! vertical diffusion
-      ELSE
-                               ua(:,:,:) = 0.e0             ! set dynamics trends to zero
-                               va(:,:,:) = 0.e0
-
-        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
-                               CALL dyn_adv( kstp )         ! advection (vector or flux form)
-                               CALL dyn_vor( kstp )         ! vorticity term including Coriolis
-                               CALL dyn_ldf( kstp )         ! lateral mixing
-        IF( ln_neptsimp )      CALL dyn_nept_cor( kstp )    ! add Neptune velocities (simplified)
-#if defined key_agrif
-        IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_dyn        ! momemtum sponge
-#endif
-                               CALL dyn_hpg( kstp )         ! horizontal gradient of Hydrostatic pressure
-                               CALL dyn_bfr( kstp )         ! bottom friction
-                               CALL dyn_zdf( kstp )         ! vertical diffusion
-                               CALL dyn_spg( kstp, indic )  ! surface pressure gradient
-      ENDIF
-                               CALL dyn_nxt( kstp )         ! lateral velocity at next time step
-
-                               CALL ssh_swp( kstp )         ! swap of sea surface height
-      IF( lk_vvl           )   CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors
-
-      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 and restarts
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                               CALL stp_ctl( kstp, indic )
-      IF( indic < 0        )   THEN
-                               CALL ctl_stop( 'step: indic < 0' )
-                               CALL dia_wri_state( 'output.abort', kstp )
-      ENDIF
-      IF( kstp == nit000   )   THEN
+                         CALL trc_stp       ( kstp )  ! time-stepping
+#endif
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Active tracers                              
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         tsa(:,:,:,:) = 0._wp         ! set tracer trends to zero
+
+      IF(  lk_asminc .AND. 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_trabbc  )   CALL tra_bbc       ( kstp )  ! bottom heat flux
+      IF( lk_trabbl  )   CALL tra_bbl       ( kstp )  ! advective (and/or diffusive) bottom boundary layer scheme
+      IF( ln_tradmp  )   CALL tra_dmp       ( kstp )  ! internal damping trends
+      IF( lk_bdy     )   CALL bdy_tra_dmp   ( kstp )  ! bdy damping trends
+#if defined key_agrif
+      IF(.NOT. Agrif_Root())  & 
+               &         CALL Agrif_Sponge_tra        ! tracers sponge
+#endif
+                         CALL tra_adv       ( kstp )  ! horizontal & vertical advection
+                         CALL tra_ldf       ( kstp )  ! lateral mixing
+
+!!gm : why CALL to dia_ptr has been moved here??? (use trends info?)
+      IF( ln_diaptr  )   CALL dia_ptr                 ! Poleward adv/ldf TRansports diagnostics
+!!gm
+                         CALL tra_zdf       ( kstp )  ! vertical mixing and after tracer fields
+      IF( ln_zdfnpc  )   CALL tra_npc       ( kstp )  ! update after fields by non-penetrative convection
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Set boundary conditions and Swap
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+!!jc1: For agrif, it would be much better to finalize tracers/momentum here (e.g. bdy conditions) and move the swap 
+!!    (and time filtering) after Agrif update. Then restart would be done after and would contain updated fields. 
+!!    If so: 
+!!    (i) no need to call agrif update at initialization time
+!!    (ii) no need to update "before" fields 
+!!
+!!    Apart from creating new tra_swp/dyn_swp routines, this however: 
+!!    (i) makes boundary conditions at initialization time computed from updated fields which is not the case between 
+!!    two restarts => restartability issue. One can circumvent this, maybe, by assuming "interface separation", 
+!!    e.g. a shift of the feedback interface inside child domain. 
+!!    (ii) requires that all restart outputs of updated variables by agrif (e.g. passive tracers/tke/barotropic arrays) are done at the same
+!!    place.
+!! 
+!!jc2: dynnxt must be the latest call. e3t_b are indeed updated in that routine
+                         CALL tra_nxt       ( kstp )  ! finalize (bcs) tracer fields at next time step and swap
+                         CALL dyn_nxt       ( kstp )  ! finalize (bcs) velocities at next time step and swap
+                         CALL ssh_swp       ( kstp )  ! swap of sea surface height
+      IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors
+      !
+
+!!gm : This does not only concern the dynamics ==>>> add a new title
+!!gm2: why ouput restart before AGRIF update?
+!!
+!!jc: That would be better, but see comment above
+!!
+      IF( lrst_oce   )   CALL rst_write     ( kstp )  ! write output ocean restart file
+
+#if defined key_agrif
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! AGRIF
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
+                         CALL Agrif_Integrate_ChildGrids( stp )  
+
+      IF( Agrif_NbStepint() == 0 ) THEN               ! AGRIF Update 
+!!jc in fact update is useless at last time step, but do it for global diagnostics
+                         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( ln_diaobs  )   CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Control
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL stp_ctl       ( kstp, indic )
+      IF( indic < 0  ) THEN
+                         CALL ctl_stop( 'step: indic < 0' )
+                         CALL dia_wri_state( 'output.abort', kstp )
+      ENDIF
+      IF( kstp == nit000 ) THEN
                  CALL iom_close( numror )     ! close input  ocean restart file
          IF(lwm) CALL FLUSH    ( numond )     ! flush output namelist oce
-         IF( lwm.AND.numoni /= -1 ) CALL FLUSH    ( numoni )     ! flush output namelist ice
-      ENDIF
-      IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file
+         IF(lwm.AND.numoni /= -1 )   &
+            &    CALL FLUSH    ( numoni )     ! flush output namelist ice (if exist)
+      ENDIF
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Coupled mode
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( lk_oasis         )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges
+!!gm why lk_oasis and not lk_cpl ????
+      IF( lk_oasis   )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges
       !
 #if defined key_iomput
@@ -369,5 +353,4 @@
       !
    END SUBROUTINE stp
-
-   !!======================================================================
+   
 END MODULE step
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 6808)
@@ -4,28 +4,19 @@
    !! Ocean time-stepping : module used in both initialisation phase and time stepping
    !!======================================================================
-   !! History :   3.3  ! 2010-08  (C. Ethe)  Original code - reorganisation of the initial phase
+   !! History :   3.3  !  2010-08  (C. Ethe)  Original code - reorganisation of the initial phase
+   !!             3.7  !  2014-01  (G. Madec) LDF simplication 
    !!----------------------------------------------------------------------
    USE oce              ! ocean dynamics and tracers variables
    USE dom_oce          ! ocean space and time domain variables
    USE zdf_oce          ! ocean vertical physics variables
-   USE ldftra_oce       ! ocean tracer   - trends
-   USE ldfdyn_oce       ! ocean dynamics - trends
-   USE divcur           ! hor. divergence and curl      (div & cur routines)
-   USE in_out_manager   ! I/O manager
-   USE iom              !
-   USE lbclnk
-   USE restart          ! restart
-#if defined key_iomput
-   USE xios
-#endif
 
    USE daymod           ! calendar                         (day     routine)
 
+   USE sbc_oce          ! surface boundary condition: ocean
    USE sbcmod           ! surface boundary condition       (sbc     routine)
    USE sbcrnf           ! surface boundary condition: runoff variables
    USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step)
-   USE sbc_oce          ! surface boundary condition: ocean
+   USE sbcapr           ! surface boundary condition: atmospheric pressure
    USE sbctide          ! Tide initialisation
-   USE sbcapr           ! surface boundary condition: ssh_ib required by bdydta 
 
    USE traqsr           ! solar radiation penetration      (tra_qsr routine)
@@ -36,5 +27,4 @@
    USE traadv           ! advection scheme control     (tra_adv_ctl routine)
    USE traldf           ! lateral mixing                   (tra_ldf routine)
-   !   zdfkpp           ! KPP non-local tracer fluxes      (tra_kpp routine)
    USE trazdf           ! vertical mixing                  (tra_zdf routine)
    USE tranxt           ! time-stepping                    (tra_nxt routine)
@@ -43,4 +33,5 @@
    USE eosbn2           ! equation of state                (eos_bn2 routine)
 
+   USE divhor           ! horizontal divergence            (div_hor routine)
    USE dynadv           ! advection                        (dyn_adv routine)
    USE dynbfr           ! Bottom friction terms            (dyn_bfr routine)
@@ -49,7 +40,5 @@
    USE dynldf           ! lateral momentum diffusion       (dyn_ldf routine)
    USE dynzdf           ! vertical diffusion               (dyn_zdf routine)
-   USE dynspg_oce       ! surface pressure gradient        (dyn_spg routine)
    USE dynspg           ! surface pressure gradient        (dyn_spg routine)
-   USE dynnept          ! simp. form of Neptune effect(dyn_nept_cor routine)
 
    USE dynnxt           ! time-stepping                    (dyn_nxt routine)
@@ -71,7 +60,6 @@
 
    USE ldfslp           ! iso-neutral slopes               (ldf_slp routine)
-   USE ldfeiv           ! eddy induced velocity coef.      (ldf_eiv routine)
-   USE ldftra_smag      ! Smagirinsky diffusion            (ldftra_smag routine)
-   USE ldfdyn_smag      ! Smagorinsky viscosity            (ldfdyn_smag routine) 
+   USE ldfdyn           ! lateral eddy viscosity coef.     (ldf_dyn routine)
+   USE ldftra           ! lateral eddy diffusive coef.     (ldf_tra routine)
 
    USE zdftmx           ! tide-induced vertical mixing     (zdf_tmx routine)
@@ -79,5 +67,4 @@
    USE zdftke           ! TKE vertical mixing              (zdf_tke routine)
    USE zdfgls           ! GLS vertical mixing              (zdf_gls routine)
-   USE zdfkpp           ! KPP vertical mixing              (zdf_kpp routine)
    USE zdfddm           ! double diffusion mixing          (zdf_ddm routine)
    USE zdfevd           ! enhanced vertical diffusion      (zdf_evd routine)
@@ -85,4 +72,9 @@
    USE zdfmxl           ! Mixed-layer depth                (zdf_mxl routine)
 
+   USE step_diu        ! Time stepping for diurnal sst
+   USE diurnal_bulk    ! diurnal SST bulk routines  (diurnal_sst_takaya routine) 
+   USE cool_skin       ! diurnal cool skin correction (diurnal_sst_coolskin routine)   
+   USE sbc_oce         ! surface fluxes  
+   
    USE zpshde           ! partial step: hor. derivative     (zps_hde routine)
 
@@ -95,4 +87,5 @@
    USE diahsb           ! heat, salt and volume budgets    (dia_hsb routine)
    USE diaharm
+   USE diacfl
    USE flo_oce          ! floats variables
    USE floats           ! floats computation               (flo_stp routine)
@@ -104,12 +97,20 @@
    USE asmbkg
    USE stpctl           ! time stepping control            (stp_ctl routine)
+   USE restart          ! ocean restart                    (rst_wri routine)
    USE prtctl           ! Print control                    (prt_ctl routine)
 
    USE diaobs           ! Observation operator
 
+   USE in_out_manager   ! I/O manager
+   USE iom              !
+   USE lbclnk
    USE timing           ! Timing
 
+#if defined key_iomput
+   USE xios
+#endif
 #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
@@ -117,5 +118,5 @@
 #endif
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 6808)
@@ -16,10 +16,9 @@
    USE oce             ! ocean dynamics and tracers variables
    USE dom_oce         ! ocean space and time domain variables 
-   USE sol_oce         ! ocean space and time domain variables 
+   USE c1d             ! 1D vertical configuration
+   !
    USE in_out_manager  ! I/O manager
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp         ! distributed memory computing
-   USE dynspg_oce      ! pressure gradient schemes 
-   USE c1d             ! 1D vertical configuration
 
    IMPLICIT NONE
@@ -32,5 +31,4 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -43,20 +41,19 @@
       !! ** Method  : - Save the time step in numstp
       !!              - Print it each 50 time steps
-      !!              - Print solver statistics in numsol 
-      !!              - Stop the run IF problem for the solver ( indec < 0 )
+      !!              - Stop the run IF problem ( indic < 0 )
       !!
       !! ** Actions :   'time.step' file containing the last ocean time-step
       !!                
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
-      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
+      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER, INTENT(inout) ::   kindic   ! error indicator
       !!
-      INTEGER  ::   ji, jj, jk              ! dummy loop indices
-      INTEGER  ::   ii, ij, ik              ! temporary integers
-      REAL(wp) ::   zumax, zsmin, zssh2     ! temporary scalars
-      INTEGER, DIMENSION(3) ::   ilocu      ! 
-      INTEGER, DIMENSION(2) ::   ilocs      ! 
+      INTEGER  ::   ji, jj, jk             ! dummy loop indices
+      INTEGER  ::   ii, ij, ik             ! local integers
+      REAL(wp) ::   zumax, zsmin, zssh2    ! local scalars
+      INTEGER, DIMENSION(3) ::   ilocu     ! 
+      INTEGER, DIMENSION(2) ::   ilocs     ! 
       !!----------------------------------------------------------------------
-
+      !
       IF( kt == nit000 .AND. lwp ) THEN
          WRITE(numout,*)
@@ -66,8 +63,8 @@
          CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
       ENDIF
-
+      !
       IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
       IF(lwp) REWIND( numstp )                       !  --------------------------
-
+      !
       !                                              !* Test maximum of velocity (zonal only)
       !                                              !  ------------------------
@@ -105,9 +102,9 @@
       ENDIF
 9400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
-
+      !
       !                                              !* Test minimum of salinity
       !                                              !  ------------------------
       !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
-      zsmin = 100.e0
+      zsmin = 100._wp
       DO jj = 2, jpjm1
          DO ji = 1, jpi
@@ -139,37 +136,19 @@
       ENDIF
 9500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
-
-      
+      !
+      !
       IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
 
-      ! log file (solver or ssh statistics)
-      ! --------
-      IF( lk_dynspg_flt ) THEN      ! elliptic solver statistics (if required)
-         !
-         IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps       ! Solver
-         !
-         IF( kindic < 0 .AND. zsmin > 0.e0 .AND. zumax <= 20.e0 ) THEN   ! create a abort file if problem found 
-            IF(lwp) THEN
-               WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode'
-               WRITE(numout,*) ' ====== '
-               WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps
-               WRITE(numout,*)
-               WRITE(numout,*) ' stpctl: output of last fields'
-               WRITE(numout,*) ' ======  '
-            ENDIF
-         ENDIF
-         !
-      ELSE                                   !* ssh statistics (and others...)
-         IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
-            CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-         ENDIF
-         !
-         zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) )
-         IF( lk_mpp )   CALL mpp_sum( zssh2 )      ! sum over the global domain
-         !
-         IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin      ! ssh statistics
-         !
+      ! log file (ssh statistics)
+      ! --------                                   !* ssh statistics (and others...)
+      IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
+         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
       ENDIF
-
+      !
+      zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_sum( zssh2 )      ! sum over the global domain
+      !
+      IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin      ! ssh statistics
+      !
 9200  FORMAT('it:', i8, ' iter:', i4, ' r: ',e16.10, ' b: ',e16.10 )
 9300  FORMAT(' it :', i8, ' ssh2: ', e16.10, ' Umax: ',e16.10,' Smin: ',e16.10)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 6808)
@@ -8,10 +8,11 @@
 
    !!----------------------------------------------------------------------
-   !!   trc_oce_rgb : tabulated attenuation coefficients for RGB light penetration         
-   !!----------------------------------------------------------------------
-   USE par_oce
-   USE in_out_manager  ! I/O manager
-   USE dom_oce         ! ocean space and time domain
-   USE lib_mpp         ! MPP library
+   !!   trc_oce_rgb   : tabulated attenuation coefficients for RGB light penetration         
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE dom_oce        ! ocean space and time domain
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
 
    IMPLICIT NONE
@@ -41,5 +42,4 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .FALSE.   !: bio-model light absorption flag
 #endif
-
 #if defined key_offline
    !!----------------------------------------------------------------------
@@ -64,7 +64,4 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_degrad = .FALSE.   !: degradation flag
 #endif
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -104,5 +101,5 @@
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient
-      !!
+      !
       INTEGER  ::   jc     ! dummy loop indice
       INTEGER  ::   irgb   ! temporary integer
@@ -188,5 +185,5 @@
          zchl = zrgb(1,jc)
          irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )
-         IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb
+         IF(lwp .AND. nn_print >= 1 ) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb
          IF( irgb /= jc ) THEN
             IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb
@@ -210,5 +207,5 @@
       !!----------------------------------------------------------------------
       REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient
-      !!
+      !
       INTEGER  ::   jc, jb ! dummy loop indice
       INTEGER  ::   irgb   ! temporary integer
@@ -262,5 +259,5 @@
       REAL(wp), INTENT(in) ::   prldex    ! longest depth of extinction
       REAL(wp), INTENT(in) ::   pqsr_frc  ! frac. solar radiation which penetrates 
-      !!
+      !
       INTEGER  ::   jk, pjl            ! levels
       REAL(wp) ::   zhext              ! deepest level till which light penetrates
@@ -276,5 +273,5 @@
       DO jk = jpkm1, 1, -1
          IF(SUM(tmask(:,:,jk)) > 0 ) THEN
-            zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) )
+            zem = MAXVAL( gdepw_0(:,:,jk+1) * tmask(:,:,jk) )
             IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr
          ELSE
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90	(revision 6808)
@@ -0,0 +1,647 @@
+MODULE nemogcm
+   !!======================================================================
+   !!                       ***  MODULE nemogcm   ***
+   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
+   !!======================================================================
+   !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code
+   !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec)
+   !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
+   !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1
+   !!             -   ! 1992-06  (L.Terray)  coupling implementation
+   !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice
+   !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
+   !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0
+   !!            8.1  ! 1997-06  (M. Imbard, G. Madec)
+   !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model
+   !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP
+   !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules
+   !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
+   !!             -   ! 2004-08  (C. Talandier) New trends organization
+   !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility
+   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation
+   !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization
+   !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)
+   !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp
+   !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
+   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
+   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.4  ! 2011-11  (C. Harris) decomposition changes for running with CICE
+   !!                 ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   nemo_gcm       : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
+   !!   nemo_init      : initialization of the NEMO system
+   !!   nemo_ctl       : initialisation of the contol print
+   !!   nemo_closefile : close remaining open files
+   !!   nemo_alloc     : dynamical allocation
+   !!   nemo_partition : calculate MPP domain decomposition
+   !!   factorise      : calculate the factors of the no. of MPI processes
+   !!----------------------------------------------------------------------
+   USE step_oce        ! module used in the ocean time stepping module
+   USE domcfg          ! domain configuration               (dom_cfg routine)
+   USE mppini          ! shared/distributed memory setting (mpp_init routine)
+   USE domain          ! domain initialization             (dom_init routine)
+#if defined key_nemocice_decomp
+   USE ice_domain_size, only: nx_global, ny_global
+#endif
+   USE istate          ! initial state setting          (istate_init routine)
+   USE phycst          ! physical constant                  (par_cst routine)
+   USE diaobs          ! Observation diagnostics       (dia_obs_init routine)
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE step            ! NEMO time-stepping                 (stp     routine)
+   USE cpl_oasis3      ! OASIS3 coupling
+   USE lib_mpp         ! distributed memory computing
+#if defined key_iomput
+   USE xios
+#endif
+   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
+
+   ! Stand Alone Observation operator modules
+   USE sao_data
+   USE sao_intp
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   nemo_gcm    ! called by model.F90
+   PUBLIC   nemo_init   ! needed by AGRIF
+   PUBLIC   nemo_alloc  ! needed by TAM
+
+   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE nemo_gcm
+         !!----------------------------------------------------------------------
+         !!                    ***  SUBROUTINE offline_obs_oper ***
+         !!
+         !! ** Purpose : To use NEMO components to interpolate model fields
+         !!              to observation space.
+         !!
+         !! ** Method : 1. Initialise NEMO
+         !!             2. Initialise offline obs_oper
+         !!             3. Cycle through match ups
+         !!             4. Write results to file
+         !!
+         !!----------------------------------------------------------------------
+         !! Initialise NEMO
+         CALL nemo_init
+         !! Initialise Stand Alone Observation operator data
+         CALL sao_data_init
+         !! Initialise obs_oper
+         CALL dia_obs_init
+         !! Interpolate to observation space
+         CALL sao_interp
+         !! Pipe to output files
+         CALL dia_obs_wri
+         !! Reset the obs_oper between
+         CALL dia_obs_dealloc
+         !! Safely stop MPI
+         IF(lk_mpp) CALL mppstop  ! end mpp communications
+   END SUBROUTINE nemo_gcm
+
+
+   SUBROUTINE nemo_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_init  ***
+      !!
+      !! ** Purpose :   initialization of the NEMO GCM
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji            ! dummy loop indices
+      INTEGER ::   ilocal_comm   ! local integer
+      INTEGER ::   ios
+      CHARACTER(len=80), DIMENSION(16) ::   cltxt
+      !
+      NAMELIST/namctl/ ln_ctl, nn_print, nn_ictls, nn_ictle,   &
+         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
+         &             nn_bench, nn_timing
+      NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
+         &             jpizoom, jpjzoom, jperio, ln_use_jattr
+      !!----------------------------------------------------------------------
+      !
+      cltxt = ''
+      cxios_context = 'nemo'
+      !
+      !                             ! Open reference namelist and configuration namelist files
+      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark
+      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
+
+      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark
+      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
+
+      !
+      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints & Benchmark
+      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
+
+      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark
+      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
+
+! Force values for AGRIF zoom (cf. agrif_user.F90)
+#if defined key_agrif
+   IF( .NOT. Agrif_Root() ) THEN
+      jpiglo  = nbcellsx + 2 + 2*nbghostcells
+      jpjglo  = nbcellsy + 2 + 2*nbghostcells
+      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
+      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
+      jpidta  = jpiglo
+      jpjdta  = jpjglo
+      jpizoom = 1
+      jpjzoom = 1
+      nperio  = 0
+      jperio  = 0
+      ln_use_jattr = .false.
+   ENDIF
+#endif
+      !
+      !                             !--------------------------------------------!
+      !                             !  set communicator & select the local node  !
+      !                             !  NB: mynode also opens output.namelist.dyn !
+      !                             !      on unit number numond on first proc   !
+      !                             !--------------------------------------------!
+#if defined key_iomput
+      IF( Agrif_Root() ) THEN
+         IF( lk_oasis ) THEN
+            CALL cpl_init( "oceanx", ilocal_comm )                     ! nemo local communicator given by oasis
+            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios
+         ELSE
+            CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios
+         ENDIF
+      ENDIF
+      ! Nodes selection (control print return in cltxt)
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
+#else
+      IF( lk_oasis ) THEN
+         IF( Agrif_Root() ) THEN
+            CALL cpl_init( "oceanx", ilocal_comm )                      ! nemo local communicator given by oasis
+         ENDIF
+         ! Nodes selection (control print return in cltxt)
+         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
+      ELSE
+         ilocal_comm = 0
+         ! Nodes selection (control print return in cltxt)
+         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )
+      ENDIF
+#endif
+      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
+
+      lwm = (narea == 1)                                    ! control of output namelists
+      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
+
+      IF(lwm) THEN
+         ! write merged namelists from earlier to output namelist now that the
+         ! file has been opened in call to mynode. nammpp has already been
+         ! written in mynode (if lk_mpp_mpi)
+         WRITE( numond, namctl )
+         WRITE( numond, namcfg )
+      ENDIF
+
+      ! If dimensions of processor grid weren't specified in the namelist file
+      ! then we calculate them here now that we have our communicator size
+      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
+#if   defined key_mpp_mpi
+         IF( Agrif_Root() ) CALL nemo_partition(mppsize)
+#else
+         jpni  = 1
+         jpnj  = 1
+         jpnij = jpni*jpnj
+#endif
+      END IF
+
+      ! Calculate domain dimensions given calculated jpni and jpnj
+      ! This used to be done in par_oce.F90 when they were parameters rather
+      ! than variables
+      IF( Agrif_Root() ) THEN
+#if defined key_nemocice_decomp
+         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim.
+         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 
+#else
+         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim.
+         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
+#endif
+      ENDIF
+         jpk = jpkdta                                             ! third dim
+         jpim1 = jpi-1                                            ! inner domain indices
+         jpjm1 = jpj-1                                            !   "           "
+         jpkm1 = jpk-1                                            !   "           "
+         jpij  = jpi*jpj                                          !  jpi x j
+
+      IF(lwp) THEN                            ! open listing units
+         !
+         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         !
+         WRITE(numout,*)
+         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
+         WRITE(numout,*) '                       NEMO team'
+         WRITE(numout,*) '            Stand Alone Observation operator'
+         WRITE(numout,*) '                  version 1.0  (2015) '
+         WRITE(numout,*)
+         WRITE(numout,*)
+         DO ji = 1, SIZE(cltxt)
+            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode
+         END DO
+         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA
+         !
+      ENDIF
+
+      ! Now we know the dimensions of the grid and numout has been set we can
+      ! allocate arrays
+      CALL nemo_alloc()
+
+      !                             !-------------------------------!
+      !                             !  NEMO general initialization  !
+      !                             !-------------------------------!
+
+      CALL nemo_ctl                          ! Control prints & Benchmark
+
+      !                                      ! Domain decomposition
+      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out
+      ELSE                            ;   CALL mpp_init2     ! eliminate land processors
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_init
+      !
+      !                                      ! General initialization
+                            CALL     phy_cst    ! Physical constants
+                            CALL     eos_init   ! Equation of state
+                            CALL     dom_cfg    ! Domain configuration
+                            CALL     dom_init   ! Domain
+
+      IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined)
+
+      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
+
+                            CALL  istate_init   ! ocean initial state (Dynamics and tracers)
+   END SUBROUTINE nemo_init
+
+
+   SUBROUTINE nemo_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_ctl  ***
+      !!
+      !! ** Purpose :   control print setting
+      !!
+      !! ** Method  : - print namctl information and check some consistencies
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namctl'
+         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
+         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
+         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
+         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
+         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
+         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
+         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
+         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
+         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench
+         WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing
+      ENDIF
+      !
+      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
+      nictls    = nn_ictls
+      nictle    = nn_ictle
+      njctls    = nn_jctls
+      njctle    = nn_jctle
+      isplt     = nn_isplt
+      jsplt     = nn_jsplt
+      nbench    = nn_bench
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'namcfg  : configuration initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namcfg'
+         WRITE(numout,*) '      configuration name              cp_cfg      = ', TRIM(cp_cfg)
+         WRITE(numout,*) '      configuration zoom name         cp_cfz      = ', TRIM(cp_cfz)
+         WRITE(numout,*) '      configuration resolution        jp_cfg      = ', jp_cfg
+         WRITE(numout,*) '      1st lateral dimension ( >= jpi ) jpidta     = ', jpidta
+         WRITE(numout,*) '      2nd    "         "    ( >= jpj ) jpjdta     = ', jpjdta
+         WRITE(numout,*) '      3nd    "         "               jpkdta     = ', jpkdta
+         WRITE(numout,*) '      1st dimension of global domain in i jpiglo  = ', jpiglo
+         WRITE(numout,*) '      2nd    -                  -    in j jpjglo  = ', jpjglo
+         WRITE(numout,*) '      left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom
+         WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
+         WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio   
+         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
+      ENDIF
+      !                             ! Parameter control
+      !
+      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+         IF( lk_mpp .AND. jpnij > 1 ) THEN
+            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
+         ELSE
+            IF( isplt == 1 .AND. jsplt == 1  ) THEN
+               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
+                  &           ' - the print control will be done over the whole domain' )
+            ENDIF
+            ijsplt = isplt * jsplt            ! total number of processors ijsplt
+         ENDIF
+         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
+         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
+         !
+         !                              ! indices used for the SUM control
+         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
+            lsp_area = .FALSE.
+         ELSE                                             ! print control done over a specific  area
+            lsp_area = .TRUE.
+            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
+               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
+               nictls = 1
+            ENDIF
+            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
+               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
+               nictle = jpiglo
+            ENDIF
+            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
+               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
+               njctls = 1
+            ENDIF
+            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
+               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
+               njctle = jpjglo
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( nbench == 1 ) THEN              ! Benchmark
+         SELECT CASE ( cp_cfg )
+         CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' )
+         CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   &
+            &                                 ' cp_cfg = "gyre" in namelist &namcfg or set nbench = 0' )
+         END SELECT
+      ENDIF
+      !
+      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
+         &                                               'f2003 standard. '                              ,  &
+         &                                               'Compile with key_nosignedzero enabled' )
+      !
+   END SUBROUTINE nemo_ctl
+
+
+   SUBROUTINE nemo_closefile
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_closefile  ***
+      !!
+      !! ** Purpose :   Close the files
+      !!----------------------------------------------------------------------
+      !
+      IF( lk_mpp )   CALL mppsync
+      !
+      CALL iom_close                                 ! close all input/output files managed by iom_*
+      !
+      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
+      IF( numsol          /= -1 )   CLOSE( numsol          )   ! solver file
+      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
+      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
+      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
+      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
+      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
+      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
+      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
+      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
+      IF( numdct_vol      /= -1 )   CLOSE( numdct_vol      )   ! volume transports
+      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
+      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
+
+      !
+      numout = 6                                     ! redefine numout in case it is used after this point...
+      !
+   END SUBROUTINE nemo_closefile
+
+
+   SUBROUTINE nemo_alloc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_alloc  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      USE diawri    , ONLY: dia_wri_alloc
+      USE dom_oce   , ONLY: dom_oce_alloc
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr =        oce_alloc       ()          ! ocean
+      ierr = ierr + dia_wri_alloc   ()
+      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
+      !
+   END SUBROUTINE nemo_alloc
+
+
+   SUBROUTINE nemo_partition( num_pes )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE nemo_partition  ***
+      !!
+      !! ** Purpose :
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have
+      !
+      INTEGER, PARAMETER :: nfactmax = 20
+      INTEGER :: nfact ! The no. of factors returned
+      INTEGER :: ierr  ! Error flag
+      INTEGER :: ji
+      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
+      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
+      !!----------------------------------------------------------------------
+      !
+      ierr = 0
+      !
+      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
+      !
+      IF( nfact <= 1 ) THEN
+         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
+         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
+         jpnj = 1
+         jpni = num_pes
+      ELSE
+         ! Search through factors for the pair that are closest in value
+         mindiff = 1000000
+         imin    = 1
+         DO ji = 1, nfact-1, 2
+            idiff = ABS( ifact(ji) - ifact(ji+1) )
+            IF( idiff < mindiff ) THEN
+               mindiff = idiff
+               imin = ji
+            ENDIF
+         END DO
+         jpnj = ifact(imin)
+         jpni = ifact(imin + 1)
+      ENDIF
+      !
+      jpnij = jpni*jpnj
+      !
+   END SUBROUTINE nemo_partition
+
+
+   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE factorise  ***
+      !!
+      !! ** Purpose :   return the prime factors of n.
+      !!                knfax factors are returned in array kfax which is of
+      !!                maximum dimension kmaxfax.
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
+      INTEGER                    , INTENT(  out) ::   kerr, knfax
+      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
+      !
+      INTEGER :: ifac, jl, inu
+      INTEGER, PARAMETER :: ntest = 14
+      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
+      kerr = 0
+      kfax = 1
+      knfax = 0
+
+      ! Find the factors of n.
+      IF( kn == 1 )   GOTO 20
+
+      ! nu holds the unfactorised part of the number.
+      ! knfax holds the number of factors found.
+      ! l points to the allowed factor list.
+      ! ifac holds the current factor.
+
+      inu   = kn
+      knfax = 0
+
+      DO jl = ntest, 1, -1
+         !
+         ifac = ilfax(jl)
+         IF( ifac > inu )   CYCLE
+
+         ! Test whether the factor will divide.
+
+         IF( MOD(inu,ifac) == 0 ) THEN
+            !
+            knfax = knfax + 1            ! Add the factor to the list
+            IF( knfax > kmaxfax ) THEN
+               kerr = 6
+               write (*,*) 'FACTOR: insufficient space in factor array ', knfax
+               return
+            ENDIF
+            kfax(knfax) = ifac
+            ! Store the other factor that goes with this one
+            knfax = knfax + 1
+            kfax(knfax) = inu / ifac
+            !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
+         ENDIF
+         !
+      END DO
+
+   20 CONTINUE      ! Label 20 is the exit point from the factor search loop.
+      !
+   END SUBROUTINE factorise
+
+#if defined key_mpp_mpi
+
+   SUBROUTINE nemo_northcomms
+      !!======================================================================
+      !!                     ***  ROUTINE  nemo_northcomms  ***
+      !! nemo_northcomms    :  Setup for north fold exchanges with explicit 
+      !!                       point-to-point messaging
+      !!=====================================================================
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
+      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
+      !!----------------------------------------------------------------------
+
+      INTEGER  ::   sxM, dxM, sxT, dxT, jn
+      INTEGER  ::   njmppmax
+
+      njmppmax = MAXVAL( njmppt )
+    
+      !initializes the north-fold communication variables
+      isendto(:) = 0
+      nsndto = 0
+
+      !if I am a process in the north
+      IF ( njmpp == njmppmax ) THEN
+          !sxM is the first point (in the global domain) needed to compute the
+          !north-fold for the current process
+          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
+          !dxM is the last point (in the global domain) needed to compute the
+          !north-fold for the current process
+          dxM = jpiglo - nimppt(narea) + 2
+
+          !loop over the other north-fold processes to find the processes
+          !managing the points belonging to the sxT-dxT range
+  
+          DO jn = 1, jpni
+                !sxT is the first point (in the global domain) of the jn
+                !process
+                sxT = nfiimpp(jn, jpnj)
+                !dxT is the last point (in the global domain) of the jn
+                !process
+                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
+                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
+                   nsndto = nsndto + 1
+                     isendto(nsndto) = jn
+                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
+                   nsndto = nsndto + 1
+                     isendto(nsndto) = jn
+                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
+                   nsndto = nsndto + 1
+                     isendto(nsndto) = jn
+                END IF
+          END DO
+          nfsloop = 1
+          nfeloop = nlci
+          DO jn = 2,jpni-1
+           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
+              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
+                 nfsloop = nldi
+              ENDIF
+              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
+                 nfeloop = nlei
+              ENDIF
+           ENDIF
+        END DO
+
+      ENDIF
+      l_north_nogather = .TRUE.
+   END SUBROUTINE nemo_northcomms
+#else
+   SUBROUTINE nemo_northcomms      ! Dummy routine
+      WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?'
+   END SUBROUTINE nemo_northcomms
+#endif
+
+   !!======================================================================
+END MODULE nemogcm
+
+
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/obs_fbm.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/obs_fbm.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/obs_fbm.F90	(revision 6808)
@@ -0,0 +1,1 @@
+link ../OPA_SRC/OBS/obs_fbm.F90
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/sao.nml
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/sao.nml	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/sao.nml	(revision 6808)
@@ -0,0 +1,10 @@
+!----------------------------------------------------------------------
+!       namsao Stand Alone Observation operator namelist
+!----------------------------------------------------------------------
+!   sao_files     specifies the files containing the model counterpart
+!   nn_sao_idx    specifies the index within the model file
+!   nn_sao_freq   specifies the number of timesteps between file reads
+&namsao
+   sao_files = 'fcst.0.nc'
+   nn_sao_idx = 1
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/sao_data.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/sao_data.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/sao_data.F90	(revision 6808)
@@ -0,0 +1,82 @@
+MODULE sao_data
+   !! =================================================================
+   !!                    *** MODULE sao_data ***
+   !! =================================================================
+   USE par_kind, ONLY: lc
+   USE lib_mpp         ! distributed memory computing
+
+   IMPLICIT NONE
+
+   !! Public data
+
+   INTEGER, PARAMETER :: MaxNumFiles = 1000
+
+   !! Stand Alone Observation operator settings
+   CHARACTER(len=lc) :: &
+      & sao_files(MaxNumFiles)         !: model files
+   INTEGER            :: &
+      & n_files, &                     !: number of files
+      & nn_sao_idx(MaxNumFiles), &     !: time_counter indices
+      & nn_sao_freq                    !: read frequency in time steps
+CONTAINS
+   SUBROUTINE sao_data_init()
+      !!----------------------------------------------------------------------
+      !!                    ***  SUBROUTINE sao_data_init ***
+      !!
+      !! ** Purpose : To read namelists and initialise offline_oper run.
+      !!
+      !!----------------------------------------------------------------------
+      USE in_out_manager
+      INTEGER            :: &
+         & jf                           !: file dummy loop index
+      LOGICAL :: lmask(MaxNumFiles)     !: Logical mask used for counting
+      INTEGER :: ios
+
+      ! Standard offline obs_oper information
+      NAMELIST/namsao/sao_files, nn_sao_idx, nn_sao_freq
+
+      ! Standard offline obs_oper initialisation
+      n_files = 0                   !: number of files to cycle through
+      sao_files(:) = ''             !: list of files to read in
+      nn_sao_idx(:) = 0             !: list of indices inside each file
+      nn_sao_freq = -1              !: input frequency in time steps
+
+      ! Standard offline obs_oper settings
+      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark
+      READ  ( numnam_ref, namsao, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsao in reference namelist', .TRUE. )
+
+      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark
+      READ  ( numnam_cfg, namsao, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsao in configuration namelist', .TRUE. )
+
+
+      ! count input files
+      lmask(:) = .FALSE.
+      WHERE (sao_files(:) /= '') lmask(:) = .TRUE.
+      n_files = COUNT(lmask)
+
+      !! Initialise sub obs window frequency
+      IF (nn_sao_freq == -1) THEN
+         !! Run length
+         nn_sao_freq = nitend - nit000 + 1
+      ENDIF
+
+      !! Print summary of settings
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'offline obs_oper : Initialization'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namsao : set stand alone obs_oper parameters'
+         DO jf = 1, n_files
+            WRITE(numout,'(1X,2A)') '   Input forecast file name          forecastfile = ', &
+               TRIM(sao_files(jf))
+            WRITE(numout,*) '   Input forecast file index        forecastindex = ', &
+               nn_sao_idx(jf)
+         END DO
+      END IF
+
+   END SUBROUTINE sao_data_init
+
+END MODULE sao_data
+
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/sao_intp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/sao_intp.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/sao_intp.F90	(revision 6808)
@@ -0,0 +1,48 @@
+MODULE sao_intp
+   !!======================================================================
+   !!                    ***  MODULE sao_intp ***
+   !! ** Purpose : Run NEMO observation operator in offline mode
+   !!======================================================================
+   !! NEMO modules
+   USE in_out_manager
+   USE diaobs
+   !! Stand Alone Observation operator modules
+   USE sao_read
+   USE sao_data
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC sao_interp
+
+   CONTAINS
+
+      SUBROUTINE sao_interp
+         !!----------------------------------------------------------------------
+         !!                    ***  SUBROUTINE sao_interp ***
+         !!
+         !! ** Purpose : To interpolate the model as if it were running online.
+         !!
+         !! ** Method : 1. Populate model counterparts
+         !!             2. Call dia_obs at appropriate time steps
+         !!----------------------------------------------------------------------
+         INTEGER :: &
+            & istp, & ! time step index
+            & ifile   ! file index
+         istp = nit000 - 1
+         nstop = 0
+         ifile = 1
+         CALL sao_rea_dri(ifile)
+         DO WHILE ( istp <= nitend .AND. nstop == 0 )
+            IF (ifile <= n_files + 1) THEN
+               IF ( MOD(istp, nn_sao_freq) == nit000 ) THEN
+                  CALL sao_rea_dri(ifile)
+                  ifile = ifile + 1
+               ENDIF
+               CALL dia_obs(istp)
+            ENDIF
+            istp = istp + 1
+         END DO
+      END SUBROUTINE sao_interp
+
+END MODULE sao_intp
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/sao_read.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/sao_read.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAO_SRC/sao_read.F90	(revision 6808)
@@ -0,0 +1,172 @@
+MODULE sao_read
+   !!==================================================================
+   !!                    *** MODULE sao_read ***
+   !! Read routines : I/O for Stand Alone Observation operator
+   !!==================================================================
+   USE mppini
+   USE lib_mpp
+   USE in_out_manager
+   USE par_kind, ONLY: lc
+   USE netcdf
+   USE oce,     ONLY: tsn, sshn
+   USE dom_oce, ONLY: nlci, nlcj, nimpp, njmpp, tmask
+   USE par_oce, ONLY: jpi, jpj, jpk
+   USE obs_fbm, ONLY: fbimdi, fbrmdi, fbsp, fbdp
+   USE sao_data
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC sao_rea_dri
+
+CONTAINS
+   SUBROUTINE sao_rea_dri(kfile)
+      !!------------------------------------------------------------------------
+      !!             *** sao_rea_dri ***
+      !!
+      !! Purpose : To choose appropriate read method
+      !! Method  :
+      !!
+      !! Author  : A. Ryan Oct 2013
+      !!
+      !!------------------------------------------------------------------------
+      INTEGER, INTENT(IN) :: &
+              & kfile         !: File number
+      CHARACTER(len=lc) :: &
+              & cdfilename    !: File name
+      INTEGER :: &
+              & kindex        !: File index to read
+
+      cdfilename = TRIM(sao_files(kfile))
+      kindex = nn_sao_idx(kfile)
+      CALL sao_read_file(TRIM(cdfilename), kindex)
+
+   END SUBROUTINE sao_rea_dri
+
+   SUBROUTINE sao_read_file(filename, ifcst)
+      !!------------------------------------------------------------------------
+      !!             *** sao_read_file ***
+      !!
+      !! Purpose : To fill tn and sn with dailymean field from netcdf files
+      !! Method  : Use subdomain indices to create start and count matrices
+      !!           for netcdf read.
+      !!
+      !! Author  : A. Ryan Oct 2010
+      !!------------------------------------------------------------------------
+
+      INTEGER,          INTENT(IN) :: ifcst
+      CHARACTER(len=*), INTENT(IN) :: filename
+      INTEGER                      :: ncid, &
+                                    & varid,&
+                                    & istat,&
+                                    & ntimes,&
+                                    & tdim, &
+                                    & xdim, &
+                                    & ydim, &
+                                    & zdim
+      INTEGER                      :: ii, ij, ik
+      INTEGER, DIMENSION(4)        :: start_n, &
+                                    & count_n
+      INTEGER, DIMENSION(3)        :: start_s, &
+                                    & count_s
+      REAL(fbdp), DIMENSION(:,:,:),ALLOCATABLE :: temp_tn, &
+                                              & temp_sn
+      REAL(fbdp), DIMENSION(:,:),  ALLOCATABLE :: temp_sshn
+      REAL(fbdp)                     :: fill_val
+
+      ! DEBUG
+      INTEGER :: istage
+
+      IF (TRIM(filename) == 'nofile') THEN
+         tsn(:,:,:,:) = fbrmdi
+         sshn(:,:) = fbrmdi
+      ELSE
+         WRITE(numout,*) "Opening :", TRIM(filename)
+         ! Open Netcdf file to find dimension id
+         istat = nf90_open(path=TRIM(filename), mode=nf90_nowrite, ncid=ncid)
+         IF ( istat /= nf90_noerr ) THEN
+             WRITE(numout,*) "WARNING: Could not open ", trim(filename)
+             WRITE(numout,*) "ERROR: ", nf90_strerror(istat)
+         ENDIF
+         istat = nf90_inq_dimid(ncid,'x',xdim)
+         istat = nf90_inq_dimid(ncid,'y',ydim)
+         istat = nf90_inq_dimid(ncid,'deptht',zdim)
+         istat = nf90_inq_dimid(ncid,'time_counter',tdim)
+         istat = nf90_inquire_dimension(ncid, tdim, len=ntimes)
+         IF (ifcst .LE. ntimes) THEN
+            ! Allocate temporary temperature array
+            ALLOCATE(temp_tn(nlci,nlcj,jpk))
+            ALLOCATE(temp_sn(nlci,nlcj,jpk))
+            ALLOCATE(temp_sshn(nlci,nlcj))
+
+            ! Set temp_tn, temp_sn to 0.
+            temp_tn(:,:,:) = fbrmdi
+            temp_sn(:,:,:) = fbrmdi
+            temp_sshn(:,:) = fbrmdi
+
+            ! Create start and count arrays
+            start_n = (/ nimpp, njmpp, 1,   ifcst /)
+            count_n = (/ nlci,  nlcj,  jpk, 1     /)
+            start_s = (/ nimpp, njmpp, ifcst /)
+            count_s = (/ nlci,  nlcj,  1     /)
+
+            ! Read information into temporary arrays
+            ! retrieve varid and read in temperature
+            istat = nf90_inq_varid(ncid,'votemper',varid)
+            istat = nf90_get_att(ncid, varid, '_FillValue', fill_val)
+            istat = nf90_get_var(ncid, varid, temp_tn, start_n, count_n)
+            WHERE(temp_tn(:,:,:) == fill_val) temp_tn(:,:,:) = fbrmdi
+
+            ! retrieve varid and read in salinity
+            istat = nf90_inq_varid(ncid,'vosaline',varid)
+            istat = nf90_get_att(ncid, varid, '_FillValue', fill_val)
+            istat = nf90_get_var(ncid, varid, temp_sn, start_n, count_n)
+            WHERE(temp_sn(:,:,:) == fill_val) temp_sn(:,:,:) = fbrmdi
+
+            ! retrieve varid and read in SSH
+            istat = nf90_inq_varid(ncid,'sossheig',varid)
+            IF (istat /= nf90_noerr) THEN
+               ! Altimeter bias
+               istat = nf90_inq_varid(ncid,'altbias',varid)
+            END IF
+
+            istat = nf90_get_att(ncid, varid, '_FillValue', fill_val)
+            istat = nf90_get_var(ncid, varid, temp_sshn, start_s, count_s)
+            WHERE(temp_sshn(:,:) == fill_val) temp_sshn(:,:) = fbrmdi
+
+            ! Initialise tsn, sshn to fbrmdi
+            tsn(:,:,:,:) = fbrmdi
+            sshn(:,:) = fbrmdi
+
+            ! Mask out missing data index
+            tsn(1:nlci,1:nlcj,1:jpk,1) = temp_tn(:,:,:) * tmask(1:nlci,1:nlcj,1:jpk)
+            tsn(1:nlci,1:nlcj,1:jpk,2) = temp_sn(:,:,:) * tmask(1:nlci,1:nlcj,1:jpk)
+            sshn(1:nlci,1:nlcj)        = temp_sshn(:,:) * tmask(1:nlci,1:nlcj,1)
+
+            ! Remove halo from tmask, tsn, sshn to prevent double obs counting
+            IF (jpi > nlci) THEN
+                tmask(nlci+1:,:,:) = 0
+                tsn(nlci+1:,:,:,1) = 0
+                tsn(nlci+1:,:,:,2) = 0
+                sshn(nlci+1:,:) = 0
+            END IF
+            IF (jpj > nlcj) THEN
+                tmask(:,nlcj+1:,:) = 0
+                tsn(:,nlcj+1:,:,1) = 0
+                tsn(:,nlcj+1:,:,2) = 0
+                sshn(:,nlcj+1:) = 0
+            END IF
+
+            ! Deallocate arrays
+            DEALLOCATE(temp_tn, temp_sn, temp_sshn)
+         ELSE
+            ! Mark all as missing data
+            tsn(:,:,:,:) = fbrmdi
+            sshn(:,:) = fbrmdi
+         ENDIF
+         ! Close netcdf file
+         WRITE(numout,*) "Closing :", TRIM(filename)
+         istat = nf90_close(ncid)
+      END IF
+   END SUBROUTINE sao_read_file
+END MODULE sao_read
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/daymod.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/daymod.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/daymod.F90	(revision 6808)
@@ -20,5 +20,5 @@
    !!
    !!   we suppose that the time step is deviding the number of second of in a day
-   !!             ---> MOD( rday, rdttra(1) ) == 0
+   !!             ---> MOD( rday, rdt ) == 0
    !!
    !!           ----------- WARNING -----------
@@ -71,12 +71,17 @@
       !!----------------------------------------------------------------------
       !
-      ! 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' )
-      IF( MOD( rday     , 2.        ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    )
-      IF( MOD( rdttra(1), 2.        ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           )
-      nsecd   = NINT(rday           )
-      nsecd05 = NINT(0.5 * rday     )
-      ndt     = NINT(      rdttra(1))
-      ndt05   = NINT(0.5 * rdttra(1))
+      ! 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, rdt ) == 0
+      IF( MOD( rday , rdt ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
+      IF( MOD( rday , 2.  ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    )
+      IF( MOD( rdt  , 2.  ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           )
+      nsecd   = NINT(rday         )
+      nsecd05 = NINT(0.5 * rday   )
+      ndt     = NINT(      rdt    )
+      ndt05   = NINT(0.5 * rdt    )
 
       ! ==> clem: here we read the ocean restart for the date (only if it exists)
@@ -219,6 +224,6 @@
       nsec_week  = nsec_week  + ndt
       nsec_day   = nsec_day   + ndt                
-      adatrj  = adatrj  + rdttra(1) / rday
-      fjulday = fjulday + rdttra(1) / rday
+      adatrj  = adatrj  + rdt / rday
+      fjulday = fjulday + rdt / rday
       IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
       IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
@@ -239,9 +244,4 @@
                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
@@ -340,5 +340,5 @@
                ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
                ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
-               adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+               adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
                ! note this is wrong if time step has changed during run
             ENDIF
@@ -346,5 +346,5 @@
             ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
             ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
-            adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+            adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
          ENDIF
          IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/diawri.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/diawri.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/diawri.F90	(revision 6808)
@@ -26,8 +26,4 @@
    USE dom_oce         ! ocean space and time domain
    USE zdf_oce         ! ocean vertical physics
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE ldfdyn_oce      ! ocean dynamics: lateral physics
-   USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv
-   USE sol_oce         ! solver variables
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice fields
@@ -40,5 +36,4 @@
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE in_out_manager  ! I/O manager
-   USE diadimg         ! dimg direct access file format output
    USE diaar5, ONLY :   lk_diaar5
    USE iom
@@ -65,6 +60,4 @@
 
    !! * Substitutions
-#  include "zdfddm_substitute.h90"
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -85,15 +78,8 @@
   END FUNCTION dia_wri_alloc
 
-#if defined key_dimgout
-   !!----------------------------------------------------------------------
-   !!   'key_dimgout'                                      DIMG output file
-   !!----------------------------------------------------------------------
-#   include "diawri_dimg.h90"
-
-#else
    !!----------------------------------------------------------------------
    !!   Default option                                   NetCDF output file
    !!----------------------------------------------------------------------
-# if defined key_iomput
+#if defined key_iomput
    !!----------------------------------------------------------------------
    !!   'key_iomput'                                        use IOM library
@@ -110,6 +96,5 @@
       !! ** Method  :  use iom_put
       !!----------------------------------------------------------------------
-      !!
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
       !!----------------------------------------------------------------------
       ! 
@@ -144,5 +129,5 @@
       INTEGER  ::   ierr                                     ! error code return from allocation
       INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
-      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt           ! local scalars
+      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars
       !!----------------------------------------------------------------------
       ! 
@@ -163,18 +148,16 @@
 
       ! Define frequency of output and means
-      zdt = rdt
-      IF( nacc == 1 ) zdt = rdtmin
       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
+      zsto = nwrite * rdt
       clop = "inst("//TRIM(clop)//")"
 #else
-      zsto=zdt
+      zsto=rdt
       clop = "ave("//TRIM(clop)//")"
 #endif
-      zout = nwrite * zdt
-      zmax = ( nitend - nit000 + 1 ) * zdt
+      zout = nwrite * rdt
+      zmax = ( nitend - nit000 + 1 ) * rdt
 
       ! Define indices of the horizontal output zoom and vertical limit storage
@@ -218,5 +201,5 @@
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, zdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
             &           "m", ipk, gdept_1d, nz_T, "down" )
@@ -230,5 +213,5 @@
          CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, zdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
             &           "m", ipk, gdept_1d, nz_U, "down" )
@@ -242,5 +225,5 @@
          CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, zdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
+            &          nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
             &          "m", ipk, gdept_1d, nz_V, "down" )
@@ -338,6 +321,4 @@
       !
    END SUBROUTINE dia_wri
-# endif
-
 #endif
 
@@ -362,5 +343,5 @@
       INTEGER  ::   id_i , nz_i, nh_i       
       INTEGER, DIMENSION(1) ::   idex             ! local workspace
-      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt
+      REAL(wp) ::   zsto, zout, zmax, zjulian
       !!----------------------------------------------------------------------
       ! 
@@ -373,9 +354,8 @@
       clname = cdfile_name
       IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
-      zdt  = rdt
       zsto = rdt
       clop = "inst(x)"           ! no use of the mask value (require less cpu time)
       zout = rdt
-      zmax = ( nitend - nit000 + 1 ) * zdt
+      zmax = ( nitend - nit000 + 1 ) * rdt
 
       IF(lwp) WRITE(numout,*)
@@ -392,5 +372,5 @@
       zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
       CALL histbeg( clname, jpi, glamt, jpj, gphit,   &
-          1, jpi, 1, jpj, nit000-1, zjulian, zdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
+          1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
       CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept
           "m", jpk, gdept_1d, nz_i, "down")
@@ -435,5 +415,5 @@
       ! -----------------
       CALL histclo( id_i )
-#if ! defined key_iomput && ! defined key_dimgout
+#if ! defined key_iomput
       IF( ninist /= 1  ) THEN
          CALL histclo( nid_T )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 6808)
@@ -184,5 +184,5 @@
       NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
          &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
-         &             nn_bench, nn_timing
+         &             nn_bench, nn_timing, nn_diacfl
       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
          &             jpizoom, jpjzoom, jperio, ln_use_jattr
@@ -521,5 +521,5 @@
 #endif
       !
-      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6
+      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6,ierr7,ierr8
       INTEGER :: jpm
       !!----------------------------------------------------------------------
@@ -545,5 +545,7 @@
       ALLOCATE( tsb(jpi,jpj,1,jpm)  , STAT=ierr5 )
       ALLOCATE( sshn(jpi,jpj)       , STAT=ierr6 )
-      ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + 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
 #endif
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90	(revision 6808)
@@ -88,9 +88,9 @@
          ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
          ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
-         IF( lk_vvl )   e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity 
+         IF( .NOT.ln_linssh )   e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity 
       ELSE
          ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
          ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
-         IF( lk_vvl )   e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity 
+         IF( .NOT.ln_linssh )   e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity 
       ENDIF
       !
@@ -115,6 +115,6 @@
          CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m   - : ', mask1=vmask, ovlap=1   )
          CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m   - : ', mask1=tmask, ovlap=1   )
-         IF( lk_vvl      )   CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m   - : ', mask1=tmask, ovlap=1   )
-         IF( ln_read_frq )   CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m   - : ', mask1=tmask, ovlap=1   )
+         IF( .NOT.ln_linssh )   CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m   - : ', mask1=tmask, ovlap=1   )
+         IF( ln_read_frq    )   CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m   - : ', mask1=tmask, ovlap=1   )
       ENDIF
       !
@@ -125,6 +125,6 @@
          CALL iom_put( 'sss_m', sss_m )
          CALL iom_put( 'ssh_m', ssh_m )
-         IF( lk_vvl      )   CALL iom_put( 'e3t_m', e3t_m )
-         IF( ln_read_frq )   CALL iom_put( 'frq_m', frq_m )
+         IF( .NOT.ln_linssh )   CALL iom_put( 'e3t_m', e3t_m )
+         IF( ln_read_frq    )   CALL iom_put( 'frq_m', frq_m )
       ENDIF
       !
@@ -216,10 +216,10 @@
       IF( ln_3d_uve ) THEN
          jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3      ! define 3D fields index
-         nfld_3d  = 2 + COUNT( (/lk_vvl/) )        ! number of 3D fields to read
+         nfld_3d  = 2 + COUNT( (/.NOT.ln_linssh/) )        ! number of 3D fields to read
          nfld_2d  = 3 + COUNT( (/ln_read_frq/) )   ! number of 2D fields to read
       ELSE
-         jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/lk_vvl/) )   ! update 2D fields index
+         jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/.NOT.ln_linssh/) )   ! update 2D fields index
          nfld_3d  = 0                                                              ! no 3D fields to read
-         nfld_2d  = 5 + COUNT( (/lk_vvl/) ) + COUNT( (/ln_read_frq/) )             ! number of 2D fields to read
+         nfld_2d  = 5 + COUNT( (/.NOT.ln_linssh/) ) + COUNT( (/ln_read_frq/) )             ! number of 2D fields to read
       ENDIF
 
@@ -231,5 +231,5 @@
          slf_3d(jf_usp) = sn_usp
          slf_3d(jf_vsp) = sn_vsp
-         IF( lk_vvl )   slf_3d(jf_e3t) = sn_e3t
+         IF( .NOT.ln_linssh )   slf_3d(jf_e3t) = sn_e3t
       ENDIF
 
@@ -243,5 +243,5 @@
          IF( .NOT. ln_3d_uve ) THEN
             slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp
-            IF( lk_vvl )   slf_2d(jf_e3t) = sn_e3t
+            IF( .NOT.ln_linssh )   slf_2d(jf_e3t) = sn_e3t
          ENDIF
       ENDIF
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/step.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/step.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/SAS_SRC/step.F90	(revision 6808)
@@ -16,29 +16,24 @@
    USE oce              ! ocean dynamics and tracers variables
    USE dom_oce          ! ocean space and time domain variables 
-   USE in_out_manager   ! I/O manager
-   USE sbc_oce
-   USE sbccpl
-   USE iom              !
-   USE lbclnk
-#if defined key_iomput
-   USE xios
-#endif
-
    USE daymod           ! calendar                         (day     routine)
-
+   USE sbc_oce          ! surface boundary condition: fields
    USE sbcmod           ! surface boundary condition       (sbc     routine)
    USE sbcrnf           ! surface boundary condition: runoff variables
-
+   USE sbccpl           ! surface boundary condition: coupled interface
    USE eosbn2           ! equation of state                (eos_bn2 routine)
-
    USE diawri           ! Standard run outputs             (dia_wri routine)
-   USE stpctl           ! time stepping control            (stp_ctl routine)
-   USE prtctl           ! Print control                    (prt_ctl routine)
-
-   USE timing           ! Timing            
-
    USE bdy_par          ! clem: mandatory for LIM3
 #if defined key_bdy
    USE bdydta           ! clem: mandatory for LIM3
+#endif
+   USE stpctl           ! time stepping control            (stp_ctl routine)
+   !
+   USE in_out_manager   ! I/O manager
+   USE prtctl           ! Print control                    (prt_ctl routine)
+   USE iom              !
+   USE lbclnk           !
+   USE timing           ! Timing            
+#if defined key_iomput
+   USE xios
 #endif
 
@@ -46,9 +41,6 @@
    PRIVATE
 
-   PUBLIC   stp   ! called by opa.F90
+   PUBLIC   stp   ! called by nemogcm.F90
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90	(revision 6808)
@@ -48,7 +48,4 @@
    REAL(wp) ::   xconv2 = 0.01_wp / 3600._wp   ! conversion from cm/h to m/s: 
    REAL(wp) ::   xconv3 = 1.e+3_wp             ! conversion from mol/l/atm to mol/m3/atm
-
-   !! * Substitutions
-#  include "top_substitute.h90"
 
    !!----------------------------------------------------------------------
@@ -258,5 +255,5 @@
                   &                      * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) / 2.
             ! Add the surface flux to the trend
-            tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / fse3t(ji,jj,1) 
+            tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / e3t_n(ji,jj,1) 
             
             ! cumulation of surface flux at each time step
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90	(revision 6808)
@@ -20,5 +20,4 @@
    PUBLIC trc_wri_c14b 
 
-#  include "top_substitute.h90"
 CONTAINS
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90	(revision 6808)
@@ -50,6 +50,4 @@
    REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv 
 
-   !! * Substitutions
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -75,5 +73,4 @@
       !!                CFC concentration in pico-mol/m3
       !!----------------------------------------------------------------------
-      !
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
       !
@@ -167,5 +164,5 @@
                   &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) )
                ! Add the surface flux to the trend
-               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1) 
+               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / e3t_n(ji,jj,1) 
 
                ! cumulation of surface flux at each time step
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90	(revision 6808)
@@ -20,5 +20,4 @@
    PUBLIC trc_wri_cfc 
 
-#  include "top_substitute.h90"
 CONTAINS
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 6808)
@@ -18,4 +18,5 @@
    USE trd_oce
    USE trdtrc
+   USE trcbc, only : trc_bc_read
 
    IMPLICIT NONE
@@ -56,5 +57,10 @@
       IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt )
 
-      IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer
+      CALL trc_bc_read  ( kt )       ! tracers: surface and lateral Boundary Conditions
+
+      ! add here the call to BGC model
+
+      ! Save the trends in the mixed layer
+      IF( l_trdtrc ) THEN
           DO jn = jp_myt0, jp_myt1
             ztrmyt(:,:,:) = tra(:,:,:,jn)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90	(revision 6808)
@@ -20,5 +20,4 @@
    PUBLIC trc_wri_my_trc 
 
-#  include "top_substitute.h90"
 CONTAINS
 
@@ -37,5 +36,5 @@
       DO jn = jp_myt0, jp_myt1
          cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
-         CALL iom_put( cltra, trn(:,:,:,jn) )
+         IF( ln_trc_wri(jn) ) CALL iom_put( cltra, trn(:,:,:,jn) )
       END DO
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90	(revision 6808)
@@ -59,6 +59,6 @@
    REAL(wp) ::   fdbod      ! zooplankton mortality fraction that goes to detritus
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -66,5 +66,4 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -186,5 +185,5 @@
                !    closure : flux grazing is redistributed below level jpkbio
                zzoobod = tmminz * zzoo * zzoo
-               xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * fse3t(ji,jj,jk)
+               xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t_n(ji,jj,jk)
                zboddet = fdbod * zzoobod
 
@@ -241,5 +240,5 @@
                 IF( ln_diatrc .OR. lk_iomput ) THEN
                   ! convert fluxes in per day
-                  ze3t = fse3t(ji,jj,jk) * 86400.
+                  ze3t = e3t_n(ji,jj,jk) * 86400._wp
                   zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t
                   zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t
@@ -362,5 +361,5 @@
                 IF( ln_diatrc .OR. lk_iomput ) THEN
                   ! convert fluxes in per day
-                  ze3t = fse3t(ji,jj,jk) * 86400.
+                  ze3t = e3t_n(ji,jj,jk) * 86400._wp
                   zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t
                   zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t
@@ -381,7 +380,7 @@
                   zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t
                   !   
-                  zw3d(ji,jj,jk,1) = zno3phy * 86400
-                  zw3d(ji,jj,jk,2) = znh4phy * 86400
-                  zw3d(ji,jj,jk,3) = znh4no3 * 86400
+                  zw3d(ji,jj,jk,1) = zno3phy * 86400._wp
+                  zw3d(ji,jj,jk,2) = znh4phy * 86400._wp
+                  zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp
                    !
                 ENDIF
@@ -599,3 +598,3 @@
 
    !!======================================================================
-END MODULE  p2zbio
+END MODULE p2zbio
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90	(revision 6808)
@@ -41,6 +41,6 @@
    REAL(wp)                                ::   areacot   !: surface coastal area
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -48,5 +48,4 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -94,5 +93,5 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
-               ze3t = 1. / fse3t(ji,jj,jk)
+               ze3t = 1. / e3t_n(ji,jj,jk)
                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj)
             END DO
@@ -109,5 +108,5 @@
          DO ji = fs_2, fs_jpim1
             ikt = mbkt(ji,jj) 
-            tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikt) 
+            tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / e3t_n(ji,jj,ikt) 
             ! Deposition of organic matter in the sediment
             zwork = vsed * trn(ji,jj,ikt,jpdet)
@@ -120,5 +119,5 @@
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1
-            tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1)
+            tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / e3t_n(ji,jj,1)
          END DO
       END DO
@@ -211,6 +210,6 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zfluo = ( fsdepw(ji,jj,jk  ) / fsdepw(ji,jj,jpkb) )**xhr
-               zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(ji,jj,jpkb) )**xhr
+               zfluo = ( gdepw_n(ji,jj,jk  ) / gdepw_n(ji,jj,jpkb) )**xhr
+               zfluu = ( gdepw_n(ji,jj,jk+1) / gdepw_n(ji,jj,jpkb) )**xhr
                IF( zfluo.GT.1. )   zfluo = 1._wp
                zdm0(ji,jj,jk) = zfluo - zfluu
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90	(revision 6808)
@@ -40,6 +40,4 @@
    REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -47,5 +45,4 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -105,6 +102,6 @@
                zkr  = xkr0 + xkrp * EXP( xlr * zpig )
                zkg  = xkg0 + xkgp * EXP( xlg * zpig )
-               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) )
-               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) )
+               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t_n(ji,jj,jk-1) )
+               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t_n(ji,jj,jk-1) )
             END DO
         END DO
@@ -116,6 +113,6 @@
                zkr  = xkr0 + xkrp * EXP( xlr * zpig )
                zkg  = xkg0 + xkgp * EXP( xlg * zpig )
-               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) )
-               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) )
+               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkr * e3t_n(ji,jj,jk) ) )
+               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkg * e3t_n(ji,jj,jk) ) )
                etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
             END DO
@@ -138,5 +135,5 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            heup(ji,jj) = fsdepw(ji,jj,neln(ji,jj))
+            heup(ji,jj) = gdepw_n(ji,jj,neln(ji,jj))
          END DO
       END DO 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90	(revision 6808)
@@ -34,6 +34,4 @@
    REAL(wp), PUBLIC ::   xhr         ! coeff for martin''s remineralisation profile
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -102,5 +100,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
+               ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
                tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk) 
             END DO
@@ -111,7 +109,7 @@
          IF( iom_use( "TDETSED" ) ) THEN
             CALL wrk_alloc( jpi, jpj, zw2d )
-            zw2d(:,:) =  ztra(:,:,1) * fse3t(:,:,1) * 86400.
+            zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp
             DO jk = 2, jpkm1
-               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400.
+               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp
             END DO
             CALL iom_put( "TDETSED", zw2d )
@@ -121,7 +119,7 @@
          IF( ln_diatrc ) THEN 
             CALL wrk_alloc( jpi, jpj, zw2d )
-            zw2d(:,:) =  ztra(:,:,1) * fse3t(:,:,1) * 86400.
+            zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp
             DO jk = 2, jpkm1
-               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400.
+               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp
             END DO
             trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90	(revision 6808)
@@ -84,3 +84,3 @@
 
    !!======================================================================
-END MODULE  p2zsms
+END MODULE p2zsms
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90	(revision 6808)
@@ -34,6 +34,4 @@
    PUBLIC  p4z_bio    
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -41,5 +39,4 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -70,10 +67,10 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF( fsdepw(ji,jj,jk+1) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01
+!!gm  :  use nmln  and test on jk ...  less memory acces
+               IF( gdepw_n(ji,jj,jk+1) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01
             END DO 
          END DO
       END DO
 
-          
       CALL p4z_opt  ( kt, knt )     ! Optic: PAR in the water column
       CALL p4z_sink ( kt, knt )     ! vertical flux of particulate organic matter
@@ -109,4 +106,3 @@
 
    !!======================================================================
-END MODULE  p4zbio
-
+END MODULE p4zbio
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90	(revision 6808)
@@ -164,6 +164,4 @@
    REAL(wp) :: devk55  = 0.3692E-3      
 
-   !!* Substitution
-#include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -195,7 +193,5 @@
       ! CHEMICAL CONSTANTS - SURFACE LAYER
       ! ----------------------------------
-!CDIR NOVERRCHK
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             !                             ! SET ABSOLUTE TEMPERATURE
@@ -227,9 +223,6 @@
       ! OXYGEN SOLUBILITY - DEEP OCEAN
       ! -------------------------------
-!CDIR NOVERRCHK
       DO jk = 1, jpk
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
               ztkel = tsn(ji,jj,jk,jp_tem) + 273.16
@@ -249,16 +242,12 @@
 
 
-
       ! CHEMICAL CONSTANTS - DEEP OCEAN
       ! -------------------------------
-!CDIR NOVERRCHK
       DO jk = 1, jpk
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
 
                ! SET PRESSION
-               zpres   = 1.025e-1 * fsdept(ji,jj,jk)
+               zpres   = 1.025e-1 * gdept_n(ji,jj,jk)
 
                ! SET ABSOLUTE TEMPERATURE
@@ -396,3 +385,3 @@
 
    !!======================================================================
-END MODULE  p4zche
+END MODULE p4zche
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90	(revision 6808)
@@ -30,15 +30,13 @@
    PUBLIC   p4z_fechem_init ! called in trcsms_pisces.F90
 
-   !! * Shared module variables
-   LOGICAL          ::  ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker
-   LOGICAL          ::  ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker
-   REAL(wp), PUBLIC ::  xlam1        !: scavenging rate of Iron 
-   REAL(wp), PUBLIC ::  xlamdust     !: scavenging rate of Iron by dust 
-   REAL(wp), PUBLIC ::  ligand       !: ligand concentration in the ocean 
-
+   LOGICAL          ::   ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker
+   LOGICAL          ::   ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker
+   REAL(wp), PUBLIC ::   xlam1        !: scavenging rate of Iron 
+   REAL(wp), PUBLIC ::   xlamdust     !: scavenging rate of Iron by dust 
+   REAL(wp), PUBLIC ::   ligand       !: ligand concentration in the ocean 
+
+!!gm Not DOCTOR norm !!!
    REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -61,8 +59,8 @@
       !!                    and one particulate form (ln_fechem)
       !!---------------------------------------------------------------------
-      !
-      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step
       !
       INTEGER  ::   ji, jj, jk, jic
+      CHARACTER (len=25) :: charout
       REAL(wp) ::   zdep, zlam1a, zlam1b, zlamfac
       REAL(wp) ::   zkeq, zfeequi, zfesatur, zfecoll
@@ -79,16 +77,14 @@
       REAL(wp) :: ztfe, zoxy
       REAL(wp) :: zstep
-      CHARACTER (len=25) :: charout
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('p4z_fechem')
       !
-      ! Allocate temporary workspace
-      CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig )
+      CALL wrk_alloc( jpi,jpj,jpk,   zFe3, zFeL1, zTL1, ztotlig )
       zFe3 (:,:,:) = 0.
       zFeL1(:,:,:) = 0.
       zTL1 (:,:,:) = 0.
       IF( ln_fechem ) THEN
-         CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP )
+         CALL wrk_alloc( jpi,jpj,jpk,   zFe2, zFeL2, zTL2, zFeP )
          zFe2 (:,:,:) = 0.
          zFeL2(:,:,:) = 0.
@@ -113,9 +109,6 @@
          ! Chemistry is supposed to be fast enough to be at equilibrium
          ! ------------------------------------------------------------
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   ! Calculate ligand concentrations : assume 2/3rd of excess goes to
@@ -195,9 +188,6 @@
          ! Chemistry is supposed to be fast enough to be at equilibrium
          ! ------------------------------------------------------------
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   zTL1(ji,jj,jk) = ztotlig(ji,jj,jk)
@@ -216,11 +206,9 @@
          !
       ENDIF
-
+      !
       zdust = 0.         ! if no dust available
-!CDIR NOVERRCHK
+      !
       DO jk = 1, jpkm1
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                zstep = xstep
@@ -261,5 +249,6 @@
                zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. )
                zlamfac = MIN( 1.  , zlamfac )
-               zdep    = MIN( 1., 1000. / fsdept(ji,jj,jk) )
+!!gm very small BUG :  it is unlikely but possible that gdept_n = 0  .....
+               zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) )
                zlam1b  = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) )
                zcoag   = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90	(revision 6808)
@@ -59,6 +59,4 @@
    REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion 
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -122,7 +120,5 @@
 
       DO jm = 1, 10
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
 
@@ -155,7 +151,5 @@
       ! -------------------------------------------
 
-!CDIR NOVERRCHK
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
             ztc  = MIN( 35., tsn(ji,jj,1,jp_tem) )
@@ -186,5 +180,5 @@
             oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000.
             ! compute the trend
-            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / fse3t(ji,jj,1)
+            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / e3t_n(ji,jj,1)
 
             ! Compute O2 flux 
@@ -192,5 +186,5 @@
             zflu16 = trb(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj)
             zoflx(ji,jj) = zfld16 - zflu16
-            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / fse3t(ji,jj,1)
+            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / e3t_n(ji,jj,1)
          END DO
       END DO
@@ -400,3 +394,3 @@
 
    !!======================================================================
-END MODULE  p4zflx
+END MODULE p4zflx
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90	(revision 6808)
@@ -81,3 +81,3 @@
 
    !!======================================================================
-END MODULE  p4zint
+END MODULE p4zint
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90	(revision 6808)
@@ -52,6 +52,5 @@
    REAL(wp) ::  xcoef2   = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5
    REAL(wp) ::  xcoef3   = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5 
-   !!* Substitution
-#  include "top_substitute.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -265,3 +264,3 @@
 
    !!======================================================================
-END MODULE  p4zlim
+END MODULE p4zlim
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90	(revision 6808)
@@ -80,9 +80,6 @@
       DO jn = 1, 5                               !  BEGIN OF ITERATION
          !
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   zfact = rhop(ji,jj,jk) / 1000. + rtrn
@@ -223,3 +220,3 @@
 #endif 
    !!======================================================================
-END MODULE  p4zlys
+END MODULE p4zlys
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90	(revision 6808)
@@ -50,6 +50,4 @@
    REAL(wp), PUBLIC ::  grazflux     !: mesozoo flux feeding rate
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -340,3 +338,3 @@
 
    !!======================================================================
-END MODULE  p4zmeso
+END MODULE p4zmeso
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90	(revision 6808)
@@ -49,6 +49,4 @@
 
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -273,3 +271,3 @@
 
    !!======================================================================
-END MODULE  p4zmicro
+END MODULE p4zmicro
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90	(revision 6808)
@@ -35,6 +35,4 @@
 
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -277,3 +275,3 @@
 
    !!======================================================================
-END MODULE  p4zmort
+END MODULE p4zmort
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90	(revision 6808)
@@ -51,6 +51,4 @@
    REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption
    
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -95,7 +93,5 @@
       !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
       DO jk = 1, jpkm1                         !  --------------------------------------------------------
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e6
@@ -103,7 +99,7 @@
                irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn )
                !                                                         
-               ekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)
-               ekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)
-               ekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk)
+               ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t_n(ji,jj,jk)
+               ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk)
+               ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk)
             END DO
          END DO
@@ -164,5 +160,5 @@
                  neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer
                  !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
-                 heup(ji,jj) = fsdepw(ji,jj,jk+1)      ! Euphotic layer depth
+                 heup(ji,jj) = gdepw_n(ji,jj,jk+1)     ! Euphotic layer depth
               ENDIF
            END DO
@@ -179,14 +175,12 @@
 
       DO jk = 1, nksrp
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
-               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
-                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * fse3t(ji,jj,jk) ! remineralisation
-                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * fse3t(ji,jj,jk) ! production
-                  zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * fse3t(ji,jj,jk) ! production
-                  zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * fse3t(ji,jj,jk) ! production
-                  zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk)
+               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
+                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t_n(ji,jj,jk) ! remineralisation
+                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t_n(ji,jj,jk) ! production
+                  zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production
+                  zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production
+                  zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk)
                ENDIF
             END DO
@@ -198,9 +192,7 @@
       !
       DO jk = 1, nksrp
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
-               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
+               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
                   z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
                   emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep
@@ -264,9 +256,7 @@
          !
          DO jk = 2, nksrp + 1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
-                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * xsi0r )
+                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r )
                   pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) )
                   pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) )
@@ -285,7 +275,5 @@
         !
         DO jk = 2, nksrp      
-!CDIR NOVERRCHK
            DO jj = 1, jpj
-!CDIR NOVERRCHK
               DO ji = 1, jpi
                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) )
@@ -439,3 +427,3 @@
 
    !!======================================================================
-END MODULE  p4zopt
+END MODULE p4zopt
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90	(revision 6808)
@@ -54,7 +54,4 @@
    REAL(wp) :: texcret2               !: 1 - excret2        
 
-
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -148,9 +145,6 @@
 
       IF( ln_newprod ) THEN
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   ! Computation of the P-I slope for nanos and diatoms
@@ -186,9 +180,6 @@
          END DO
       ELSE
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
 
@@ -231,9 +222,6 @@
       !  Computation of a proxy of the N/C ratio
       !  ---------------------------------------
-!CDIR NOVERRCHK
       DO jk = 1, jpkm1
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                 zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   &
@@ -287,5 +275,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
+               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
                   zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj)
                   zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj)
@@ -296,9 +284,6 @@
 
       ! Computation of the various production terms 
-!CDIR NOVERRCHK
       DO jk = 1, jpkm1
-!CDIR NOVERRCHK
          DO jj = 1, jpj
-!CDIR NOVERRCHK
             DO ji = 1, jpi
                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
@@ -331,11 +316,8 @@
 
       IF( ln_newprod ) THEN
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
-                  IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
+                  IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
                      zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj)
                      zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj)
@@ -359,9 +341,6 @@
          END DO
       ELSE
-!CDIR NOVERRCHK
          DO jk = 1, jpkm1
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
@@ -481,5 +460,5 @@
              zw2d(:,:) = 0.
              DO jk = 1, jpkm1
-               zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano
+               zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano
              ENDDO
              CALL iom_put( "INTPPPHY" , zw2d )
@@ -487,5 +466,5 @@
              zw2d(:,:) = 0.
              DO jk = 1, jpkm1
-                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom
+                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom
              ENDDO
              CALL iom_put( "INTPPPHY2" , zw2d )
@@ -494,5 +473,5 @@
              zw2d(:,:) = 0.
              DO jk = 1, jpkm1
-                zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp
+                zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp
              ENDDO
              CALL iom_put( "INTPP" , zw2d )
@@ -501,5 +480,5 @@
              zw2d(:,:) = 0.
              DO jk = 1, jpkm1
-                zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod
+                zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod
              ENDDO
              CALL iom_put( "INTPNEW" , zw2d )
@@ -508,5 +487,5 @@
              zw2d(:,:) = 0.
              DO jk = 1, jpkm1
-                zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod
+                zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod
              ENDDO
             CALL iom_put( "INTPBFE" , zw2d )
@@ -515,5 +494,5 @@
              zw2d(:,:) = 0.
              DO jk = 1, jpkm1
-                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk)  ! vert integr. bsi prod
+                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert integr. bsi prod
              ENDDO
              CALL iom_put( "INTPBSI" , zw2d )
@@ -629,3 +608,3 @@
 
    !!======================================================================
-END MODULE  p4zprod
+END MODULE p4zprod
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90	(revision 6808)
@@ -50,6 +50,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitnh4   !: -    -    -    -   -
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -103,9 +101,9 @@
             DO ji = 1, jpi
                zdep = MAX( hmld(ji,jj), heup(ji,jj) )
-               IF( fsdept(ji,jj,jk) < zdep ) THEN
+               IF( gdept_n(ji,jj,jk) < zdep ) THEN
                   zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 )
                   ztempbac(ji,jj)   = zdepbac(ji,jj,jk)
                ELSE
-                  zdepmin = MIN( 1., zdep / fsdept(ji,jj,jk) )
+                  zdepmin = MIN( 1., zdep / gdept_n(ji,jj,jk) )
                   zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj)
                   zdepprod(ji,jj,jk) = zdepmin**0.273
@@ -283,5 +281,5 @@
                ! ----------------------------------------------------------
                zdep     = MAX( hmld(ji,jj), heup(ji,jj) ) 
-               zdep     = MAX( 0., fsdept(ji,jj,jk) - zdep )
+               zdep     = MAX( 0., gdept_n(ji,jj,jk) - zdep )
                ztem     = MAX( tsn(ji,jj,1,jp_tem), 0. )
                zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90	(revision 6808)
@@ -25,5 +25,4 @@
    PUBLIC   p4z_sbc_init   
 
-   !! * Shared module variables
    LOGICAL , PUBLIC  :: ln_dust     !: boolean for dust input from the atmosphere
    LOGICAL , PUBLIC  :: ln_solub    !: boolean for variable solubility of atmospheric iron
@@ -45,5 +44,4 @@
    LOGICAL , PUBLIC  :: ll_sbc
 
-   !! * Module variables
    LOGICAL  ::  ll_solub
 
@@ -80,7 +78,6 @@
    REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput
 
-
-   !!* Substitution
-#  include "top_substitute.h90"
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -88,5 +85,4 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -162,5 +158,5 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * fse3t(ji,jj,1) + rtrn )
+                  nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * e3t_n(ji,jj,1) + rtrn )
                END DO
             END DO
@@ -266,5 +262,5 @@
       IF( lk_offline ) THEN
         nk_rnf(:,:) = 1
-        h_rnf (:,:) = fsdept(:,:,1)
+        h_rnf (:,:) = gdept_n(:,:,1)
       ENDIF
 
@@ -455,5 +451,5 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zexpide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) )
+                  zexpide   = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) )
                   zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2
                   zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 )
@@ -465,5 +461,5 @@
          ironsed(:,:,jpk) = 0._wp
          DO jk = 1, jpkm1
-            ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday )
+            ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_n(:,:,jk) * rday )
          END DO
          DEALLOCATE( zcmask)
@@ -519,3 +515,3 @@
 
    !!======================================================================
-END MODULE  p4zsbc
+END MODULE p4zsbc
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90	(revision 6808)
@@ -32,12 +32,8 @@
    PUBLIC   p4z_sed_alloc
  
-
-   !! * Module variables
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot    !: Nitrogen fixation 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: sdenit     !: Nitrate reduction in the sediments
    REAL(wp) :: r1_rday                  !: inverse of rday
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -100,5 +96,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zdep    = rfact2 / fse3t(ji,jj,1)
+               zdep    = rfact2 / e3t_n(ji,jj,1)
                zwflux  = fmmflx(ji,jj) / 1000._wp
                zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep
@@ -111,5 +107,5 @@
          ! 
          IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) )   &
-            &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! iron flux from ice
+            &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice
          !
          CALL wrk_dealloc( jpi, jpj, zironice )
@@ -125,15 +121,15 @@
          !                                              ! Iron and Si deposition at the surface
          IF( ln_solub ) THEN
-            zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 
+            zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 
          ELSE
-            zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 
+            zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 
          ENDIF
-         zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 28.1 
-         zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 31. / po4r 
+         zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1 
+         zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r 
          !                                              ! Iron solubilization of particles in the water column
          !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j
          zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday )
          DO jk = 2, jpkm1
-            zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -fsdept(:,:,jk) / 540. )
+            zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. )
          END DO
          !                                              ! Iron solubilization of particles in the water column
@@ -145,5 +141,5 @@
             IF( knt == nrdttrc ) THEN
                 IF( iom_use( "Irondep" ) )   &
-                &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron
+                &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron
                 IF( iom_use( "pdust" ) )   &
                 &  CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday )  * tmask(:,:,1) ) ! dust concentration at surface
@@ -151,5 +147,5 @@
          ELSE                                    
             IF( ln_diatrc )  &
-              &  trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
+              &  trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1)
          ENDIF
          CALL wrk_dealloc( jpi, jpj,      zpdep, zsidep )
@@ -206,5 +202,5 @@
          DO ji = 1, jpi
             ikt  = mbkt(ji,jj)
-            zdep = fse3t(ji,jj,ikt) / xstep
+            zdep = e3t_n(ji,jj,ikt) / xstep
             zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) )
             zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) )
@@ -230,5 +226,5 @@
               zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) )
               zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
-              zdep  = LOG10( fsdepw(ji,jj,ikt+1) )
+              zdep  = LOG10( gdepw_n(ji,jj,ikt+1) )
               zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    &
               &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2
@@ -279,5 +275,5 @@
          DO ji = 1, jpi
             ikt  = mbkt(ji,jj)
-            zdep = xstep / fse3t(ji,jj,ikt) 
+            zdep = xstep / e3t_n(ji,jj,ikt) 
             zws4 = zwsbio4(ji,jj) * zdep
             zwsc = zwscal (ji,jj) * zdep
@@ -305,5 +301,5 @@
          DO ji = 1, jpi
             ikt  = mbkt(ji,jj)
-            zdep = xstep / fse3t(ji,jj,ikt) 
+            zdep = xstep / e3t_n(ji,jj,ikt) 
             zws4 = zwsbio4(ji,jj) * zdep
             zws3 = zwsbio3(ji,jj) * zdep
@@ -336,5 +332,5 @@
             tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )
             tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt
-            sdenit(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)
+            sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt)
 #endif
          END DO
@@ -388,5 +384,5 @@
                zwork1(:,:) = 0.
                DO jk = 1, jpkm1
-                 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk)
+                 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * e3t_n(:,:,jk) * tmask(:,:,jk)
                ENDDO
                CALL iom_put( "INTNFIX" , zwork1 ) 
@@ -395,5 +391,5 @@
       ELSE
          IF( ln_diatrc )  &
-            &  trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
+            &  trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1)
       ENDIF
       !
@@ -436,3 +432,3 @@
 
    !!======================================================================
-END MODULE  p4zsed
+END MODULE p4zsed
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90	(revision 6808)
@@ -65,6 +65,4 @@
 #endif
 
-   !!* Substitution
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -108,5 +106,5 @@
             DO ji = 1,jpi
                zmax  = MAX( heup(ji,jj), hmld(ji,jj) )
-               zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 5000._wp
+               zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / 5000._wp
                wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact
             END DO
@@ -137,5 +135,5 @@
              DO ji = 1, jpi
                 IF( tmask(ji,jj,jk) == 1) THEN
-                   zwsmax =  0.5 * fse3t(ji,jj,jk) / xstep
+                   zwsmax =  0.5 * e3t_n(ji,jj,jk) / xstep
                    iiter1 =  MAX( iiter1, INT( wsbio3(ji,jj,jk) / zwsmax ) )
                    iiter2 =  MAX( iiter2, INT( wsbio4(ji,jj,jk) / zwsmax ) )
@@ -156,5 +154,5 @@
             DO ji = 1, jpi
                IF( tmask(ji,jj,jk) == 1 ) THEN
-                 zwsmax = 0.5 * fse3t(ji,jj,jk) / xstep
+                 zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep
                  wsbio3(ji,jj,jk) = MIN( wsbio3(ji,jj,jk), zwsmax * FLOAT( iiter1 ) )
                  wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax * FLOAT( iiter2 ) )
@@ -700,5 +698,5 @@
          zl = zmin
          zr = zmax
-         wmax = 0.5 * fse3t(1,1,jk) * rday * float(niter1max) / rfact2
+         wmax = 0.5 * e3t_n(1,1,jk) * rday * float(niter1max) / rfact2
          zdiv = xkr_zeta + xkr_eta - xkr_eta * zl
          znum = zl - 1.
@@ -844,5 +842,5 @@
             DO jj = 1, jpj      
                DO ji = 1, jpi    
-                  zigma = zwsink2(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1)
+                  zigma = zwsink2(ji,jj,jk+1) * zstep / e3w_n(ji,jj,jk+1)
                   zew   = zwsink2(ji,jj,jk+1)
                   psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep
@@ -858,5 +856,5 @@
             DO jj = 1,jpj
                DO ji = 1, jpi
-                  zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
+                  zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
                   trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx
                END DO
@@ -869,5 +867,5 @@
          DO jj = 1,jpj
             DO ji = 1, jpi
-               zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
+               zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
                ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx
             END DO
@@ -913,3 +911,3 @@
 
    !!======================================================================
-END MODULE  p4zsink
+END MODULE p4zsink
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90	(revision 6808)
@@ -45,6 +45,4 @@
 
 
-   !! * Substitutions
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -94,6 +92,6 @@
       !
       !                                                                    !   set time step size (Euler/Leapfrog)
-      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN   ;    rfact = rdttrc(1)     !  at nittrc000
-      ELSEIF( kt <= nittrc000 + nn_dttrc )                          THEN   ;    rfact = 2. * rdttrc(1)   ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog)
+      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN   ;    rfact = rdttrc     !  at nittrc000
+      ELSEIF( kt <= nittrc000 + nn_dttrc )                          THEN   ;    rfact = 2. * rdttrc   ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog)
       ENDIF
       !
@@ -104,5 +102,5 @@
          xstep = rfact2 / rday         ! Time step duration for biology
          IF(lwp) WRITE(numout,*) 
-         IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdttra(1)
+         IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdt
          IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2
          IF(lwp) WRITE(numout,*)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90	(revision 6808)
@@ -60,11 +60,4 @@
 
       ALLOCATE( zdta(jpi,jpj,jpksed,jptrased), zdta1(jpi,jpj,jpksed,2), zhipor(jpoce,jpksed) ) 
-
-      IF ( jprstlib == jprstdimg ) THEN
-        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
-        ! if restart_sed.nc exists, then set jlibalt to jpnf90
-        INQUIRE( FILE = 'restart_sed.nc', EXIST = llok )
-        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
-      ENDIF
 
       CALL iom_open( 'restart_sed', numrsr, kiolib = jlibalt )     
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90	(revision 6808)
@@ -29,7 +29,24 @@
 CONTAINS
 
+
    SUBROUTINE trc_ice_ini_pisces
       !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE 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 ***
       !!
       !! ** Purpose :   PISCES fake sea ice model setting
@@ -58,6 +75,8 @@
 
                                         !--- Dummy variables
-      REAL(wp), DIMENSION(jptra,2) &
-               ::  zratio            ! effective ice-ocean tracer cc ratio
+      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(2) :: zrs  ! ice-ocean salinity ratio, 1 - global, 2- Baltic
       REAL(wp) :: zsice_bal          ! prescribed ice salinity in the Baltic
@@ -80,128 +99,139 @@
       ! fluxes
 
-      !--- 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  
+      !--- 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
-      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 
+      zpisc(jpgoc,1) =  5.23e-8_wp  
+      zpisc(jpbfe,1) =  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
+      zpisc(jpnum,1) = 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
+      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
 
       !--- Arctic specificities (dissolved inorganic & DOM)
-      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
+      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
-      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
+      zpisc(jpgoc,2) =  2.84e-8_wp  
+      zpisc(jpbfe,2) =  7.03e-13_wp 
 #  else
-      IF ( cn_trc_o(jpnum) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnum) =  0.00e-00_wp ; END WHERE ; ENDIF
+      zpisc(jpnum,2) =  0.00e-00_wp 
 #  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
+      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 
 
       !--- Antarctic specificities (dissolved inorganic & DOM)
-      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
+      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
-      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
+      zpisc(jpgoc,3) =  2.89e-8_wp  
+      zpisc(jpbfe,3) =  5.63e-13_wp 
 #  else
-      IF ( cn_trc_o(jpnum) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpnum) =  0.00e-00_wp ; END WHERE ; ENDIF
+      zpisc(jpnum,3) =  0.00e-00_wp 
 #  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
+      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  
 
       !--- Baltic Sea particular case for ORCA configurations
-      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
+      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
-         trc_o(:,:,jpgoc) = 1.05e-8_wp
-         trc_o(:,:,jpbfe) = 4.97e-13_wp
+      zpisc(jpgoc,4) = 1.05e-8_wp
+      zpisc(jpbfe,4) = 4.97e-13_wp
 #  else
-         trc_o(:,:,jpnum) = 0. ! could not get this value
+      zpisc(jpnum,4) = 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
+      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
+
+
 
       !-----------------------------
@@ -217,7 +247,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
 
@@ -227,20 +257,18 @@
       DO jn = jp_pcs0, jp_pcs1
          !-- Everywhere but in the Baltic
-         IF ( trc_ice_ratio(jn) >= -1._wp ) THEN !! no prescribed concentration
-                                              !! (typically everything but iron) 
+         IF ( trc_ice_ratio(jn) >= -1._wp ) THEN ! no prescribed conc. ; 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 concentration
-                                                 !! (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 conc. ; 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 )
@@ -251,6 +279,18 @@
       !
       END DO ! jn
-
-   END SUBROUTINE trc_ice_ini_pisces
+#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
+
 
 #else
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 6808)
@@ -27,6 +27,4 @@
    PUBLIC   trc_ini_pisces   ! called by trcini.F90 module
 
-
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90	(revision 6808)
@@ -21,5 +21,9 @@
    PUBLIC trc_wri_pisces 
 
-#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcnam.F90 5836 2015-10-26 14:49:40Z cetlod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -55,5 +59,5 @@
          zdic(:,:) = 0.
          DO jk = 1, jpkm1
-            zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * fse3t(:,:,jk) * tmask(:,:,jk) * 12.
+            zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12.
          ENDDO
          CALL iom_put( 'INTDIC', zdic )     
@@ -62,5 +66,5 @@
       IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN  ! Oxygen minimum concentration and depth 
          zo2min   (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1)
-         zdepo2min(:,:) = fsdepw(:,:,1)    * tmask(:,:,1)
+         zdepo2min(:,:) = gdepw_n(:,:,1)   * tmask(:,:,1)
          DO jk = 2, jpkm1
             DO jj = 1, jpj
@@ -69,5 +73,5 @@
                      IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then
                         zo2min   (ji,jj) = trn(ji,jj,jk,jpoxy)
-                        zdepo2min(ji,jj) = fsdepw(ji,jj,jk)
+                        zdepo2min(ji,jj) = gdepw_n(ji,jj,jk)
                      ENDIF
                   ENDIF
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 6808)
@@ -4,6 +4,7 @@
    !! Ocean passive tracers:  advection trend 
    !!==============================================================================
-   !! History :  2.0  !  05-11  (G. Madec)  Original code
-   !!            3.0  !  10-06  (C. Ethe)   Adapted to passive tracers
+   !! History :  2.0  !  2005-11  (G. Madec)  Original code
+   !!            3.0  !  2010-06  (C. Ethe)   Adapted to passive tracers
+   !!            3.7  !  2014-05  (G. Madec, C. Ethe)  Add 2nd/4th order cases for CEN and FCT schemes 
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -11,52 +12,60 @@
    !!   'key_top'                                                TOP models
    !!----------------------------------------------------------------------
-   !!   trc_adv      : compute ocean tracer advection trend
-   !!   trc_adv_ctl  : control the different options of advection scheme
-   !!----------------------------------------------------------------------
-   USE oce_trc         ! ocean dynamics and active tracers
-   USE trc             ! ocean passive tracers variables
-   USE trcnam_trp      ! passive tracers transport namelist variables
-   USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine)
-   USE traadv_tvd      ! TVD      scheme           (tra_adv_tvd    routine)
-   USE traadv_muscl    ! MUSCL    scheme           (tra_adv_muscl  routine)
-   USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine)
-   USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine)
-   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine)
-   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine)
-   USE traadv_mle      ! ML eddy induced velocity  (tra_adv_mle    routine)
-   USE ldftra_oce      ! lateral diffusion coefficient on tracers
-   USE prtctl_trc      ! Print control
+   !!   trc_adv       : compute ocean tracer advection trend
+   !!   trc_adv_ini   : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   USE oce_trc        ! ocean dynamics and active tracers
+   USE trc            ! ocean passive tracers variables
+   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine)
+   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine)
+   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine)
+   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine)
+   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine)
+   USE traadv_mle     ! ML eddy induced velocity  (tra_adv_mle  routine)
+   USE ldftra         ! lateral diffusion coefficient on tracers
+   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces
+   !
+   USE prtctl_trc     ! Print control
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   trc_adv          ! routine called by step module
-   PUBLIC   trc_adv_alloc    ! routine called by nemogcm module
-
-   INTEGER ::   nadv   ! choice of the type of advection scheme
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra
-   !                                                    ! except at nitrrc000 (=rdttra) if neuler=0
+   PUBLIC   trc_adv       
+   PUBLIC   trc_adv_ini  
+
+   !                            !!* Namelist namtrc_adv *
+   LOGICAL ::   ln_trcadv_cen    ! centered scheme flag
+   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme
+   LOGICAL ::   ln_trcadv_fct    ! FCT scheme flag
+   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme
+   INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping
+   LOGICAL ::   ln_trcadv_mus    ! MUSCL scheme flag
+   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths
+   LOGICAL ::   ln_trcadv_ubs    ! UBS scheme flag
+   INTEGER ::      nn_ubs_v             ! =2/4 : vertical choice of the order of UBS scheme
+   LOGICAL ::   ln_trcadv_qck    ! QUICKEST scheme flag
+
+   !                                        ! choices of advection scheme:
+   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection
+   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme
+   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme
+   INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping
+   INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme
+   INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme
+   INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme
+
+   INTEGER ::              nadv             ! chosen advection scheme
+   !
+   REAL(wp) ::   r2dttrc  ! vertical profile time-step, = 2 rdt
+   !                                                    ! except at nitrrc000 (=rdt) if neuler=0
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! NEMO/TOP 3.7 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
-
-   INTEGER FUNCTION trc_adv_alloc()
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_adv_alloc  ***
-      !!----------------------------------------------------------------------
-
-      ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc )
-
-      IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.')
-
-   END FUNCTION trc_adv_alloc
-
 
    SUBROUTINE trc_adv( kt )
@@ -68,84 +77,65 @@
       !! ** Method  : - Update the tracer with the advection term following nadv
       !!----------------------------------------------------------------------
-      !!
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
       !
-      INTEGER ::   jk 
+      INTEGER ::   jk   ! dummy loop index
       CHARACTER (len=22) ::   charout
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('trc_adv')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn )
-      !
-
-      IF( kt == nittrc000 )   CALL trc_adv_ctl          ! initialisation & control of options
-
+      IF( nn_timing == 1 )   CALL timing_start('trc_adv')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn )
+      !
       IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000
-         r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping)
+         r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping)
       ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1
-         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
-      ENDIF
-      !                                                   ! effective transport
+         r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog)
+      ENDIF
+      !                                               !==  effective transport  ==!
       DO jk = 1, jpkm1
-         !                                                ! eulerian transport only
-         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)
-         zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport
+         zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
          zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
-         !
       END DO
       !
-      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
+      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections
          zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
          zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
       ENDIF
       !
-      zun(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
-      zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
-      zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
-
-      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary)
-         &              CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' )
-      !
-      IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )    ! add the mle transport (if necessary)
-      !
-      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
-      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered
-      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD 
-      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups )   !  MUSCL 
-      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2 
-      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS 
-      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST 
-      !
-      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
-         CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )          
-         WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout)
-                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-         CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
-         WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout)
-                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-         CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups  )          
-         WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout)
-                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-         CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
-         WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout)
-                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-         CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
-         WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout)
-                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-         CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
-         WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout)
-                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-         !
+      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
+         &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport
+      !
+      IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport
+      !
+      zun(:,:,jpk) = 0._wp                                                       ! no transport trough the bottom
+      zvn(:,:,jpk) = 0._wp
+      zwn(:,:,jpk) = 0._wp
+      !
+      !
+      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
+      !
+      CASE ( np_CEN )                                    ! Centered : 2nd / 4th order
+         CALL tra_adv_cen    ( kt, nittrc000,'TRC',       zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v )
+      CASE ( np_FCT )                                    ! FCT      : 2nd / 4th order
+         CALL tra_adv_fct    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v )
+      CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting
+         CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra        , nn_fct_zts )
+      CASE ( np_MUS )                                    ! MUSCL
+         CALL tra_adv_mus    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups ) 
+      CASE ( np_UBS )                                    ! UBS
+         CALL tra_adv_ubs    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra        , nn_ubs_v   )
+      CASE ( np_QCK )                                    ! QUICKEST
+         CALL tra_adv_qck    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     )
+      !
       END SELECT
-
-      !                                              ! print mean trends (used for debugging)
-      IF( ln_ctl )   THEN
+      !                  
+      IF( ln_ctl )   THEN                             !== print mean trends (used for debugging)
          WRITE(charout, FMT="('adv ')")  ;  CALL prt_ctl_trc_info(charout)
                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
       END IF
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zun, zvn, zwn )
       !
       IF( nn_timing == 1 )  CALL timing_stop('trc_adv')
@@ -154,7 +144,7 @@
 
 
-   SUBROUTINE trc_adv_ctl
+   SUBROUTINE trc_adv_ini
       !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_adv_ctl  ***
+      !!                  ***  ROUTINE trc_adv_ini  ***
       !!                
       !! ** Purpose : Control the consistency between namelist options for 
@@ -162,38 +152,108 @@
       !!----------------------------------------------------------------------
       INTEGER ::   ioptio
-      !!----------------------------------------------------------------------
-
-      ioptio = 0                      ! Parameter control
-      IF( ln_trcadv_cen2   )   ioptio = ioptio + 1
-      IF( ln_trcadv_tvd    )   ioptio = ioptio + 1
-      IF( ln_trcadv_muscl  )   ioptio = ioptio + 1
-      IF( ln_trcadv_muscl2 )   ioptio = ioptio + 1
-      IF( ln_trcadv_ubs    )   ioptio = ioptio + 1
-      IF( ln_trcadv_qck    )   ioptio = ioptio + 1
-      IF( lk_esopa         )   ioptio =          1
-
+      INTEGER ::  ios                 ! Local integer output status for namelist read
+      !!
+      NAMELIST/namtrc_adv/ ln_trcadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN
+         &                 ln_trcadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT
+         &                 ln_trcadv_mus,                     ln_mus_ups,   &   ! MUSCL
+         &                 ln_trcadv_ubs,           nn_ubs_v,               &   ! UBS
+         &                 ln_trcadv_qck                                        ! QCK
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnat_ref )              !  namtrc_adv in reference namelist 
+      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! namtrc_adv in configuration namelist
+      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_adv )
+
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_adv : chose a advection scheme for tracers'
+         WRITE(numout,*) '      centered scheme                           ln_trcadv_cen = ', ln_trcadv_cen
+         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v
+         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_trcadv_fct = ', ln_trcadv_fct
+         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v
+         WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts
+         WRITE(numout,*) '      MUSCL scheme                              ln_trcadv_mus = ', ln_trcadv_mus
+         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups
+         WRITE(numout,*) '      UBS scheme                                ln_trcadv_ubs = ', ln_trcadv_ubs
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v
+         WRITE(numout,*) '      QUICKEST scheme                           ln_trcadv_qck = ', ln_trcadv_qck
+      ENDIF
+      !
+
+      ioptio = 0                       !==  Parameter control  ==!
+      IF( ln_trcadv_cen )   ioptio = ioptio + 1
+      IF( ln_trcadv_fct )   ioptio = ioptio + 1
+      IF( ln_trcadv_mus )   ioptio = ioptio + 1
+      IF( ln_trcadv_ubs )   ioptio = ioptio + 1
+      IF( ln_trcadv_qck )   ioptio = ioptio + 1
+
+      !
+      IF( ioptio == 0 ) THEN
+         nadv = np_NO_adv
+         CALL ctl_warn( 'trc_adv_init: You are running without tracer advection.' )
+      ENDIF
       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' )
-
-      !                              ! Set nadv
-      IF( ln_trcadv_cen2   )   nadv =  1
-      IF( ln_trcadv_tvd    )   nadv =  2
-      IF( ln_trcadv_muscl  )   nadv =  3
-      IF( ln_trcadv_muscl2 )   nadv =  4
-      IF( ln_trcadv_ubs    )   nadv =  5
-      IF( ln_trcadv_qck    )   nadv =  6
-      IF( lk_esopa         )   nadv = -1
-
+      !
+      IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &
+                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN
+        CALL ctl_stop( 'trc_adv_init: CEN scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   &
+                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN
+        CALL ctl_stop( 'trc_adv_init: FCT scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_trcadv_fct .AND. nn_fct_zts > 0 ) THEN
+         IF( nn_fct_h == 4 ) THEN
+            nn_fct_h = 2
+            CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' )
+         ENDIF
+         IF( .NOT.ln_linssh ) THEN
+            CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' )
+         ENDIF
+         IF( nn_fct_zts == 1 )   CALL ctl_warn( 'trc_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' )
+      ENDIF
+      IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN
+        CALL ctl_stop( 'trc_adv_init: UBS scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN
+         CALL ctl_warn( 'trc_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
+      ENDIF
+      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities
+         IF(  ln_trcadv_cen .AND. nn_cen_v /= 4    .OR.   &                            ! NO 4th order with ISF
+            & ln_trcadv_fct .AND. nn_fct_v /= 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' )
+      ENDIF
+      !
+      !                                !==  used advection scheme  ==!
+      !                                      ! set nadv
+      IF( ln_trcadv_cen                      )   nadv = np_CEN
+      IF( ln_trcadv_fct                      )   nadv = np_FCT
+      IF( ln_trcadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts
+      IF( ln_trcadv_mus                      )   nadv = np_MUS
+      IF( ln_trcadv_ubs                      )   nadv = np_UBS
+      IF( ln_trcadv_qck                      )   nadv = np_QCK
+      !
       IF(lwp) THEN                   ! Print the choice
          WRITE(numout,*)
-         IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used'
-         IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used'
-         IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used'
-         IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used'
-         IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used'
-         IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used'
-         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme'
-      ENDIF
-      !
-   END SUBROUTINE trc_adv_ctl
+         IF( nadv == np_NO_adv  )   WRITE(numout,*) '         NO passive tracer advection'
+         IF( nadv == np_CEN     )   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   &
+            &                                                                        ' Vertical   order: ', nn_cen_v
+         IF( nadv == np_FCT     )   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   &
+            &                                                                       ' Vertical   order: ', nn_fct_v
+         IF( nadv == np_FCT_zts )   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping'
+         IF( nadv == np_MUS     )   WRITE(numout,*) '         MUSCL    scheme is used'
+         IF( nadv == np_UBS     )   WRITE(numout,*) '         UBS      scheme is used'
+         IF( nadv == np_QCK     )   WRITE(numout,*) '         QUICKEST scheme is used'
+      ENDIF
+      !
+   END SUBROUTINE trc_adv_ini
    
 #else
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90	(revision 6808)
@@ -22,5 +22,4 @@
    USE oce_trc             ! ocean dynamics and active tracers variables
    USE trc                 ! ocean passive tracers variables
-   USE trcnam_trp      ! passive tracers transport namelist variables
    USE trabbl              ! 
    USE prtctl_trc          ! Print control for debbuging
@@ -30,7 +29,4 @@
    PUBLIC   trc_bbl       !  routine called by step.F90
 
-
-   !! * Substitutions
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 6808)
@@ -18,5 +18,4 @@
    USE oce_trc         ! ocean dynamics and tracers variables
    USE trc             ! ocean passive tracers variables
-   USE trcnam_trp      ! passive tracers transport namelist variables
    USE trcdta
    USE tradmp
@@ -29,7 +28,11 @@
    PRIVATE
 
-   PUBLIC trc_dmp            ! routine called by step.F90
-   PUBLIC trc_dmp_clo        ! routine called by step.F90
-   PUBLIC trc_dmp_alloc      ! routine called by nemogcm.F90
+   PUBLIC trc_dmp      
+   PUBLIC trc_dmp_clo   
+   PUBLIC trc_dmp_alloc  
+   PUBLIC trc_dmp_ini    
+
+   INTEGER , PUBLIC ::   nn_zdmp_tr    ! = 0/1/2 flag for damping in the mixed layer
+   CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr    !File containing restoration coefficient
 
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1)
@@ -40,5 +43,5 @@
 
    !! * Substitutions
-#  include "top_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -78,20 +81,14 @@
       !!              - save the trends ('key_trdmxl_trc')
       !!----------------------------------------------------------------------
-      !!
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk, jn, jl       ! dummy loop indices
-      REAL(wp) ::   ztra                 ! temporary scalars
-      CHARACTER (len=22) :: charout
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   ji, jj, jk, jn, jl   ! dummy loop indices
+      CHARACTER (len=22) ::   charout
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrd
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 3D  workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrcdta   ! 3D  workspace
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('trc_dmp')
       !
-      ! 0. Initialization (first time-step only)
-      !    --------------
-      IF( kt == nittrc000 ) CALL trc_dmp_init
-
       IF( l_trdtrc )   CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )   ! temporary save of trends
       !
@@ -105,9 +102,9 @@
             !
             IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
-               
+               !
                jl = n_trc_index(jn) 
                CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) )   ! read tracer data at nit000
                ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:)
-
+               !
                SELECT CASE ( nn_zdmp_tr )
                !
@@ -116,10 +113,9 @@
                      DO jj = 2, jpjm1
                         DO ji = fs_2, fs_jpim1   ! vector opt.
-                           ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
-                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
                         END DO
                      END DO
                   END DO
-               !
+                  !
                CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==!
                   DO jk = 1, jpkm1
@@ -127,23 +123,21 @@
                         DO ji = fs_2, fs_jpim1   ! vector opt.
                            IF( avt(ji,jj,jk) <= 5.e-4_wp )  THEN 
-                              ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
-                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
                            ENDIF
                         END DO
                      END DO
                   END DO
-               !
+                  !
                CASE ( 2 )               !==  no damping in the mixed layer   ==! 
                   DO jk = 1, jpkm1
                      DO jj = 2, jpjm1
                         DO ji = fs_2, fs_jpim1   ! vector opt.
-                           IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
-                              ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
-                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+                           IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
+                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
                            END IF
                         END DO
                      END DO
                   END DO
-               !  
+                  !  
                END SELECT
                ! 
@@ -162,7 +156,8 @@
       IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd )
       !                                          ! print mean trends (used for debugging)
-      IF( ln_ctl )   THEN
-         WRITE(charout, FMT="('dmp ')") ;  CALL prt_ctl_trc_info(charout)
-                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      IF( ln_ctl ) THEN
+         WRITE(charout, FMT="('dmp ')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
       ENDIF
       !
@@ -170,4 +165,65 @@
       !
    END SUBROUTINE trc_dmp
+
+
+   SUBROUTINE trc_dmp_ini
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_dmp_ini  ***
+      !! 
+      !! ** Purpose :   Initialization for the newtonian damping 
+      !!
+      !! ** Method  :   read the nammbf namelist and check the parameters
+      !!              called by trc_dmp at the first timestep (nittrc000)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ios, imask  ! local integers
+      !!
+      NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init')
+      !
+      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping
+      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909)
+909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping
+      READ  ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910)
+910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_dmp )
+
+      IF(lwp) THEN                       ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter'
+         WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)'
+         WRITE(numout,*) '      Restoration coeff file    cn_resto_tr = ', cn_resto_tr
+      ENDIF
+      !
+      IF( lzoom .AND. .NOT.lk_c1d )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries
+      SELECT CASE ( nn_zdmp_tr )
+      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column'
+      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)'
+      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
+      CASE DEFAULT
+         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr
+         CALL ctl_stop(ctmp1)
+      END SELECT
+
+      IF( .NOT.lk_c1d ) THEN
+         IF( .NOT. ln_tradmp )   &
+            &   CALL ctl_stop( 'passive trace damping need ln_tradmp to compute damping coef.' )
+         !
+         !                          ! Read damping coefficients from file
+         !Read in mask from file
+         CALL iom_open ( cn_resto_tr, imask)
+         CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr)
+         CALL iom_close( imask )
+         !
+      ENDIF
+      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init')
+      !
+   END SUBROUTINE trc_dmp_ini
+
 
    SUBROUTINE trc_dmp_clo( kt )
@@ -183,12 +239,11 @@
       !!                nctsi2(), nctsj2() : north-east Closed sea limits (i,j)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !
-      INTEGER :: ji , jj, jk, jn, jl, jc                     ! dummy loop indicesa
-      INTEGER :: isrow                                      ! local index
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace
-
-      !!----------------------------------------------------------------------
-
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   ji , jj, jk, jn, jl, jc   ! dummy loop indicesa
+      INTEGER ::   isrow                     ! local index
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrcdta   ! 3D  workspace
+      !!----------------------------------------------------------------------
+      !
       IF( kt == nit000 ) THEN
          ! initial values
@@ -302,43 +357,4 @@
    END SUBROUTINE trc_dmp_clo
 
-
-   SUBROUTINE trc_dmp_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_dmp_init  ***
-      !! 
-      !! ** Purpose :   Initialization for the newtonian damping 
-      !!
-      !! ** Method  :   read the nammbf namelist and check the parameters
-      !!              called by trc_dmp at the first timestep (nittrc000)
-      !!----------------------------------------------------------------------
-      !
-      INTEGER :: imask  !local file handle
-
-      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init')
-      !
-
-      IF( lzoom )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries
-      SELECT CASE ( nn_zdmp_tr )
-      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column'
-      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)'
-      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
-      CASE DEFAULT
-         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr
-         CALL ctl_stop(ctmp1)
-      END SELECT
-
-      IF( .NOT. ln_tradmp )   &
-         &   CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' )
-      !
-      !                          ! Read damping coefficients from file
-      !Read in mask from file
-      CALL iom_open ( cn_resto_tr, imask)
-      CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr)
-      CALL iom_close( imask )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init')
-      !
-   END SUBROUTINE trc_dmp_init
-
 #else
    !!----------------------------------------------------------------------
@@ -352,5 +368,4 @@
 #endif
 
-
    !!======================================================================
 END MODULE trcdmp
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 6808)
@@ -4,6 +4,7 @@
    !! Ocean Passive tracers : lateral diffusive trends
    !!=====================================================================
-   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
-   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
+   !! History :  1.0  ! 2005-11  (G. Madec)  Original code
+   !!            3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!            3.7  ! 2014-03  (G. Madec)  LDF simplification
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -11,38 +12,45 @@
    !!   'key_top'                                                TOP models
    !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   trc_ldf     : update the tracer trend with the lateral diffusion
-   !!       ldf_ctl : initialization, namelist read, and parameters control
-   !!----------------------------------------------------------------------
-   USE oce_trc         ! ocean dynamics and active tracers
-   USE trc             ! ocean passive tracers variables
-   USE trcnam_trp      ! passive tracers transport namelist variables
-   USE ldftra_oce      ! lateral diffusion coefficient on tracers
-   USE ldfslp          ! ???
-   USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine)
-   USE traldf_bilap    ! lateral mixing            (tra_ldf_bilap routine)
-   USE traldf_iso      ! lateral mixing            (tra_ldf_iso routine)
-   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
-   USE traldf_lap      ! lateral mixing            (tra_ldf_lap routine)
-   USE trd_oce
-   USE trdtra
-   USE prtctl_trc      ! Print control
+   !!   trc_ldf       : update the tracer trend with the lateral diffusion
+   !!   trc_ldf_ini   : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE trc            ! ocean passive tracers variables
+   USE oce_trc        ! ocean dynamics and active tracers
+   USE ldfslp         ! lateral diffusion: iso-neutral slope
+   USE traldf_lap_blp ! lateral diffusion: lap/bilaplacian iso-level      operator  (tra_ldf_lap/_blp   routine)
+   USE traldf_iso     ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso        routine)
+   USE traldf_triad   ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_     triad routine)
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends manager: tracers
+   !
+   USE prtctl_trc     ! Print control
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   trc_ldf    ! called by step.F90
-   !                                                 !!: ** lateral mixing namelist (nam_trcldf) **
-   REAL(wp) ::  rldf_rat    ! ratio between active and passive tracers diffusive coefficient
+   PUBLIC   trc_ldf    
+   PUBLIC   trc_ldf_ini   
+   !
+   LOGICAL , PUBLIC ::   ln_trcldf_lap       !:   laplacian operator
+   LOGICAL , PUBLIC ::   ln_trcldf_blp       !: bilaplacian operator
+   LOGICAL , PUBLIC ::   ln_trcldf_lev       !: iso-level   direction
+   LOGICAL , PUBLIC ::   ln_trcldf_hor       !: horizontal  direction (rotation to geopotential)
+   LOGICAL , PUBLIC ::   ln_trcldf_iso       !: iso-neutral direction (standard)
+   LOGICAL , PUBLIC ::   ln_trcldf_triad     !: iso-neutral direction (triad)
+   REAL(wp), PUBLIC ::   rn_ahtrc_0          !:   laplacian diffusivity coefficient for passive tracer [m2/s]
+   REAL(wp), PUBLIC ::   rn_bhtrc_0          !: bilaplacian      -          --     -       -   [m4/s]
+   !
+   !                      !!: ** lateral mixing namelist (nam_trcldf) **
+   REAL(wp) ::  rldf       ! ratio between active and passive tracers diffusive coefficient
+   
    INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals)
+   
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! NEMO/TOP 3.7 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -55,7 +63,8 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
-      !!
+      !
       INTEGER            :: jn
       CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zahu, zahv
       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd
       !!----------------------------------------------------------------------
@@ -63,44 +72,31 @@
       IF( nn_timing == 1 )   CALL timing_start('trc_ldf')
       !
-      IF( kt == nittrc000 )   CALL ldf_ctl          ! initialisation & control of options
-
-      rldf = rldf_rat
-
       IF( l_trdtrc )  THEN
-         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd )
+         CALL wrk_alloc( jpi,jpj,jpk,jptra,   ztrtrd )
          ztrtrd(:,:,:,:)  = tra(:,:,:,:)
       ENDIF
-
-      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
-      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra        )  ! iso-level laplacian
-      CASE ( 1 )                                                                                            ! rotated laplacian
-                       IF( ln_traldf_grif ) THEN
-                          CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
-                       ELSE
-                          CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 )
-                       ENDIF
-      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            )  ! iso-level bilaplacian
-      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian
-         !
-      CASE ( -1 )                                     ! esopa: test all possibility with control print
-         CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            )
-         WRITE(charout, FMT="('ldf0 ')") ;  CALL prt_ctl_trc_info(charout)
-                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
-         IF( ln_traldf_grif ) THEN
-            CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
-         ELSE
-            CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 )
-         ENDIF
-         WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout)
-                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
-         CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            )
-         WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout)
-                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
-         CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )
-         WRITE(charout, FMT="('ldf3 ')") ;  CALL prt_ctl_trc_info(charout)
-                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      !
+      !                                        !* set the lateral diffusivity coef. for passive tracer      
+      CALL wrk_alloc( jpi,jpj,jpk,   zahu, zahv )
+      zahu(:,:,:) = rldf * ahtu(:,:,:)
+      zahv(:,:,:) = rldf * ahtv(:,:,:)
+
+      SELECT CASE ( nldf )                     !* compute lateral mixing trend and add it to the general trend
+      !
+      CASE ( np_lap   )                               ! iso-level laplacian
+         CALL tra_ldf_lap  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb,      tra, jptra,  1   )
+         !
+      CASE ( np_lap_i )                               ! laplacian : standard iso-neutral operator (Madec)
+         CALL tra_ldf_iso  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   )
+         !
+      CASE ( np_lap_it )                              ! laplacian : triad iso-neutral operator (griffies)
+         CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   )
+         !
+      CASE ( np_blp , np_blp_i , np_blp_it )          ! bilaplacian: all operator (iso-level, -neutral)
+         CALL tra_ldf_blp  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb     , tra, jptra, nldf )
+         !
       END SELECT
       !
-      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+      IF( l_trdtrc )   THEN                    ! send the trends for further diagnostics
         DO jn = 1, jptra
            ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
@@ -109,9 +105,12 @@
         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd )
       ENDIF
-      !                                          ! print mean trends (used for debugging)
-      IF( ln_ctl )   THEN
-         WRITE(charout, FMT="('ldf ')") ;  CALL prt_ctl_trc_info(charout)
-                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
-      ENDIF
+      !                
+      IF( ln_ctl ) THEN                        ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('ldf ')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zahu, zahv )
       !
       IF( nn_timing == 1 )   CALL timing_stop('trc_ldf')
@@ -120,13 +119,11 @@
 
 
-   SUBROUTINE ldf_ctl
+   SUBROUTINE trc_ldf_ini
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ldf_ctl  ***
       !!
-      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion
+      !! ** Purpose :   Define the operator for the lateral diffusion
       !!
       !! ** Method  :   set nldf from the namtra_ldf logicals
-      !!      nldf == -2   No lateral diffusion
-      !!      nldf == -1   ESOPA test: ALL operators are used
       !!      nldf ==  0   laplacian operator
       !!      nldf ==  1   Rotated laplacian operator
@@ -134,124 +131,138 @@
       !!      nldf ==  3   Rotated bilaplacian
       !!----------------------------------------------------------------------
-      INTEGER ::   ioptio, ierr         ! temporary integers
-      !!----------------------------------------------------------------------
-
-      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN
-         IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN
-            rldf_rat = 1.0_wp
-         ELSE
-            CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' )
-         END IF
-      ELSE
-         rldf_rat = rn_ahtrc_0 / rn_aht_0
-      END IF
-      !  Define the lateral mixing oparator for tracers
-      ! ===============================================
-
-      !                               ! control the input
+      INTEGER ::   ioptio, ierr   ! temporary integers
+      INTEGER ::   ios            ! Local integer output status for namelist read
+      !!
+      NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp,                                  &
+         &                 ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad,  &
+         &                 rn_ahtrc_0   , rn_bhtrc_0
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnat_ref )             !  namtrc_ldf in reference namelist 
+      READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp )
+      !
+      REWIND( numnat_cfg )             !  namtrc_ldf in configuration namelist 
+      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_ldf )
+      !
+      IF(lwp) THEN                     ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_ldf_ini : lateral tracer diffusive operator'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)'
+         WRITE(numout,*) '      operator'
+         WRITE(numout,*) '           laplacian                 ln_trcldf_lap   = ', ln_trcldf_lap
+         WRITE(numout,*) '         bilaplacian                 ln_trcldf_blp   = ', ln_trcldf_blp
+         WRITE(numout,*) '      direction of action'
+         WRITE(numout,*) '         iso-level                   ln_trcldf_lev   = ', ln_trcldf_lev
+         WRITE(numout,*) '         horizontal (geopotential)   ln_trcldf_hor   = ', ln_trcldf_hor
+         WRITE(numout,*) '         iso-neutral (standard)      ln_trcldf_iso   = ', ln_trcldf_iso
+         WRITE(numout,*) '         iso-neutral (triad)         ln_trcldf_triad = ', ln_trcldf_triad
+         WRITE(numout,*) '      diffusivity coefficient'
+         WRITE(numout,*) '           laplacian                 rn_ahtrc_0      = ', rn_ahtrc_0
+         WRITE(numout,*) '         bilaplacian                 rn_bhtrc_0      = ', rn_bhtrc_0
+      ENDIF
+      !      
+      !                                ! control the namelist parameters
       ioptio = 0
-      IF( ln_trcldf_lap   )   ioptio = ioptio + 1
-      IF( ln_trcldf_bilap )   ioptio = ioptio + 1
-      IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' )
-      IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion
+      IF( ln_trcldf_lap )   ioptio = ioptio + 1
+      IF( ln_trcldf_blp )   ioptio = ioptio + 1
+      IF( ioptio >  1   )   CALL ctl_stop( 'trc_ldf_ctl: use ONE or NONE of the 2 lap/bilap operator type on tracer' )
+      IF( ioptio == 0   )   nldf = np_no_ldf   ! No lateral diffusion
+      
+      IF( ln_trcldf_lap .AND. ln_trcldf_blp )   CALL ctl_stop( 'trc_ldf_ctl: bilaplacian should be used on both TRC and TRA' )
+      IF( ln_trcldf_blp .AND. ln_trcldf_lap )   CALL ctl_stop( 'trc_ldf_ctl:   laplacian should be used on both TRC and TRA' )
+      !
       ioptio = 0
-      IF( ln_trcldf_level )   ioptio = ioptio + 1
-      IF( ln_trcldf_hor   )   ioptio = ioptio + 1
-      IF( ln_trcldf_iso   )   ioptio = ioptio + 1
-      IF( ioptio /= 1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
-
+      IF( ln_trcldf_lev )   ioptio = ioptio + 1
+      IF( ln_trcldf_hor )   ioptio = ioptio + 1
+      IF( ln_trcldf_iso )   ioptio = ioptio + 1
+      IF( ioptio /= 1   )   CALL ctl_stop( 'trc_ldf_ctl: use only ONE direction (level/hor/iso)' )
+      !
       ! defined the type of lateral diffusion from ln_trcldf_... logicals
       ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully
       ierr = 0
-      IF( ln_trcldf_lap ) THEN       ! laplacian operator
+      IF( ln_trcldf_lap ) THEN      !==  laplacian operator  ==!
          IF ( ln_zco ) THEN                ! z-coordinate
-            IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation)
-            IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation)
-            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_zps ) THEN             ! z-coordinate
-            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed
-            IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation)
-            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_sco ) THEN             ! z-coordinate
-            IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation)
-            IF ( ln_trcldf_hor   )   nldf = 1      ! horizontal (   rotation)
-            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
-         ENDIF
-      ENDIF
-
-      IF( ln_trcldf_bilap ) THEN      ! bilaplacian operator
+            IF ( ln_trcldf_lev   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation)
+            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate with partial step
+            IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed 
+            IF ( ln_trcldf_hor   )   nldf = np_lap     ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! s-coordinate
+            IF ( ln_trcldf_lev   )   nldf = np_lap     ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = np_lap_it  ! horizontal (   rotation)       !!gm   a checker....
+            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         !                                ! diffusivity ratio: passive / active tracers 
+         IF( ABS(rn_aht_0) < 2._wp*TINY(1._wp) ) THEN
+            IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1._wp) ) THEN
+               rldf = 1.0_wp
+            ELSE
+               CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' )
+            ENDIF
+         ELSE
+            rldf = rn_ahtrc_0 / rn_aht_0
+         ENDIF
+      ENDIF
+      !
+      IF( ln_trcldf_blp ) THEN      !==  bilaplacian operator  ==!
          IF ( ln_zco ) THEN                ! z-coordinate
-            IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation)
-            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation)
-            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_zps ) THEN             ! z-coordinate
-            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed
-            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation)
-            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-         IF ( ln_sco ) THEN             ! z-coordinate
-            IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation)
-            IF ( ln_trcldf_hor   )   nldf = 3      ! horizontal (   rotation)
-            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
-         ENDIF
-      ENDIF
-
-      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' )
-      IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' )
-      IF( lk_traldf_eiv .AND. .NOT.ln_trcldf_iso )   &
-           CALL ctl_stop( '          eddy induced velocity on tracers',   &
-           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' )
-      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
-         IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' )
-#if defined key_offline
-         l_traldf_rot = .TRUE.                 ! needed for trazdf_imp
-#endif
-      ENDIF
-
-      IF( lk_esopa ) THEN
-         IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options'
-         nldf = -1
-      ENDIF
-
+            IF ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate with partial step
+            IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed 
+            IF ( ln_trcldf_hor   )   nldf = np_blp     ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! s-coordinate
+            IF ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = np_blp_it  ! horizontal (   rotation)       !!gm   a checker....
+            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         !                                ! diffusivity ratio: passive / active tracers 
+         IF( ABS(rn_bht_0) < 2._wp*TINY(1._wp) ) THEN
+            IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1._wp) ) THEN
+               rldf = 1.0_wp
+            ELSE
+               CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' )
+            ENDIF
+         ELSE
+            rldf = SQRT(  ABS( rn_bhtrc_0 / rn_bht_0 )  )
+         ENDIF
+      ENDIF
+      !
+      IF( ierr == 1 )   CALL ctl_stop( 'trc_ldf_ctl: iso-level in z-partial step, not allowed' )
+      IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso )   CALL ctl_stop( 'trc_ldf_ctl: eiv requires isopycnal laplacian diffusion' )
+      IF( nldf == 1 .OR. nldf == 3 )   l_ldfslp = .TRUE.    ! slope of neutral surfaces required 
+      !
       IF(lwp) THEN
          WRITE(numout,*)
-         IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion'
-         IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used'
-         IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator'
-         IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator'
-         IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator'
-         IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian'
-      ENDIF
-
-      IF( ln_trcldf_bilap ) THEN
-         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion'
-         IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' )
-      ELSE
-         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)'
-         IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' )
-      ENDIF
-
-      ! ratio between active and passive tracers diffusive coef.
-      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN
-         IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN
-            rldf_rat = 1.0_wp
-         ELSE
-            CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' )
-         END IF
-      ELSE
-         rldf_rat = rn_ahtrc_0 / rn_aht_0
-      END IF
-      IF( rldf_rat < 0 ) THEN
-         IF( .NOT.lk_offline ) THEN 
-            CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' )
-         ELSE
-            CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' )
-         ENDIF 
-      ENDIF
-      !
-   END SUBROUTINE ldf_ctl
+         SELECT CASE( nldf )
+         CASE( np_no_ldf )   ;   WRITE(numout,*) '          NO lateral diffusion'
+         CASE( np_lap    )   ;   WRITE(numout,*) '          laplacian iso-level operator'
+         CASE( np_lap_i  )   ;   WRITE(numout,*) '          Rotated laplacian operator (standard)'
+         CASE( np_lap_it )   ;   WRITE(numout,*) '          Rotated laplacian operator (triad)'
+         CASE( np_blp    )   ;   WRITE(numout,*) '          bilaplacian iso-level operator'
+         CASE( np_blp_i  )   ;   WRITE(numout,*) '          Rotated bilaplacian operator (standard)'
+         CASE( np_blp_it )   ;   WRITE(numout,*) '          Rotated bilaplacian operator (triad)'
+         END SELECT
+      ENDIF
+      !
+   END SUBROUTINE trc_ldf_ini
 #else
    !!----------------------------------------------------------------------
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90	(revision 6807)
+++ 	(revision )
@@ -1,195 +1,0 @@
-MODULE trcnam_trp
-   !!======================================================================
-   !!                       ***  MODULE  trcnam_trp  ***
-   !! TOP :   namelist read options for transport
-   !!======================================================================
-   !! History :   1.0  !  2004-03  (C. Ethe)  Original code
-   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   !!   trc_nam_trp  : read the passive tracer namelist for transport
-   !!----------------------------------------------------------------------
-   USE trc                 ! passive tracers variables
-   USE in_out_manager      ! ocean dynamics and active tracers variables
-   USE lib_mpp           ! distributed memory computing library
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   trc_nam_trp    ! routine called by step module
- 
-   !                                        !!: ** Advection (namtrc_adv) **
-   LOGICAL , PUBLIC ::   ln_trcadv_cen2      ! 2nd order centered scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_tvd       ! TVD scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_muscl     ! MUSCL scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_muscl2    ! MUSCL2 scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_ubs       ! UBS scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_qck       ! QUICKEST scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_msc_ups   ! use upstream scheme within muscl
-
-
-   !                                        !!: ** lateral mixing namelist (nam_trcldf) **
-   LOGICAL , PUBLIC ::   ln_trcldf_lap       !: laplacian operator
-   LOGICAL , PUBLIC ::   ln_trcldf_bilap     !: bilaplacian operator
-   LOGICAL , PUBLIC ::   ln_trcldf_level     !: iso-level direction
-   LOGICAL , PUBLIC ::   ln_trcldf_hor       !: horizontal (geopotential) direction
-   LOGICAL , PUBLIC ::   ln_trcldf_iso       !: iso-neutral direction
-   REAL(wp), PUBLIC ::   rn_ahtrc_0          !: diffusivity coefficient for passive tracer (m2/s)
-   REAL(wp), PUBLIC ::   rn_ahtrb_0          !: background diffusivity coefficient for passive tracer (m2/s)
-
-   !                                        !!: ** Treatment of Negative concentrations ( nam_trcrad )
-   LOGICAL , PUBLIC ::   ln_trcrad           !: flag to artificially correct negative concentrations
-
-   !                                        !!: ** Vertical diffusion (nam_trczdf) **
-   LOGICAL , PUBLIC ::   ln_trczdf_exp       !: explicit vertical diffusion scheme flag
-   INTEGER , PUBLIC ::   nn_trczdf_exp       !: number of sub-time step (explicit time stepping)
-
-   !                                                 !!: ** newtonian damping namelist (nam_trcdmp) **
-   !                          !!* Namelist namtrc_dmp : passive tracer newtonian damping *
-   INTEGER , PUBLIC ::   nn_zdmp_tr    ! = 0/1/2 flag for damping in the mixed layer
-   CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr    !File containing restoration coefficient
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_nam_trp
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_nam_trp  ***
-      !!                
-      !! ** Purpose :   Read Namelist for tracer transport option
-      !!----------------------------------------------------------------------
-      INTEGER ::  ios                 ! Local integer output status for namelist read
-      NAMELIST/namtrc_adv/ ln_trcadv_cen2 , ln_trcadv_tvd   ,    &
-         &                 ln_trcadv_muscl, ln_trcadv_muscl2,    &
-         &                 ln_trcadv_ubs  , ln_trcadv_qck, ln_trcadv_msc_ups
-
-      NAMELIST/namtrc_ldf/ ln_trcldf_lap  ,     &
-         &                 ln_trcldf_bilap, ln_trcldf_level,     &
-         &                 ln_trcldf_hor  , ln_trcldf_iso  , rn_ahtrc_0, rn_ahtrb_0
-      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp
-      NAMELIST/namtrc_rad/ ln_trcrad
-      NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' trc_nam_trp: read namelist for tracer transport'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
-
-      REWIND( numnat_ref )              ! Namelist namtrc_adv in reference namelist : Tracer advection scheme
-      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp )
-
-      REWIND( numnat_cfg )              ! Namelist namtrc_adv in configuration namelist : Tracer advection scheme
-      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp )
-      IF(lwm) WRITE ( numont, namtrc_adv )
-
-      IF(lwp) THEN                    ! Namelist print
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_adv_ctl : choice/control of the tracer advection scheme'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namtrc_adv : chose a advection scheme for tracers'
-         WRITE(numout,*) '      2nd order advection scheme     ln_trcadv_cen2   = ', ln_trcadv_cen2
-         WRITE(numout,*) '      TVD advection scheme           ln_trcadv_tvd    = ', ln_trcadv_tvd
-         WRITE(numout,*) '      MUSCL  advection scheme        ln_trcadv_muscl  = ', ln_trcadv_muscl
-         WRITE(numout,*) '      MUSCL2 advection scheme        ln_trcadv_muscl2 = ', ln_trcadv_muscl2
-         WRITE(numout,*) '      UBS    advection scheme        ln_trcadv_ubs    = ', ln_trcadv_ubs
-         WRITE(numout,*) '      QUICKEST advection scheme      ln_trcadv_qck    = ', ln_trcadv_qck
-      ENDIF
-      !
-      REWIND( numnat_ref )              ! Namelist namtrc_ldf in reference namelist : Tracer lateral diffusive operator
-      READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903)
-903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp )
-
-      REWIND( numnat_cfg )              ! Namelist namtrc_ldf in configuration namelist : Tracer lateral diffusive operator
-      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 )
-904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp )
-      IF(lwm) WRITE ( numont, namtrc_ldf )
-
-      IF(lwp) THEN                    ! Namelist print
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc:ldf_ctl : lateral tracer diffusive operator'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)'
-         WRITE(numout,*) '      laplacian operator                                 ln_trcldf_lap   = ', ln_trcldf_lap
-         WRITE(numout,*) '      bilaplacian operator                               ln_trcldf_bilap = ', ln_trcldf_bilap
-         WRITE(numout,*) '      iso-level                                          ln_trcldf_level = ', ln_trcldf_level
-         WRITE(numout,*) '      horizontal (geopotential)                          ln_trcldf_hor   = ', ln_trcldf_hor
-         WRITE(numout,*) '      iso-neutral                                        ln_trcldf_iso   = ', ln_trcldf_iso
-         WRITE(numout,*) '      diffusivity coefficient                                 rn_ahtrc_0 = ', rn_ahtrc_0
-         WRITE(numout,*) '      background hor. diffusivity                             rn_ahtrb_0 = ', rn_ahtrb_0
-      ENDIF
-
-      !                                ! Vertical mixing
-      REWIND( numnat_ref )              ! Namelist namtrc_zdf in reference namelist : Tracer vertical mixing
-      READ  ( numnat_ref, namtrc_zdf, IOSTAT = ios, ERR = 905)
-905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in reference namelist', lwp )
-
-      REWIND( numnat_cfg )              ! Namelist namtrc_zdf in configuration namelist : Tracer vertical mixing
-      READ  ( numnat_cfg, namtrc_zdf, IOSTAT = ios, ERR = 906 )
-906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in configuration namelist', lwp )
-      IF(lwm) WRITE ( numont, namtrc_zdf )
-
-      IF(lwp) THEN                     !   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namtrc_zdf : set vertical diffusion parameters'
-         WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp
-         WRITE(numout,*) '      number of time step              nn_trczdf_exp = ', nn_trczdf_exp
-      ENDIF
-
-      !
-      REWIND( numnat_ref )              ! Namelist namtrc_rad in reference namelist : Tracer negative concentrations
-      READ  ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907)
-907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp )
-
-      REWIND( numnat_cfg )              ! Namelist namtrc_rad in configuration namelist : Tracer negative concentrations
-      READ  ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 )
-908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp )
-      IF(lwm) WRITE ( numont, namtrc_rad )
-
-      IF(lwp) THEN                     !   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namtrc_rad : treatment of negative concentrations'
-         WRITE(numout,*) '      correct artificially negative concen. or not ln_trcrad = ', ln_trcrad
-      ENDIF
-
-
-      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping
-      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909)
-909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp )
-
-      REWIND( numnat_cfg )              ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping
-      READ  ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910)
-910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp )
-      IF(lwm) WRITE ( numont, namtrc_dmp )
-
-      IF(lwp) THEN                       ! Namelist print
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping'
-         WRITE(numout,*) '~~~~~~~'
-         WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter'
-         WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)'
-         WRITE(numout,*) '      Restoration coeff file    cn_resto_tr = ', cn_resto_tr
-      ENDIF
-      !
-   END SUBROUTINE trc_nam_trp
-   
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                                         No TOP model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_nam_trp              ! Empty routine
-   END SUBROUTINE trc_nam_trp
-#endif
-
-  !!======================================================================
-END MODULE trcnam_trp
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 6808)
@@ -33,4 +33,6 @@
    USE trdtra
    USE tranxt
+   USE trcbdy          ! BDY open boundaries
+   USE bdy_par, only: lk_bdy
 # if defined key_agrif
    USE agrif_top_interp
@@ -41,7 +43,6 @@
 
    PUBLIC   trc_nxt          ! routine called by step.F90
-   PUBLIC   trc_nxt_alloc    ! routine called by nemogcm.F90
 
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt
+   REAL(wp) ::   r2dttrc
 
    !!----------------------------------------------------------------------
@@ -51,15 +52,4 @@
    !!----------------------------------------------------------------------
 CONTAINS
-
-   INTEGER FUNCTION trc_nxt_alloc()
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE trc_nxt_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc )
-      !
-      IF( trc_nxt_alloc /= 0 )   CALL ctl_warn('trc_nxt_alloc : failed to allocate array')
-      !
-   END FUNCTION trc_nxt_alloc
-
 
    SUBROUTINE trc_nxt( kt )
@@ -101,32 +91,25 @@
          WRITE(numout,*) 'trc_nxt : time stepping on passive tracers'
       ENDIF
-
-      ! Update after tracer on domain lateral boundaries
-      DO jn = 1, jptra
+      !
+#if defined key_agrif
+      CALL Agrif_trc                   ! AGRIF zoom boundaries
+#endif
+      DO jn = 1, jptra                 ! Update after tracer on domain lateral boundaries
          CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )   
       END DO
 
+      IF( lk_bdy )  CALL trc_bdy( kt )
 
-#if defined key_bdy
-!!      CALL bdy_trc( kt )               ! BDY open boundaries
-#endif
-#if defined key_agrif
-      CALL Agrif_trc                   ! AGRIF zoom boundaries
-#endif
-
-
-      ! set time step size (Euler/Leapfrog)
-      IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nittrc000             (Euler)
-      ELSEIF( kt <= nittrc000 + nn_dttrc )     THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog)
+      !                                ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dttrc =     rdttrc   ! at nittrc000             (Euler)
+      ELSEIF( kt <= nittrc000 + nn_dttrc )     THEN  ;  r2dttrc = 2.* rdttrc   ! at nit000 or nit000+1 (Leapfrog)
       ENDIF
 
-      ! trends computation initialisation
-      IF( l_trdtrc )  THEN
-         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt )  !* store now fields before applying the Asselin filter
+      IF( l_trdtrc )  THEN             ! trends: store now fields before the Asselin filter application
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt )
          ztrdt(:,:,:,:)  = trn(:,:,:,:)
       ENDIF
-      ! Leap-Frog + Asselin filter time stepping
-      IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step
-         !                                                ! (only swap)
+      !                                ! Leap-Frog + Asselin filter time stepping
+      IF( neuler == 0 .AND. kt == nittrc000 ) THEN    ! Euler time-stepping at first time-step (only swap)
          DO jn = 1, jptra
             DO jk = 1, jpkm1
@@ -134,18 +117,21 @@
             END DO
          END DO
-         !                                              
-      ELSE
-         ! Leap-Frog + Asselin filter time stepping
-         IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      &
-           &                                                                sbc_trc, sbc_trc_b, jptra )      ! variable volume level (vvl) 
-         ELSE                ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )      ! fixed    volume level 
+      ELSE                                            ! Asselin filter + swap
+         IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )  !     linear ssh
+         ELSE                   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      &
+           &                                                                   sbc_trc, sbc_trc_b, jptra )  ! non-linear ssh
          ENDIF
+         !
+         DO jn = 1, jptra
+            CALL lbc_lnk( trb(:,:,:,jn), 'T', 1._wp ) 
+            CALL lbc_lnk( trn(:,:,:,jn), 'T', 1._wp )
+            CALL lbc_lnk( tra(:,:,:,jn), 'T', 1._wp )
+         END DO
       ENDIF
-
-      ! trends computation
-      IF( l_trdtrc ) THEN                                      ! trends
+      !
+      IF( l_trdtrc ) THEN              ! trends: send Asselin filter trends to trdtra manager for further diagnostics
          DO jn = 1, jptra
             DO jk = 1, jpkm1
-               zfact = 1.e0 / r2dt(jk)  
+               zfact = 1._wp / r2dttrc  
                ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 
                CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 6808)
@@ -22,8 +22,9 @@
    PRIVATE
 
-   PUBLIC trc_rad         ! routine called by trcstp.F90
-
-   !! * Substitutions
-#  include "top_substitute.h90"
+   PUBLIC trc_rad     
+   PUBLIC trc_rad_ini  
+
+   LOGICAL , PUBLIC ::   ln_trcrad           !: flag to artificially correct negative concentrations
+
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -76,4 +77,32 @@
       !
    END SUBROUTINE trc_rad
+
+   SUBROUTINE trc_rad_ini
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trc _rad_ini ***
+      !!
+      !! ** Purpose : read  namelist options 
+      !!----------------------------------------------------------------------
+      INTEGER ::  ios                 ! Local integer output status for namelist read
+      NAMELIST/namtrc_rad/ ln_trcrad
+      !!----------------------------------------------------------------------
+
+      !
+      REWIND( numnat_ref )              ! namtrc_rad in reference namelist 
+      READ  ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907)
+907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! namtrc_rad in configuration namelist 
+      READ  ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 )
+908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_rad )
+
+      IF(lwp) THEN                     !   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrc_rad : treatment of negative concentrations'
+         WRITE(numout,*) '      correct artificially negative concen. or not ln_trcrad = ', ln_trcrad
+      ENDIF
+      !
+   END SUBROUTINE trc_rad_ini
 
    SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 6808)
@@ -28,8 +28,6 @@
    PUBLIC   trc_sbc   ! routine called by step.F90
 
-   REAL(wp) ::   r2dt  !  time-step at surface
-
    !! * Substitutions
-#  include "top_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -75,6 +73,6 @@
       !
       ! Allocate temporary workspace
-                      CALL wrk_alloc( jpi, jpj,      zsfx   )
-      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )
+                      CALL wrk_alloc( jpi,jpj,       zsfx   )
+      IF( l_trdtrc )  CALL wrk_alloc( jpi,jpj,jpk,   ztrtrd )
       !
       zrtrn = 1.e-15_wp
@@ -83,14 +81,14 @@
          CASE( 0    )   ;   zswitch = 1  ! (0) standard levitating sea-ice : salt exchange only
          CASE( 1, 2 )   ;   zswitch = 0  ! (1) levitating sea-ice: salt and volume exchange but no pressure effect                                
-                                         ! (2) embedded sea-ice : salt and volume fluxes and pressure
+      !                                  ! (2) embedded sea-ice : salt and volume fluxes and pressure
       END SELECT
 
       IF( ln_top_euler) THEN
-         r2dt =  rdttrc(1)              ! = rdttrc (use Euler time stepping)
+         r2dt =  rdttrc              ! = rdttrc (use Euler time stepping)
       ELSE
          IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000
-            r2dt = rdttrc(1)           ! = rdttrc (restarting with Euler time stepping)
+            r2dt = rdttrc            ! = rdttrc (restarting with Euler time stepping)
          ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1
-            r2dt = 2. * rdttrc(1)       ! = 2 rdttrc (leapfrog)
+            r2dt = 2. * rdttrc       ! = 2 rdttrc (leapfrog)
          ENDIF
       ENDIF
@@ -128,5 +126,5 @@
       ! Coupling offline : runoff are in emp which contains E-P-R
       !
-      IF( .NOT. lk_offline .AND. lk_vvl ) THEN  ! online coupling with vvl
+      IF( .NOT. lk_offline .AND. .NOT.ln_linssh ) THEN  ! online coupling with vvl
          zsfx(:,:) = 0._wp
       ELSE                                      ! online coupling free surface or offline with free surface
@@ -137,6 +135,5 @@
       DO jn = 1, jptra
          !
-         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends
-         !                                             ! add the trend to the general tracer trend
+         IF( l_trdtrc )   ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends
 
          IF ( nn_ice_tr == -1 ) THEN  ! No tracers in sea ice (null concentration in sea ice)
@@ -152,5 +149,5 @@
             DO jj = 2, jpj
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zse3t = 1. / fse3t(ji,jj,1)
+                  zse3t = 1. / e3t_n(ji,jj,1)
                   ! tracer flux at the ice/ocean interface (tracer/m2/s)
                   zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice
@@ -173,5 +170,5 @@
          DO jj = 2, jpj
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zse3t = zfact / fse3t(ji,jj,1)
+               zse3t = zfact / e3t_n(ji,jj,1)
                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t
             END DO
@@ -202,6 +199,6 @@
                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
       ENDIF
-                      CALL wrk_dealloc( jpi, jpj,      zsfx   )
-      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd )
+                      CALL wrk_dealloc( jpi,jpj,       zsfx   )
+      IF( l_trdtrc )  CALL wrk_dealloc( jpi,jpj,jpk,   ztrtrd )
       !
       IF( nn_timing == 1 )  CALL timing_stop('trc_sbc')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 6808)
@@ -15,8 +15,6 @@
    USE oce_trc         ! ocean dynamics and active tracers variables
    USE trc             ! ocean passive tracers variables 
-   USE trcnam_trp      ! passive tracers transport namelist variables
    USE trabbl          ! bottom boundary layer               (trc_bbl routine)
    USE trcbbl          ! bottom boundary layer               (trc_bbl routine)
-   USE zdfkpp          ! KPP non-local tracer fluxes         (trc_kpp routine)
    USE trcdmp          ! internal damping                    (trc_dmp routine)
    USE trcldf          ! lateral mixing                      (trc_ldf routine)
@@ -27,4 +25,6 @@
    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
@@ -38,6 +38,4 @@
    PUBLIC   trc_trp    ! called by trc_stp
 
-   !! * Substitutions
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -48,5 +46,5 @@
 CONTAINS
 
-   SUBROUTINE trc_trp( kstp )
+   SUBROUTINE trc_trp( kt )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE trc_trp  ***
@@ -57,5 +55,5 @@
       !!              - Update the passive tracers
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index
+      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index
       !! ---------------------------------------------------------------------
       !
@@ -64,36 +62,35 @@
       IF( .NOT. lk_c1d ) THEN
          !
-                                CALL trc_sbc( kstp )            ! surface boundary condition
-         IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme
-         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
-                                CALL trc_adv( kstp )            ! horizontal & vertical advection 
-                                CALL trc_ldf( kstp )            ! lateral mixing
-         IF( .NOT. lk_offline .AND. lk_zdfkpp )    &
-            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes
+                                CALL trc_sbc    ( kt )      ! surface boundary condition
+         IF( lk_trabbl )        CALL trc_bbl    ( kt )      ! advective (and/or diffusive) bottom boundary layer scheme
+         IF( ln_trcdmp )        CALL trc_dmp    ( kt )      ! internal damping trends
+         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kt )      ! internal damping trends on closed seas only
+         IF( lk_bdy )           CALL trc_bdy_dmp( kt )      ! BDY damping trends
+                                CALL trc_adv    ( kt )      ! horizontal & vertical advection 
+         !                                                         ! Partial top/bottom cell: GRADh( trb )  
+         IF( ln_zps ) THEN
+           IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! both top & bottom
+           ELSE                 ; CALL zps_hde    ( kt, jptra, trb, gtru, gtrv )                                      !  only bottom
+           ENDIF
+         ENDIF
+         !                                                      
+                                CALL trc_ldf    ( kt )      ! lateral mixing
 #if defined key_agrif
-         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge
+         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc       ! tracers sponge
 #endif
-                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields
-                                CALL trc_nxt( kstp )            ! tracer fields at next time step     
-         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations
+                                CALL trc_zdf    ( kt )      ! vertical mixing and after tracer fields
+                                CALL trc_nxt    ( kt )      ! tracer fields at next time step     
+         IF( ln_trcrad )        CALL trc_rad    ( kt )      ! Correct artificial negative concentrations
 
 #if defined key_agrif
-      IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )   ! Update tracer at AGRIF zoom boundaries : children only
+         IF( .NOT.Agrif_Root()) CALL Agrif_Update_Trc( kt ) ! Update tracer at AGRIF zoom boundaries : children only
 #endif
-
-         IF( ln_zps  .AND. .NOT. ln_isfcav)        &
-            &            CALL zps_hde    ( kstp, jptra, trn, gtru, gtrv )   ! Partial steps: now horizontal gradient of passive
-         IF( ln_zps .AND.        ln_isfcav)        &
-            &            CALL zps_hde_isf( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! Partial steps: now horizontal gradient of passive
-                                                                ! tracers at the bottom ocean level
          !
       ELSE                                               ! 1D vertical configuration
-                                CALL trc_sbc( kstp )            ! surface boundary condition
-         IF( .NOT. lk_offline .AND. lk_zdfkpp )    &
-            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes
-                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields
-                                CALL trc_nxt( kstp )            ! tracer fields at next time step     
-          IF( ln_trcrad )       CALL trc_rad( kstp )            ! Correct artificial negative concentrations
+                                CALL trc_sbc( kt )            ! surface boundary condition
+         IF( ln_trcdmp )        CALL trc_dmp( kt )            ! internal damping trends
+                                CALL trc_zdf( kt )            ! vertical mixing and after tracer fields
+                                CALL trc_nxt( kt )            ! tracer fields at next time step     
+          IF( ln_trcrad )       CALL trc_rad( kt )            ! Correct artificial negative concentrations
          !
       END IF
@@ -108,7 +105,7 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE trc_trp( kstp )              ! Empty routine
-      INTEGER, INTENT(in) ::   kstp
-      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kstp
+   SUBROUTINE trc_trp( kt )              ! Empty routine
+      INTEGER, INTENT(in) ::   kt
+      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt
    END SUBROUTINE trc_trp
 #endif
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90	(revision 6808)
@@ -11,48 +11,40 @@
    !!   'key_top'                                                TOP models
    !!----------------------------------------------------------------------
-   !!   trc_ldf     : update the tracer trend with the lateral diffusion
-   !!       ldf_ctl : initialization, namelist read, and parameters control
+   !!   trc_zdf      : update the tracer trend with the lateral diffusion
+   !!   trc_zdf_ini  : initialization, namelist read, and parameters control
    !!----------------------------------------------------------------------
-   USE oce_trc         ! ocean dynamics and active tracers
-   USE trc             ! ocean passive tracers variables
-   USE trcnam_trp      ! passive tracers transport namelist variables
-   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine)
-   USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine)
-   USE trd_oce
-   USE trdtra
-   USE prtctl_trc      ! Print control
+   USE trc           ! ocean passive tracers variables
+   USE oce_trc       ! ocean dynamics and active tracers
+   USE trd_oce       ! trends: ocean variables
+   USE trazdf_exp    ! vertical diffusion: explicit (tra_zdf_exp     routine)
+   USE trazdf_imp    ! vertical diffusion: implicit (tra_zdf_imp     routine)
+   USE trcldf        ! passive tracers: lateral diffusion
+   USE trdtra        ! trends manager: tracers 
+   USE prtctl_trc    ! Print control
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   trc_zdf          ! called by step.F90 
-   PUBLIC   trc_zdf_alloc    ! called by nemogcm.F90 
+   PUBLIC   trc_zdf         ! called by step.F90 
+   PUBLIC   trc_zdf_ini     ! called by nemogcm.F90 
+   
+   !                                        !!** Vertical diffusion (nam_trczdf) **
+   LOGICAL , PUBLIC ::   ln_trczdf_exp       !: explicit vertical diffusion scheme flag
+   INTEGER , PUBLIC ::   nn_trczdf_exp       !: number of sub-time step (explicit time stepping)
 
    INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used
       !                                ! defined from ln_zdf...  namlist logicals)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  r2dt   ! vertical profile time-step, = 2 rdttra
-      !                                                 ! except at nittrc000 (=rdttra) if neuler=0
+   REAL(wp) ::  r2dttrc   ! vertical profile time-step, = 2 rdt
+      !                   ! except at nittrc000 (=rdt) if neuler=0
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "zdfddm_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! NEMO/TOP 3.7 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
-   
-   INTEGER FUNCTION trc_zdf_alloc()
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_zdf_alloc  ***
-      !!----------------------------------------------------------------------
-      ALLOCATE( r2dt(jpk) , STAT=trc_zdf_alloc )
-      !
-      IF( trc_zdf_alloc /= 0 )   CALL ctl_warn('trc_zdf_alloc : failed to allocate array.')
-      !
-   END FUNCTION trc_zdf_alloc
-
 
    SUBROUTINE trc_zdf( kt )
@@ -71,10 +63,8 @@
       IF( nn_timing == 1 )  CALL timing_start('trc_zdf')
       !
-      IF( kt == nittrc000 )   CALL zdf_ctl          ! initialisation & control of options
-
       IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000
-         r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping)
+         r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping)
       ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1
-         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
+         r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog)
       ENDIF
 
@@ -85,14 +75,6 @@
 
       SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
-      CASE ( -1 )                                       ! esopa: test all possibility with control print
-         CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) 
-         WRITE(charout, FMT="('zdf1 ')") ;  CALL prt_ctl_trc_info(charout)
-                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
-         CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra ) 
-         WRITE(charout, FMT="('zdf2 ')") ;  CALL prt_ctl_trc_info(charout)
-                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
-      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme 
-      CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme          
-
+      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dttrc, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme 
+      CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc,                trb, tra, jptra )    !   implicit scheme          
       END SELECT
 
@@ -100,5 +82,5 @@
          DO jn = 1, jptra
             DO jk = 1, jpkm1
-               ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn)
+               ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dttrc ) - ztrtrd(:,:,jk,jn)
             END DO
             CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) )
@@ -117,7 +99,7 @@
 
 
-   SUBROUTINE zdf_ctl
+   SUBROUTINE trc_zdf_ini
       !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE zdf_ctl  ***
+      !!                 ***  ROUTINE trc_zdf_ini  ***
       !!
       !! ** Purpose :   Choose the vertical mixing scheme
@@ -128,30 +110,41 @@
       !!      NB: The implicit scheme is required when using : 
       !!             - rotated lateral mixing operator
-      !!             - TKE, GLS or KPP vertical mixing scheme
+      !!             - TKE, GLS vertical mixing scheme
       !!----------------------------------------------------------------------
-
-      !  Define the vertical tracer physics scheme
-      ! ==========================================
-
-      ! Choice from ln_zdfexp already read in namelist in zdfini module
-      IF( ln_trczdf_exp ) THEN           ! use explicit scheme
-         nzdf = 0
-      ELSE                               ! use implicit scheme
-         nzdf = 1
+      INTEGER ::  ios                 ! Local integer output status for namelist read
+      !!
+      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnat_ref )             ! namtrc_zdf in reference namelist 
+      READ  ( numnat_ref, namtrc_zdf, IOSTAT = ios, ERR = 905)
+905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in reference namelist', lwp )
+      !
+      REWIND( numnat_cfg )             ! namtrc_zdf in configuration namelist 
+      READ  ( numnat_cfg, namtrc_zdf, IOSTAT = ios, ERR = 906 )
+906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_zdf )
+      !
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrc_zdf : set vertical diffusion  parameters'
+         WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp
+         WRITE(numout,*) '      number of time step              nn_trczdf_exp = ', nn_trczdf_exp
       ENDIF
 
-      ! Force implicit schemes
-      IF( ln_trcldf_iso                               )   nzdf = 1      ! iso-neutral lateral physics
-      IF( ln_trcldf_hor .AND. ln_sco                  )   nzdf = 1      ! horizontal lateral physics in s-coordinate
-#if defined key_zdftke || defined key_zdfgls || defined key_zdfkpp
-                                                          nzdf = 1      ! TKE, GLS or KPP physics       
-#endif
-      IF( ln_trczdf_exp .AND. nzdf == 1 )   THEN
-         CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS or KPP vertical scheme ', &
-            &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' )
+      !                                ! Define the vertical tracer physics scheme
+      IF( ln_trczdf_exp ) THEN   ;   nzdf = 0     ! explicit scheme
+      ELSE                       ;   nzdf = 1     ! implicit scheme
       ENDIF
 
-      ! Test: esopa
-      IF( lk_esopa )    nzdf = -1                      ! All schemes used
+      !                                ! Force implicit schemes
+      IF( ln_trcldf_iso              )   nzdf = 1      ! iso-neutral lateral physics
+      IF( ln_trcldf_hor .AND. ln_sco )   nzdf = 1      ! horizontal lateral physics in s-coordinate
+#if defined key_zdftke || defined key_zdfgls 
+                                         nzdf = 1      ! TKE or GLS physics       
+#endif
+      IF( ln_trczdf_exp .AND. nzdf == 1 )  & 
+         CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS vertical scheme ', &
+            &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' )
 
       IF(lwp) THEN
@@ -159,10 +152,10 @@
          WRITE(numout,*) 'trc:zdf_ctl : vertical passive tracer physics scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
-         IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
          IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme'
          IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
       ENDIF
-
-   END SUBROUTINE zdf_ctl
+      !
+   END SUBROUTINE trc_zdf_ini
+   
 #else
    !!----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90	(revision 6808)
@@ -8,5 +8,5 @@
    !!                 !  07-06  (C. Deltel)  key_gyre : do not call lbc_lnk
    !!----------------------------------------------------------------------
-#if   defined key_top && ( defined key_trdmxl_trc   ||   defined key_esopa )
+#if   defined key_top   &&   defined key_trdmxl_trc
    !!----------------------------------------------------------------------
    !!   'key_trdmxl_trc'                      mixed layer trend diagnostics
@@ -24,5 +24,4 @@
    USE zdfddm  , ONLY : avs  ! salinity vertical diffusivity coeff. at w-point
 # endif
-   USE trcnam_trp        ! passive tracers transport namelist variables
    USE trdtrc_oce    ! definition of main arrays used for trends computations
    USE in_out_manager    ! I/O manager
@@ -67,5 +66,4 @@
 
    !! * Substitutions
-#  include "top_substitute.h90"
 #  include "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
@@ -176,5 +174,5 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk)
+                  IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
                END DO
             END DO
@@ -294,5 +292,5 @@
             DO jj = 1,jpj
               DO ji = 1,jpi
-                  IF( jk - nmld_trc(ji,jj) < 0. )   wkx_trc(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk)
+                  IF( jk - nmld_trc(ji,jj) < 0. )   wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
                END DO
             END DO
@@ -331,5 +329,5 @@
       !! 
       !! ** Purpose :  Compute and cumulate the mixed layer trends over an analysis
-      !!               period, and write NetCDF (or dimg) outputs.
+      !!               period, and write NetCDF outputs.
       !!
       !! ** Method/usage :
@@ -391,8 +389,4 @@
       !
       CHARACTER (LEN=10) ::   clvar
-#if defined key_dimgout
-      INTEGER ::   iyear,imon,iday
-      CHARACTER(LEN=80) ::   cltext, clmode
-#endif
       !!----------------------------------------------------------------------
 
@@ -418,5 +412,5 @@
                DO jn = 1, jptra
                   IF( ln_trdtrc(jn) )    &
-                  tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  &
+                  tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / e3w_n(ji,jj,ik) * tmask(ji,jj,ik)  &
                        &                    * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) )            &
                        &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1)
@@ -775,12 +769,5 @@
       ! ======================================================================
 
-      ! IV.1 Code for dimg mpp output
-      ! -----------------------------
-
-# if defined key_dimgout
-      STOP 'Not implemented'
-# else
-      
-      ! IV.2 Code for IOIPSL/NetCDF output
+      ! IV.1 Code for IOIPSL/NetCDF output
       ! ----------------------------------
 
@@ -866,6 +853,4 @@
       icount = 1
 
-# endif /* key_dimgout */
-
       IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN
          !
@@ -897,5 +882,5 @@
       !!
       !! ** Purpose :  Compute and cumulate the mixed layer biological trends over an analysis
-      !!               period, and write NetCDF (or dimg) outputs.
+      !!               period, and write NetCDF outputs.
       !!
       !! ** Method/usage :
@@ -944,8 +929,4 @@
       LOGICAL  :: llwarn  = .TRUE., lldebug = .TRUE.
       REAL(wp) :: zfn, zfn2
-#if defined key_dimgout
-      INTEGER ::  iyear,imon,iday
-      CHARACTER(LEN=80) :: cltext, clmode
-#endif
       !!----------------------------------------------------------------------
       ! ... Warnings
@@ -1056,12 +1037,5 @@
       ! ======================================================================
 
-      ! IV.1 Code for dimg mpp output
-      ! -----------------------------
-
-# if defined key_dimgout
-      STOP 'Not implemented'
-# else
-
-      ! IV.2 Code for IOIPSL/NetCDF output
+      ! IV.1 Code for IOIPSL/NetCDF output
       ! ----------------------------------
 
@@ -1108,5 +1082,4 @@
 
 
-# endif /* key_dimgout */
 
       IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN
@@ -1259,7 +1232,4 @@
       ! ======================================================================
 
-#if defined key_dimgout 
-      ???
-#else
       ! clmxl = legend root for netCDF output
       IF( nn_ctls_trc == 0 ) THEN                                   ! control surface = mixed-layer with density criterion
@@ -1404,5 +1374,4 @@
 #endif
 
-#endif        /* key_dimgout */
    END SUBROUTINE trd_mxl_trc_init
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90	(revision 6808)
@@ -21,4 +21,5 @@
   
    INTEGER ::   nummldw_trc               ! logical unit for mld restart
+   
    !!---------------------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -26,7 +27,5 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!---------------------------------------------------------------------------------
-  
 CONTAINS
-  
 
     SUBROUTINE trd_mxl_trc_rst_write( kt )
@@ -147,12 +146,4 @@
       clpath = TRIM(cn_trcrst_indir)
       IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
-
-      IF ( jprstlib == jprstdimg ) THEN
-        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
-        ! if {cn_trdrst_trc_in}.nc exists, then set jlibalt to jpnf90
-        INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok )
-        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
-      ENDIF
-
       CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum, kiolib = jlibalt ) 
       
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90	(revision 6808)
@@ -14,5 +14,4 @@
    !!----------------------------------------------------------------------
    USE trc               ! tracer definitions (trn, trb, tra, etc.)
-   USE trcnam_trp
    USE trd_oce
    USE trdtrc_oce       ! definition of main arrays used for trends computations
@@ -29,6 +28,4 @@
    PUBLIC trd_trc
 
-   !! * Substitutions
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90	(revision 6808)
@@ -4,5 +4,5 @@
    !! Ocean trends :   set tracer and momentum trend variables
    !!======================================================================
-#if defined key_top   ||   defined key_esopa
+#if defined key_top
    !!----------------------------------------------------------------------
    !!   'key_top'                                                TOP models
@@ -30,5 +30,5 @@
 # endif
 
-# if defined key_trdmxl_trc   ||   defined key_esopa
+# if defined key_trdmxl_trc
    !!----------------------------------------------------------------------
    !!   'key_trdmxl_trc'                     mixed layer trends diagnostics
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 6808)
@@ -11,6 +11,6 @@
    !!   'key_top'                                                TOP models
    !!----------------------------------------------------------------------
-
-   !* Domain size *
+   !
+   !                                            !* Domain size *
    USE par_oce , ONLY :   jpi      =>   jpi        !: first  dimension of grid --> i 
    USE par_oce , ONLY :   jpj      =>   jpj        !: second dimension of grid --> j  
@@ -20,34 +20,16 @@
    USE par_oce , ONLY :   jpkm1    =>   jpkm1      !: jpk - 1  
    USE par_oce , ONLY :   jpij     =>   jpij       !: jpi x jpj
-   USE par_oce , ONLY :   lk_esopa =>   lk_esopa   !: flag to activate the all option
    USE par_oce , ONLY :   jp_tem   =>   jp_tem     !: indice for temperature
    USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity
 
-   !* IO manager *
-   USE in_out_manager    
- 
-   !* Memory Allocation *
-   USE wrk_nemo      
- 
-   !* Timing *
-   USE timing    
- 
-   !* MPP library                         
-   USE lib_mpp 
-
-   !* Fortran utilities                         
-   USE lib_fortran
-
-   !* Lateral boundary conditions                         
-   USE lbclnk
-
-   !* physical constants *
-   USE phycst            
-
-   !* 1D configuration
-   USE c1d                                         
-
-   !* model domain *
-   USE dom_oce 
+   USE in_out_manager                           !* IO manager *
+   USE wrk_nemo                                 !* Memory Allocation *
+   USE timing                                   !* Timing * 
+   USE lib_mpp                                  !* MPP library                         
+   USE lib_fortran                              !* Fortran utilities                         
+   USE lbclnk                                   !* Lateral boundary conditions                         
+   USE phycst                                   !* physical constants *
+   USE c1d                                      !* 1D configuration
+   USE dom_oce                                  !* model domain *
 
    USE domvvl, ONLY : un_td, vn_td          !: thickness diffusion transport
@@ -56,6 +38,4 @@
 
    !* ocean fields: here now and after fields *
-   USE oce , ONLY :   ua      =>    ua      !: i-horizontal velocity (m s-1) 
-   USE oce , ONLY :   va      =>    va      !: j-horizontal velocity (m s-1)
    USE oce , ONLY :   un      =>    un      !: i-horizontal velocity (m s-1) 
    USE oce , ONLY :   vn      =>    vn      !: j-horizontal velocity (m s-1)
@@ -66,15 +46,11 @@
    USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3) 
    USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units)
+   USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s)
+   USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]   
+   USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]   
+   USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]   
 #if defined key_offline
    USE oce , ONLY :   rab_n   =>    rab_n   !: local thermal/haline expension ratio at T-points
 #endif
-   USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s)
-   USE oce , ONLY :   rotn    =>    rotn    !: relative vorticity    [s-1]
-   USE oce , ONLY :   hdivb   =>    hdivb   !: horizontal divergence (1/s)
-   USE oce , ONLY :   rotb    =>    rotb    !: relative vorticity    [s-1]
-   USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]   
-   USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]   
-   USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]   
-   USE oce , ONLY :   l_traldf_rot => l_traldf_rot  !: rotated laplacian operator for lateral diffusion
 
    !* surface fluxes *
@@ -102,18 +78,27 @@
    USE trc_oce
 
+!!gm : I don't understand this as ldftra (where everything is defined) is used by TRC in all cases (ON/OFF-line)
+!!gm   so the following lines should be removed....   logical should be the one of TRC namelist
+!!gm   In case off coarsening....  the ( ahtu, ahtv, aeiu, aeiv) arrays are needed that's all.
    !* lateral diffusivity (tracers) *
-   USE ldftra_oce , ONLY :  rldf     =>   rldf        !: multiplicative coef. for lateral diffusivity
-   USE ldftra_oce , ONLY :  rn_aht_0 =>   rn_aht_0    !: horizontal eddy diffusivity for tracers (m2/s)
-   USE ldftra_oce , ONLY :  aht0     =>   aht0        !: horizontal eddy diffusivity for tracers (m2/s)
-   USE ldftra_oce , ONLY :  ahtb0    =>   ahtb0       !: background eddy diffusivity for isopycnal diff. (m2/s)
-   USE ldftra_oce , ONLY :  ahtu     =>   ahtu        !: lateral diffusivity coef. at u-points 
-   USE ldftra_oce , ONLY :  ahtv     =>   ahtv        !: lateral diffusivity coef. at v-points 
-   USE ldftra_oce , ONLY :  ahtw     =>   ahtw        !: lateral diffusivity coef. at w-points 
-   USE ldftra_oce , ONLY :  ahtt     =>   ahtt        !: lateral diffusivity coef. at t-points
-   USE ldftra_oce , ONLY :  aeiv0    =>   aeiv0       !: eddy induced velocity coefficient (m2/s) 
-   USE ldftra_oce , ONLY :  aeiu     =>   aeiu        !: eddy induced velocity coef. at u-points (m2/s)   
-   USE ldftra_oce , ONLY :  aeiv     =>   aeiv        !: eddy induced velocity coef. at v-points (m2/s) 
-   USE ldftra_oce , ONLY :  aeiw     =>   aeiw        !: eddy induced velocity coef. at w-points (m2/s) 
-   USE ldftra_oce , ONLY :  lk_traldf_eiv  =>  lk_traldf_eiv     !: eddy induced velocity flag
+   USE ldftra , ONLY :  rn_aht_0     =>   rn_aht_0     !:   laplacian lateral eddy diffusivity [m2/s]
+   USE ldftra , ONLY :  rn_bht_0     =>   rn_bht_0     !: bilaplacian lateral eddy diffusivity [m4/s]
+   USE ldftra , ONLY :  ahtu         =>   ahtu         !: lateral diffusivity coef. at u-points 
+   USE ldftra , ONLY :  ahtv         =>   ahtv         !: lateral diffusivity coef. at v-points 
+   USE ldftra , ONLY :  rn_aeiv_0    =>   rn_aeiv_0    !: eddy induced velocity coefficient (m2/s) 
+   USE ldftra , ONLY :  aeiu         =>   aeiu         !: eddy induced velocity coef. at u-points (m2/s)   
+   USE ldftra , ONLY :  aeiv         =>   aeiv         !: eddy induced velocity coef. at v-points (m2/s) 
+   USE ldftra , ONLY :  ln_ldfeiv    =>   ln_ldfeiv    !: eddy induced velocity flag
+     
+!!gm this should be : ln_trcldf_triad (TRC namelist)
+   USE ldfslp , ONLY :  ln_traldf_triad => ln_traldf_triad   !: triad scheme (Griffies et al.)
+
+   !* direction of lateral diffusion *
+   USE ldfslp , ONLY :   l_ldfslp  =>  l_ldfslp       !: slopes flag
+   USE ldfslp , ONLY :   uslp       =>   uslp         !: i-slope at u-point
+   USE ldfslp , ONLY :   vslp       =>   vslp         !: j-slope at v-point
+   USE ldfslp , ONLY :   wslpi      =>   wslpi        !: i-slope at w-point
+   USE ldfslp , ONLY :   wslpj      =>   wslpj        !: j-slope at w-point
+!!gm end 
 
    !* vertical diffusion *
@@ -128,13 +113,4 @@
    USE zdfmxl , ONLY :   hmlp        =>   hmlp        !: mixed layer depth  (rho=rho0+zdcrit) (m)
    USE zdfmxl , ONLY :   hmlpt       =>   hmlpt       !: mixed layer depth at t-points (m)
-
-   !* direction of lateral diffusion *
-   USE ldfslp , ONLY :   lk_ldfslp  =>  lk_ldfslp     !: slopes flag
-# if   defined key_ldfslp
-   USE ldfslp , ONLY :   uslp       =>   uslp         !: i-direction slope at u-, w-points
-   USE ldfslp , ONLY :   vslp       =>   vslp         !: j-direction slope at v-, w-points
-   USE ldfslp , ONLY :   wslpi      =>   wslpi        !: i-direction slope at u-, w-points
-   USE ldfslp , ONLY :   wslpj      =>   wslpj        !: j-direction slope at v-, w-points
-# endif
 
    USE diaar5 , ONLY :   lk_diaar5  =>   lk_diaar5
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/top_substitute.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/top_substitute.h90	(revision 6807)
+++ 	(revision )
@@ -1,17 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                    ***  top_substitute.h90   ***
-   !!----------------------------------------------------------------------
-   !! ** purpose : Statement function file: to be include in all passive tracer modules
-   !!----------------------------------------------------------------------
-   !! History :   1.0  !  2004-03 (C. Ethe) Original code
-   !!             2.0  !  2007-12 (C. Ethe, G. Madec) new architecture
-   !!----------------------------------------------------------------------
-#  include "domzgr_substitute.h90"
-#  include "ldfeiv_substitute.h90"
-#  include "ldftra_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 6808)
@@ -14,4 +14,7 @@
    USE par_oce
    USE par_trc
+#if defined key_bdy
+   USE bdy_oce, only: nb_bdy, OBC_DATA
+#endif
    
    IMPLICIT NONE
@@ -64,5 +67,5 @@
    CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output)
    CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_outdir  !: restart output directory
-   REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step
+   REAL(wp)            , PUBLIC                                    ::  rdttrc         !: passive tracer time step
    LOGICAL             , PUBLIC                                    ::  ln_top_euler  !: boolean term for euler integration 
    LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files
@@ -91,4 +94,9 @@
        CHARACTER(len = 20)  :: clunit   !: unit
        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
    END TYPE PTRACER
@@ -143,10 +151,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s]
 # endif
-#if defined key_ldfslp
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_tm    !: i-direction slope at u-, w-points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpj_tm    !: j-direction slope at u-, w-points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm     !: j-direction slope at u-, w-points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vslp_tm     !: j-direction slope at u-, w-points
-#endif
 #if defined key_trabbl
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm  !: u-, w-points
@@ -183,11 +185,15 @@
 #endif
    !
-#if defined key_ldfslp
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_temp, wslpj_temp, uslp_temp, vslp_temp    !: hold current values 
-#endif
-   ! 
 # if defined key_zdfddm
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_temp      !: salinity vertical diffusivity coeff. at w-point   [m/s]
 # 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
    !
 
@@ -211,7 +217,15 @@
          &      gtrui(jpi,jpj,jptra)  , gtrvi(jpi,jpj,jptra)                          ,       &
          &      sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra)                      ,       &  
-         &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       &
+         &      cvol(jpi,jpj,jpk)     , trai(jptra)                                   ,       &
          &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       & 
-         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)     , qsr_mean(jpi,jpj)     ,  STAT = trc_alloc  )  
+         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)     , qsr_mean(jpi,jpj)     ,       &
+#if defined key_my_trc
+         &      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
+         &      STAT = trc_alloc  )
 
       IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcbc.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcbc.F90	(revision 6808)
@@ -1,13 +1,15 @@
 MODULE trcbc
    !!======================================================================
-   !!                     ***  MODULE  trcdta  ***
+   !!                     ***  MODULE  trcbc  ***
    !! TOP :  module for passive tracer boundary conditions
    !!=====================================================================
-   !!----------------------------------------------------------------------
-#if  defined key_top 
+   !! History :  3.5 !  2014-04  (M. Vichi, T. Lovato)  Original
+   !!            3.6 !  2015-03  (T . Lovato) Revision and BDY support
+   !!----------------------------------------------------------------------
+#if defined key_top
    !!----------------------------------------------------------------------
    !!   'key_top'                                                TOP model 
    !!----------------------------------------------------------------------
-   !!   trc_dta    : read and time interpolated passive tracer data
+   !!   trc_bc       : read and time interpolated tracer Boundary Conditions
    !!----------------------------------------------------------------------
    USE par_trc       !  passive tracers parameters
@@ -17,4 +19,7 @@
    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
@@ -24,30 +29,26 @@
    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
-   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.3 , NEMO Consortium (2010)
-   !! $Id$ 
+   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
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.6 , NEMO Consortium (2015)
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE trc_bc_init(ntrc)
+   SUBROUTINE trc_bc_init( ntrc )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE trc_bc_init  ***
@@ -60,10 +61,12 @@
       !
       INTEGER,INTENT(IN) :: ntrc                           ! number of tracers
-      INTEGER            :: jl, jn                         ! dummy loop indices
+      INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices
       INTEGER            :: ierr0, ierr1, ierr2, ierr3     ! temporary integers
-      INTEGER            ::  ios                           ! Local integer output status for namelist read
+      INTEGER            :: ios                            ! Local integer output status for namelist read
+      INTEGER            :: nblen, igrd                    ! support arrays for BDY
       CHARACTER(len=100) :: clndta, clntrc
       !
-      CHARACTER(len=100) :: cn_dir
+      CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc
+
       TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i  ! local array of namelist informations on the fields to read
       TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc    ! open
@@ -74,8 +77,16 @@
       REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trcfac    ! multiplicative factor for tracer values
       !!
-      NAMELIST/namtrc_bc/ cn_dir, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 
+      NAMELIST/namtrc_bc/ cn_dir_sbc, cn_dir_cbc, cn_dir_obc, sn_trcobc, 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
       !!----------------------------------------------------------------------
       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  
@@ -107,31 +118,5 @@
       n_trc_indcbc(:) = 0
       !
-      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,*) ' '
-
+      ! Read Boundary Conditions Namelists
       REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure
       READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901)
@@ -143,54 +128,149 @@
       IF(lwm) WRITE ( numont, namtrc_bc )
 
-      ! print some information for each 
+#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.' )
+         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
+               IF ( ln_trc_obc(jn) )  WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn)%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), rf_trofac(nb_trcobc), nbmap_ptr(nb_trcobc), 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 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
+            DO ib = 1, nb_bdy
+
+               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)
+                  rf_trofac(jl) = rn_trofac(jn)
+                                               ALLOCATE( sf_trcobc(jl)%fnow(nblen,1,jpk)   , STAT=ierr2 )
+                  IF( sn_trcobc(jn)%ln_tint )  ALLOCATE( sf_trcobc(jl)%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)%fnow(:,1,:)
+                  trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl)
+                  ! create OBC mapping array
+                  nbmap_ptr(jl)%ptr => idx_bdy(ib)%nbmap(:,igrd)
+                  nbmap_ptr(jl)%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
-            ENDIF
-            !   
+            ENDDO
          ENDDO
-         !                         ! 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
-      !
+
+         CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' )
+      ENDIF
+#endif
       ! SURFACE Boundary conditions
       IF( nb_trcsbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
@@ -214,5 +294,5 @@
          ENDDO
          !                         ! fill sf_trcsbc with slf_i and control print
-         CALL fld_fill( sf_trcsbc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' )
+         CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' )
          !
       ENDIF
@@ -239,15 +319,15 @@
          ENDDO
          !                         ! fill sf_trccbc with slf_i and control print
-         CALL fld_fill( sf_trccbc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' )
+         CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' )
          !
       ENDIF
- 
+      !
       DEALLOCATE( slf_i )          ! deallocate local field structure
       IF( nn_timing == 1 )  CALL timing_stop('trc_bc_init')
-
+      !
    END SUBROUTINE trc_bc_init
 
 
-   SUBROUTINE trc_bc_read(kt)
+   SUBROUTINE trc_bc_read(kt, jit)
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE trc_bc_init  ***
@@ -258,44 +338,66 @@
       !!              
       !!----------------------------------------------------------------------
-   
-      ! NEMO
       USE fldread
       
       !! * Arguments
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-
+      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option)
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('trc_bc_read')
 
-      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( 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 
+
+         ! 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
+           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kit=jit, kt_offset=+1)
+         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
+
+         ! 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
+           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kt_offset=+1)
+         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( nn_timing == 1 )  CALL timing_stop('trc_bc_read')
-      !       
-
+      !
    END SUBROUTINE trc_bc_read
+
 #else
    !!----------------------------------------------------------------------
@@ -303,4 +405,10 @@
    !!----------------------------------------------------------------------
 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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90	(revision 6808)
@@ -0,0 +1,293 @@
+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( 'trc_bdy : unrecognised option for open boundaries for passive tracers' )
+            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) ::   zwgt           ! boundary weight
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
+      INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, 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  ) +  bdytmask(ii+1,ij  )
+            zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1)
+            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)
+               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) / MAX( 1, zcoef) ) * tmask(ii,ij,ik)
+            ELSE
+               ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
+               jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)
+               tra(ii,ij,ik,jn) = tra(ii+ip,ij+jp,ik,jn) * tmask(ii+ip,ij+jp,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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcdia.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcdia.F90	(revision 6808)
@@ -51,6 +51,4 @@
    INTEGER  ::   nhoritb   !:  id for horizontal mesh
 
-   !! * Substitutions
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -108,5 +106,5 @@
       CHARACTER (len=20) :: cltra, cltrau
       CHARACTER (len=80) :: cltral
-      REAL(wp) :: zsto, zout, zdt
+      REAL(wp) :: zsto, zout
       INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
       !!----------------------------------------------------------------------
@@ -120,5 +118,4 @@
 
       ! Define frequency of output and means
-      zdt = rdt
       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)
@@ -128,8 +125,8 @@
       clop = "inst("//TRIM(clop)//")"
 # else
-      zsto = zdt
+      zsto = rdt
       clop = "ave("//TRIM(clop)//")"
 # endif
-      zout = nn_writetrc * zdt
+      zout = nn_writetrc * rdt
 
       ! Define indices of the horizontal output zoom and vertical limit storage
@@ -184,5 +181,5 @@
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     &
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
-            &          iiter, zjulian, zdt, nhorit5, nit5 , domain_id=nidom, snc4chunks=snc4set)
+            &          iiter, zjulian, rdt, nhorit5, nit5 , domain_id=nidom, snc4chunks=snc4set)
 
          ! Vertical grid for tracer : gdept
@@ -252,5 +249,5 @@
       INTEGER  ::   jl
       INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
-      REAL(wp) ::   zsto, zout, zdt
+      REAL(wp) ::   zsto, zout
       !!----------------------------------------------------------------------
 
@@ -263,16 +260,15 @@
       !
       ! Define frequency of output and means
-      zdt = rdt
       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 = nn_writedia * zdt
+      zsto = nn_writedia * rdt
       clop = "inst("//TRIM(clop)//")"
 #  else
-      zsto = zdt
+      zsto = rdt
       clop = "ave("//TRIM(clop)//")"
 #  endif
-      zout = nn_writedia * zdt
+      zout = nn_writedia * rdt
 
       ! Define indices of the horizontal output zoom and vertical limit storage
@@ -304,5 +300,5 @@
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             &
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &
-            &          iiter, zjulian, zdt, nhoritd, nitd , domain_id=nidom, snc4chunks=snc4set )
+            &          iiter, zjulian, rdt, nhoritd, nitd , domain_id=nidom, snc4chunks=snc4set )
 
          ! Vertical grid for 2d and 3d arrays
@@ -389,5 +385,5 @@
       INTEGER  ::   ji, jj, jk, jl
       INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
-      REAL(wp) ::   zsto, zout, zdt
+      REAL(wp) ::   zsto, zout
       !!----------------------------------------------------------------------
 
@@ -400,16 +396,15 @@
 
       ! Define frequency of output and means
-      zdt = rdt
       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 = nn_writebio * zdt
+      zsto = nn_writebio * rdt
       clop = "inst("//TRIM(clop)//")"
 #        else
-      zsto = zdt
+      zsto = rdt
       clop = "ave("//TRIM(clop)//")"
 #        endif
-      zout = nn_writebio * zdt
+      zout = nn_writebio * rdt
 
       ! Define indices of the horizontal output zoom and vertical limit storage
@@ -437,5 +432,5 @@
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,      &
             &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          &
-            &    iiter, zjulian, zdt, nhoritb, nitb , domain_id=nidom, snc4chunks=snc4set )
+            &    iiter, zjulian, rdt, nhoritb, nitb , domain_id=nidom, snc4chunks=snc4set )
          ! Vertical grid for biological trends
          CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_1d, ndepitb)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 6808)
@@ -9,6 +9,7 @@
    !!            3.4   !  2010-11  (C. Ethe, G. Madec)  use of fldread + dynamical allocation 
    !!            3.5   !  2013-08  (M. Vichi)  generalization for other BGC models
-   !!----------------------------------------------------------------------
-#if  defined key_top 
+   !!            3.6   !  2015-03  (T. Lovato) revision of code log info
+   !!----------------------------------------------------------------------
+#if defined key_top 
    !!----------------------------------------------------------------------
    !!   'key_top'                                                TOP model 
@@ -36,6 +37,5 @@
    TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read)
 !$AGRIF_END_DO_NOT_TREAT
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -72,4 +72,10 @@
       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  
@@ -77,5 +83,5 @@
       ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
       IF( ierr0 > 0 ) THEN
-         CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN
+         CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' )   ;   RETURN
       ENDIF
       nb_trcdta      = 0
@@ -97,9 +103,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 in reference namelist', lwp )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init 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 in configuration namelist', lwp )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in configuration namelist', lwp )
       IF(lwm) WRITE ( numont, namtrc_dta )
 
@@ -109,12 +115,14 @@
                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 :  ',   &
-                  &              'the variable name in the data file : '//clndta//   & 
-                  &              '  must be the same than the name of the passive tracer : '//clntrc//' ')
+                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation    ',   &
+                  &              'Input name of data file : '//TRIM(clndta)//   &
+                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ')
                ENDIF
-               WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, & 
-               &               ' multiplicative factor : ', zfact
+               WRITE(numout,*) ' '
+               WRITE(numout,'(a, i3,3a,e11.3)') ' Read IC file for tracer number :', &
+               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact
             ENDIF
          END DO
@@ -124,5 +132,5 @@
          ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
          IF( ierr1 > 0 ) THEN
-            CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN
+            CALL ctl_stop( 'trc_dta_init: unable to allocate  sf_trcdta structure' )   ;   RETURN
          ENDIF
          !
@@ -135,5 +143,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 : unable to allocate passive tracer data arrays' )   ;   RETURN
+                 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' )   ;   RETURN
                ENDIF
             ENDIF
@@ -141,5 +149,5 @@
          ENDDO
          !                         ! fill sf_trcdta with slf_i and control print
-         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' )
+         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' )
          !
       ENDIF
@@ -189,5 +197,5 @@
                   DO ji = 1, jpi
                      DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
-                        zl = fsdept_n(ji,jj,jk)
+                        zl = gdept_n(ji,jj,jk)
                         IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data
                            ztp(jk) =  sf_dta(1)%fnow(ji,jj,1)
@@ -220,11 +228,6 @@
                         ik = mbkt(ji,jj) 
                         IF( ik > 1 ) THEN
-                           zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
+                           zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
                            sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1)
-                        ENDIF
-                        ik = mikt(ji,jj)
-                        IF( ik > 1 ) THEN
-                           zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
-                           sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik+1)
                         ENDIF
                      END DO
@@ -236,16 +239,4 @@
          sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac   !  multiplicative factor
          !
-         IF( lwp .AND. kt == nit000 ) THEN
-               clndta = TRIM( sf_dta(1)%clvar ) 
-               WRITE(numout,*) ''//clndta//' data '
-               WRITE(numout,*)
-               WRITE(numout,*)'  level = 1'
-               CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-               WRITE(numout,*)'  level = ', jpk/2
-               CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-               WRITE(numout,*)'  level = ', jpkm1
-               CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-               WRITE(numout,*)
-         ENDIF
       ENDIF
       !
@@ -253,4 +244,5 @@
       !
    END SUBROUTINE trc_dta
+   
 #else
    !!----------------------------------------------------------------------
@@ -262,4 +254,5 @@
    END SUBROUTINE trc_dta
 #endif
+
    !!======================================================================
 END MODULE trcdta
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcini.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 6808)
@@ -18,18 +18,13 @@
    USE oce_trc         ! shared variables between ocean and passive tracers
    USE trc             ! passive tracers common variables
-   USE trcrst          ! passive tracers restart
    USE trcnam          ! Namelist read
-   USE trcini_cfc      ! CFC      initialisation
-   USE trcini_pisces   ! PISCES   initialisation
-   USE trcini_c14b     ! C14 bomb initialisation
-   USE trcini_my_trc   ! MY_TRC   initialisation
-   USE trcdta          ! initialisation from files
    USE daymod          ! calendar manager
-   USE zpshde          ! partial step: hor. derivative   (zps_hde routine)
    USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine)
    USE trcsub          ! variables to substep passive tracers
+   USE trcrst
    USE lib_mpp         ! distribued memory computing library
    USE sbc_oce
    USE trcice          ! tracers in sea ice
+   USE trcbc,   only : trc_bc_init ! generalized Boundary Conditions
  
    IMPLICIT NONE
@@ -38,6 +33,4 @@
    PUBLIC   trc_init   ! called by opa
 
-    !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 4.0 , NEMO Consortium (2011)
@@ -59,8 +52,4 @@
       !!                or read data or analytical formulation
       !!---------------------------------------------------------------------
-      INTEGER ::   jk, jn, jl    ! dummy loop indices
-      CHARACTER (len=25) :: charout
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace
-      !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )   CALL timing_start('trc_init')
@@ -70,46 +59,157 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~'
 
-      CALL top_alloc()              ! allocate TOP arrays
-
+      !
+      CALL top_alloc()   ! allocate TOP arrays
+      !
+      CALL trc_ini_ctl   ! control 
+      !
+      CALL trc_nam       ! read passive tracers namelists
+      !
+      IF(lwp) WRITE(numout,*)
+      !
+      IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar
+      !
+      IF(lwp) WRITE(numout,*)
+      !
+      CALL trc_ini_sms   ! SMS
+      !
+      CALL trc_ini_trp   ! passive tracers transport
+      !
+      CALL trc_ice_ini   ! Tracers in sea ice
+      !
+      IF( lwp )  &
+         &  CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea )
+      !
+      CALL trc_ini_state  !  passive tracers initialisation : from a restart or from clim
+      !
+      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers
+      !
+      CALL trc_ini_inv   ! Inventories
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_init')
+      !
+   END SUBROUTINE trc_init
+
+
+   SUBROUTINE trc_ini_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_ctl  ***
+      !! ** Purpose :        Control  + ocean volume
+      !!----------------------------------------------------------------------
+      INTEGER ::   jk    ! dummy loop indices
+      !
+      ! Define logical parameter ton control dirunal cycle in TOP
       l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 )
       l_trcdm2dc = l_trcdm2dc  .AND. .NOT. lk_offline
-      IF( l_trcdm2dc .AND. lwp ) &
-         &   CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. &
-         & Computation of a daily mean shortwave for some biogeochemical models) ')
-
-      IF( nn_cla == 1 )   &
-         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' )
-
-      CALL trc_nam      ! read passive tracers namelists
-      !
-      IF(lwp) WRITE(numout,*)
-      !
-      IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar
-      !
-      IF(lwp) WRITE(numout,*)
-                                                              ! masked grid volume
+      IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   &
+         &                           'Computation of a daily mean shortwave for some biogeochemical models ' )
+      !
+   END SUBROUTINE trc_ini_ctl
+
+
+   SUBROUTINE trc_ini_inv
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_stat  ***
+      !! ** Purpose :      passive tracers inventories at initialsation phase
+      !!----------------------------------------------------------------------
+      INTEGER ::  jk, jn    ! dummy loop indices
+      CHARACTER (len=25) :: charout
+      !!----------------------------------------------------------------------
       !                                                              ! masked grid volume
       DO jk = 1, jpk
-         cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
+         cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk)
       END DO
-      IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol
+      IF( lk_degrad )   cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)    ! degrad option: reduction by facvol
       !                                                              ! total volume of the ocean 
       areatot = glob_sum( cvol(:,:,:) )
-
+      !
+      trai(:) = 0._wp                                                   ! initial content of all tracers
+      DO jn = 1, jptra
+         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
+      END DO
+
+      IF(lwp) THEN               ! control print
+         WRITE(numout,*)
+         WRITE(numout,*)
+         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra
+         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot
+         WRITE(numout,*) '          *** Total inital content of all tracers '
+         WRITE(numout,*)
+         DO jn = 1, jptra
+            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
+         ENDDO
+         WRITE(numout,*)
+      ENDIF
+      IF(lwp) WRITE(numout,*)
+      IF(ln_ctl) THEN            ! print mean trends (used for debugging)
+         CALL prt_ctl_trc_init
+         WRITE(charout, FMT="('ini ')")
+         CALL prt_ctl_trc_info( charout )
+         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+      ENDIF
+9000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10)
+      !
+   END SUBROUTINE trc_ini_inv
+
+
+   SUBROUTINE trc_ini_sms
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_sms  ***
+      !! ** Purpose :   SMS initialisation
+      !!----------------------------------------------------------------------
+      USE trcini_cfc      ! CFC      initialisation
+      USE trcini_pisces   ! PISCES   initialisation
+      USE trcini_c14b     ! C14 bomb initialisation
+      USE trcini_my_trc   ! MY_TRC   initialisation
+      !!----------------------------------------------------------------------
       IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model
       IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers
       IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer
       IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers
-
-      CALL trc_ice_ini                                 ! Tracers in sea ice
-
-      IF( lwp ) THEN
-         !
-         CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea )
-         !
-      ENDIF
-
+      !
+   END SUBROUTINE trc_ini_sms
+
+   SUBROUTINE trc_ini_trp
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_trp  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!----------------------------------------------------------------------
+      USE trcdmp , ONLY:  trc_dmp_ini
+      USE trcadv , ONLY:  trc_adv_ini
+      USE trcldf , ONLY:  trc_ldf_ini
+      USE trczdf , ONLY:  trc_zdf_ini
+      USE trcrad , ONLY:  trc_rad_ini
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_trcdmp )  CALL  trc_dmp_ini          ! damping
+                       CALL  trc_adv_ini          ! advection
+                       CALL  trc_ldf_ini          ! lateral diffusion
+                       CALL  trc_zdf_ini          ! vertical diffusion
+                       CALL  trc_rad_ini          ! positivity of passive tracers 
+      !
+   END SUBROUTINE trc_ini_trp
+
+
+   SUBROUTINE trc_ini_state
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_state ***
+      !! ** Purpose :          Initialisation of passive tracer concentration 
+      !!----------------------------------------------------------------------
+      USE zpshde          ! partial step: hor. derivative   (zps_hde routine)
+      USE trcrst          ! passive tracers restart
+      USE trcdta          ! initialisation from files
+      !
+      INTEGER ::   jk, jn, jl    ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace
+      !!----------------------------------------------------------------------
+      !
+      ! Initialisation of tracers Initial Conditions
       IF( ln_trcdta )      CALL trc_dta_init(jptra)
 
+      ! Initialisation of tracers Boundary Conditions
+      IF( lk_my_trc )     CALL trc_bc_init(jptra)
 
       IF( ln_rsttr ) THEN
@@ -146,44 +246,6 @@
  
       tra(:,:,:,:) = 0._wp
-      IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav )   &              ! Partial steps: before horizontal gradient of passive
-        &    CALL zps_hde    ( nit000, jptra, trn, gtru, gtrv  )  ! Partial steps: before horizontal gradient
-      IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav )   &
-        &    CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )       ! tracers at the bottom ocean level
-
-
-      !
-      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers
-      !
-
-      trai(:) = 0._wp                                                   ! initial content of all tracers
-      DO jn = 1, jptra
-         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
-      END DO
-
-      IF(lwp) THEN               ! control print
-         WRITE(numout,*)
-         WRITE(numout,*)
-         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra
-         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot
-         WRITE(numout,*) '          *** Total inital content of all tracers '
-         WRITE(numout,*)
-         DO jn = 1, jptra
-            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
-         ENDDO
-         WRITE(numout,*)
-      ENDIF
-      IF(lwp) WRITE(numout,*)
-      IF(ln_ctl) THEN            ! print mean trends (used for debugging)
-         CALL prt_ctl_trc_init
-         WRITE(charout, FMT="('ini ')")
-         CALL prt_ctl_trc_info( charout )
-         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
-      ENDIF
-9000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10)
-      !
-      IF( nn_timing == 1 )   CALL timing_stop('trc_init')
-      !
-   END SUBROUTINE trc_init
-
+      !                                                         ! Partial top/bottom cell: GRADh(trn)
+   END SUBROUTINE trc_ini_state
 
    SUBROUTINE top_alloc
@@ -193,8 +255,5 @@
       !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
       !!----------------------------------------------------------------------
-      USE trcadv        , ONLY:   trc_adv_alloc          ! TOP-related alloc routines...
       USE trc           , ONLY:   trc_alloc
-      USE trcnxt        , ONLY:   trc_nxt_alloc
-      USE trczdf        , ONLY:   trc_zdf_alloc
       USE trdtrc_oce    , ONLY:   trd_trc_oce_alloc
 #if defined key_trdmxl_trc 
@@ -205,8 +264,5 @@
       !!----------------------------------------------------------------------
       !
-      ierr =        trc_adv_alloc()          ! Start of TOP-related alloc routines...
-      ierr = ierr + trc_alloc    ()
-      ierr = ierr + trc_nxt_alloc()
-      ierr = ierr + trc_zdf_alloc()
+      ierr =        trc_alloc()
       ierr = ierr + trd_trc_oce_alloc()
 #if defined key_trdmxl_trc 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 6808)
@@ -20,5 +20,4 @@
    USE oce_trc           ! shared variables between ocean and passive tracers
    USE trc               ! passive tracers common variables
-   USE trcnam_trp        ! Transport namelist
    USE trcnam_pisces     ! PISCES namelist
    USE trcnam_cfc        ! CFC SMS namelist
@@ -35,6 +34,4 @@
    PUBLIC trc_nam      ! called in trcini
 
-   !! * Substitutions
-#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -42,7 +39,5 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
-
 
    SUBROUTINE trc_nam
@@ -57,26 +52,19 @@
       !!---------------------------------------------------------------------
       INTEGER  ::   jn                  ! dummy loop indice
-      !                                        !   Parameters of the run 
-      IF( .NOT. lk_offline ) CALL trc_nam_run
-      
-      !                                        !  passive tracer informations
-      CALL trc_nam_trc
-      
-      !                                        !   Parameters of additional diagnostics
-      CALL trc_nam_dia
-
-      !                                        !   namelist of transport
-      CALL trc_nam_trp
-
-
-      IF( ln_rsttr )                      ln_trcdta = .FALSE.   ! restart : no need of clim data
-      !
-      IF( ln_trcdmp .OR. ln_trcdmp_clo )  ln_trcdta = .TRUE.   ! damping : need to have clim data
-      !
-      IF( .NOT.ln_trcdta ) THEN
-         ln_trc_ini(:) = .FALSE.
-      ENDIF
-
-     IF(lwp) THEN                   ! control print
+      !                                  
+      IF( .NOT.lk_offline )   CALL trc_nam_run     ! Parameters of the run 
+      !               
+                              CALL trc_nam_trc     ! passive tracer informations
+      !                                        
+                              CALL trc_nam_dia     ! Parameters of additional diagnostics
+      !                                      
+      !
+      IF( ln_rsttr                     )   ln_trcdta     = .FALSE.   ! restart : no need of clim data
+      !
+      IF( ln_trcdmp .OR. ln_trcdmp_clo )   ln_trcdta     = .TRUE.   ! damping : need to have clim data
+      !
+      IF( .NOT.ln_trcdta               )   ln_trc_ini(:) = .FALSE.
+
+      IF(lwp) THEN                   ! control print
          WRITE(numout,*)
          WRITE(numout,*) ' Namelist : namtrc'
@@ -110,9 +98,9 @@
 
       
-      rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step
+      rdttrc = rdt * FLOAT( nn_dttrc )   ! passive tracer time-step
   
       IF(lwp) THEN                   ! control print
         WRITE(numout,*) 
-        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1)
+        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc
         WRITE(numout,*) 
       ENDIF
@@ -149,5 +137,5 @@
       ! Call the ice module for tracers
       ! -------------------------------
-      CALL trc_nam_ice
+                                  CALL trc_nam_ice
 
       ! namelist of SMS
@@ -171,4 +159,5 @@
    END SUBROUTINE trc_nam
 
+
    SUBROUTINE trc_nam_run
       !!---------------------------------------------------------------------
@@ -180,12 +169,9 @@
       NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, &
         &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out
-
-
+      !
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-
-      !!---------------------------------------------------------------------
-
-
-      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'
+      !!---------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists'
       IF(lwp) WRITE(numout,*) '~~~~~~~'
 
@@ -220,4 +206,5 @@
     END SUBROUTINE trc_nam_run
 
+
    SUBROUTINE trc_nam_ice
       !!---------------------------------------------------------------------
@@ -229,12 +216,12 @@
       !!
       !!---------------------------------------------------------------------
-      ! --- Variable declarations --- !
       INTEGER :: jn      ! dummy loop indices
       INTEGER :: ios     ! Local integer output status for namelist read
-
-      ! --- Namelist declarations --- !
+      !
       TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer
+      !!
       NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer
-
+      !!---------------------------------------------------------------------
+      !
       IF(lwp) THEN
          WRITE(numout,*)
@@ -271,4 +258,5 @@
    END SUBROUTINE trc_nam_ice
 
+
    SUBROUTINE trc_nam_trc
       !!---------------------------------------------------------------------
@@ -278,15 +266,14 @@
       !!
       !!---------------------------------------------------------------------
-      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
       INTEGER  ::   jn                  ! dummy loop indice
+      !
+      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
       !!---------------------------------------------------------------------
       IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'
+      IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists'
       IF(lwp) WRITE(numout,*) '~~~~~~~'
-
 
       REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables
@@ -304,8 +291,13 @@
          ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  )
          ln_trc_ini(jn) =       sn_tracer(jn)%llinit
+#if defined key_my_trc
+         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
-      
-    END SUBROUTINE trc_nam_trc
+      !
+   END SUBROUTINE trc_nam_trc
 
 
@@ -320,5 +312,7 @@
       !!                ( (PISCES, CFC, MY_TRC )
       !!---------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
       INTEGER ::  ierr
+      !!
 #if defined key_trdmxl_trc  || defined key_trdtrc
       NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, &
@@ -327,11 +321,5 @@
 #endif
       NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio
-
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      !!---------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*) 
-      IF(lwp) WRITE(numout,*) 'trc_nam_dia : read the passive tracer diagnostics options'
-      IF(lwp) WRITE(numout,*) '~~~~~~~'
+      !!---------------------------------------------------------------------
 
       IF(lwp) WRITE(numout,*)
@@ -397,3 +385,3 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
-END MODULE  trcnam
+END MODULE trcnam
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 6808)
@@ -14,9 +14,5 @@
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!   trc_rst :   Restart for passive tracer
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
+   !!   trc_rst        : Restart for passive tracer
    !!   trc_rst_opn    : open  restart file
    !!   trc_rst_read   : read  restart file
@@ -25,7 +21,7 @@
    USE oce_trc
    USE trc
-   USE trcnam_trp
    USE iom
    USE daymod
+   
    IMPLICIT NONE
    PRIVATE
@@ -36,7 +32,9 @@
    PUBLIC   trc_rst_cal
 
-   !! * Substitutions
-#  include "top_substitute.h90"
-   
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.7 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
    
@@ -132,5 +130,5 @@
       !!----------------------------------------------------------------------
       !
-      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface passive tracer time step
+      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc )   ! passive tracer time step
       ! prognostic variables 
       ! -------------------- 
@@ -200,11 +198,4 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
 
-         IF ( jprstlib == jprstdimg ) THEN
-           ! eventually read netcdf file (monobloc)  for restarting on different number of processors
-           ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 
-           INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
-           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
-         ENDIF
-
          IF( ln_rsttr ) THEN
             CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt )
@@ -236,5 +227,5 @@
              ELSE
                ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
-               adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
+               adatrj = ( REAL( nittrc000-1, wp ) * rdt ) / rday
                ! note this is wrong if time step has changed during run
             ENDIF
@@ -289,5 +280,5 @@
       !
       DO jk = 1, jpk
-         zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
+         zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk)
       END DO
       !
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 6808)
@@ -75,3 +75,3 @@
 
    !!======================================================================
-END MODULE  trcsms
+END MODULE trcsms
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 6808)
@@ -36,6 +36,4 @@
    LOGICAL  :: llnew
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -66,7 +64,7 @@
       IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer
       !
-      IF( lk_vvl ) THEN                                                   ! update ocean volume due to ssh temporal evolution
+      IF( .NOT.ln_linssh ) THEN                                           ! update ocean volume due to ssh temporal evolution
          DO jk = 1, jpk
-            cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
+            cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk)
          END DO
          IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)       ! degrad option: reduction by facvol
@@ -116,4 +114,5 @@
    END SUBROUTINE trc_stp
 
+
    SUBROUTINE trc_mean_qsr( kt )
       !!----------------------------------------------------------------------
@@ -130,5 +129,6 @@
       INTEGER, INTENT(in) ::   kt
       INTEGER  :: jn
-
+      !!----------------------------------------------------------------------
+      !
       IF( kt == nittrc000 ) THEN
          IF( ln_cpl )  THEN  
@@ -165,5 +165,5 @@
           DO jn = 1, nb_rec_per_days - 1
              qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
-          ENDDO
+          END DO
           qsr_arr (:,:,nb_rec_per_days) = qsr(:,:)
           qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 6808)
@@ -25,5 +25,5 @@
    USE zdf_oce
    USE domvvl
-   USE divcur          ! hor. divergence and curl      (div & cur routines)
+   USE divhor          ! horizontal divergence            (div_hor routine)
    USE sbcrnf, ONLY: h_rnf, nk_rnf   ! River runoff 
    USE bdy_oce
@@ -40,10 +40,11 @@
    PUBLIC   trc_sub_ssh      ! called by trc_stp to reset physics variables
 
-   !!* Module variables
    REAL(wp)  :: r1_ndttrc     !    1 /  nn_dttrc 
    REAL(wp)  :: r1_ndttrcp1   !    1 / (nn_dttrc+1) 
 
-   !!* Substitution
-#  include "top_substitute.h90"
+   !                                                       !* iso-neutral slopes (if l_ldfslp=T)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_temp, vslp_temp, wslpi_temp, wslpj_temp   !: hold current values 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm  , vslp_tm  , wslpi_tm  , wslpj_tm     !: time mean 
+
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -84,19 +85,19 @@
        IF( MOD( kt , nn_dttrc ) /= 0 ) THEN
           !
-          un_tm   (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * fse3u(:,:,:) 
-          vn_tm   (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * fse3v(:,:,:) 
-          tsn_tm  (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * fse3t(:,:,:)  
-          tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * fse3t(:,:,:)  
-          rhop_tm (:,:,:)        = rhop_tm (:,:,:)        + rhop (:,:,:)        * fse3t(:,:,:)  
-          avt_tm  (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * fse3w(:,:,:)  
-# if defined key_zdfddm
-          avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)  
-# endif
-#if defined key_ldfslp
-          wslpi_tm(:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:)
-          wslpj_tm(:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:)
-          uslp_tm (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:)
-          vslp_tm (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:)
-#endif
+          un_tm   (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u_n(:,:,:) 
+          vn_tm   (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v_n(:,:,:) 
+          tsn_tm  (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)  
+          tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)  
+          rhop_tm (:,:,:)        = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)  
+          avt_tm  (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * e3w_n(:,:,:)  
+# if defined key_zdfddm
+          avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)  
+# endif
+         IF( l_ldfslp ) THEN
+            uslp_tm (:,:,:)      = uslp_tm (:,:,:)        + uslp (:,:,:)
+            vslp_tm (:,:,:)      = vslp_tm (:,:,:)        + vslp (:,:,:)
+            wslpi_tm(:,:,:)      = wslpi_tm(:,:,:)        + wslpi(:,:,:)
+            wslpj_tm(:,:,:)      = wslpj_tm(:,:,:)        + wslpj(:,:,:)
+         ENDIF
 # if defined key_trabbl
           IF( nn_bbl_ldf == 1 ) THEN
@@ -131,10 +132,8 @@
          avs_temp   (:,:,:)      = avs   (:,:,:)
 # endif
-#if defined key_ldfslp
-         wslpi_temp (:,:,:)      = wslpi (:,:,:)
-         wslpj_temp (:,:,:)      = wslpj (:,:,:)
-         uslp_temp  (:,:,:)      = uslp  (:,:,:)
-         vslp_temp  (:,:,:)      = vslp  (:,:,:)
-#endif
+         IF( l_ldfslp ) THEN
+            uslp_temp  (:,:,:)   = uslp  (:,:,:)   ;   wslpi_temp (:,:,:)   = wslpi (:,:,:)
+            vslp_temp  (:,:,:)   = vslp  (:,:,:)   ;   wslpj_temp (:,:,:)   = wslpj (:,:,:)
+         ENDIF
 # if defined key_trabbl
           IF( nn_bbl_ldf == 1 ) THEN
@@ -160,25 +159,22 @@
          wndm_temp  (:,:)        = wndm  (:,:)
          !                                    !  Variables reset in trc_sub_ssh
-         rotn_temp  (:,:,:)      = rotn  (:,:,:)
          hdivn_temp (:,:,:)      = hdivn (:,:,:)
-         rotb_temp  (:,:,:)      = rotb  (:,:,:)
-         hdivb_temp (:,:,:)      = hdivb (:,:,:)
          !
          ! 2. Create averages and reassign variables
-         un_tm    (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * fse3u(:,:,:) 
-         vn_tm    (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * fse3v(:,:,:) 
-         tsn_tm   (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * fse3t(:,:,:)  
-         tsn_tm   (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * fse3t(:,:,:)  
-         rhop_tm (:,:,:)         = rhop_tm (:,:,:)        + rhop (:,:,:)        * fse3t(:,:,:)  
-         avt_tm   (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * fse3w(:,:,:)  
-# if defined key_zdfddm
-         avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)  
-# endif
-#if defined key_ldfslp
-         wslpi_tm (:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:) 
-         wslpj_tm (:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:) 
-         uslp_tm  (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:) 
-         vslp_tm  (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:)
-#endif
+         un_tm    (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u_n(:,:,:) 
+         vn_tm    (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v_n(:,:,:) 
+         tsn_tm   (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)  
+         tsn_tm   (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)  
+         rhop_tm (:,:,:)         = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)  
+         avt_tm   (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * e3w_n(:,:,:)  
+# if defined key_zdfddm
+         avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)  
+# endif
+         IF( l_ldfslp ) THEN
+            uslp_tm  (:,:,:)     = uslp_tm (:,:,:)        + uslp (:,:,:) 
+            vslp_tm  (:,:,:)     = vslp_tm (:,:,:)        + vslp (:,:,:)
+            wslpi_tm (:,:,:)     = wslpi_tm(:,:,:)        + wslpi(:,:,:) 
+            wslpj_tm (:,:,:)     = wslpj_tm(:,:,:)        + wslpj(:,:,:) 
+         ENDIF
 # if defined key_trabbl
           IF( nn_bbl_ldf == 1 ) THEN
@@ -245,8 +241,8 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  z1_ne3t = r1_ndttrcp1  / fse3t(ji,jj,jk)
-                  z1_ne3u = r1_ndttrcp1  / fse3u(ji,jj,jk)
-                  z1_ne3v = r1_ndttrcp1  / fse3v(ji,jj,jk)
-                  z1_ne3w = r1_ndttrcp1  / fse3w(ji,jj,jk)
+                  z1_ne3t = r1_ndttrcp1  / e3t_n(ji,jj,jk)
+                  z1_ne3u = r1_ndttrcp1  / e3u_n(ji,jj,jk)
+                  z1_ne3v = r1_ndttrcp1  / e3v_n(ji,jj,jk)
+                  z1_ne3w = r1_ndttrcp1  / e3w_n(ji,jj,jk)
                   !
                   un   (ji,jj,jk)        = un_tm   (ji,jj,jk)        * z1_ne3u
@@ -255,17 +251,18 @@
                   tsn  (ji,jj,jk,jp_sal) = tsn_tm  (ji,jj,jk,jp_sal) * z1_ne3t
                   rhop (ji,jj,jk)        = rhop_tm (ji,jj,jk)        * z1_ne3t
+!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w
                   avt  (ji,jj,jk)        = avt_tm  (ji,jj,jk)        * z1_ne3w
 # if defined key_zdfddm
                   avs  (ji,jj,jk)        = avs_tm  (ji,jj,jk)        * z1_ne3w
 # endif
-#if defined key_ldfslp
-                  wslpi(ji,jj,jk)        = wslpi_tm(ji,jj,jk) 
-                  wslpj(ji,jj,jk)        = wslpj_tm(ji,jj,jk)
-                  uslp (ji,jj,jk)        = uslp_tm (ji,jj,jk)
-                  vslp (ji,jj,jk)        = vslp_tm (ji,jj,jk)
-#endif
-               ENDDO
-            ENDDO
-         ENDDO
+               END DO
+            END DO
+         END DO
+         IF( l_ldfslp ) THEN
+            wslpi(:,:,:)        = wslpi_tm(:,:,:) 
+            wslpj(:,:,:)        = wslpj_tm(:,:,:)
+            uslp (:,:,:)        = uslp_tm (:,:,:)
+            vslp (:,:,:)        = vslp_tm (:,:,:)
+         ENDIF
          !
          CALL trc_sub_ssh( kt )         ! after ssh & vertical velocity
@@ -276,4 +273,5 @@
       !
    END SUBROUTINE trc_sub_stp
+
 
    SUBROUTINE trc_sub_ini
@@ -299,19 +297,20 @@
       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' )
 
-      un_tm   (:,:,:)        = un   (:,:,:)        * fse3u(:,:,:) 
-      vn_tm   (:,:,:)        = vn   (:,:,:)        * fse3v(:,:,:) 
-      tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * fse3t(:,:,:)  
-      tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:)  
-      rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:)  
-      avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:)  
-# if defined key_zdfddm
-      avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)  
-# endif
-#if defined key_ldfslp
-      wslpi_tm(:,:,:)        = wslpi(:,:,:)
-      wslpj_tm(:,:,:)        = wslpj(:,:,:)
-      uslp_tm (:,:,:)        = uslp (:,:,:)
-      vslp_tm (:,:,:)        = vslp (:,:,:)
-#endif
+      un_tm   (:,:,:)        = un   (:,:,:)        * e3u_n(:,:,:) 
+      vn_tm   (:,:,:)        = vn   (:,:,:)        * e3v_n(:,:,:) 
+      tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)  
+      tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)  
+      rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)  
+!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w
+      avt_tm  (:,:,:)        = avt  (:,:,:)        * e3w_n(:,:,:)  
+# if defined key_zdfddm
+      avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)  
+# endif
+      IF( l_ldfslp ) THEN
+         wslpi_tm(:,:,:)     = wslpi(:,:,:)
+         wslpj_tm(:,:,:)     = wslpj(:,:,:)
+         uslp_tm (:,:,:)     = uslp (:,:,:)
+         vslp_tm (:,:,:)     = vslp (:,:,:)
+      ENDIF
       sshn_tm  (:,:) = sshn  (:,:) 
       rnf_tm   (:,:) = rnf   (:,:) 
@@ -365,10 +364,10 @@
       avs   (:,:,:)   =  avs_temp   (:,:,:)
 # endif
-#if defined key_ldfslp
-      wslpi (:,:,:)   =  wslpi_temp (:,:,:)
-      wslpj (:,:,:)   =  wslpj_temp (:,:,:)
-      uslp  (:,:,:)   =  uslp_temp  (:,:,:)
-      vslp  (:,:,:)   =  vslp_temp  (:,:,:)
-#endif
+      IF( l_ldfslp ) THEN
+         wslpi (:,:,:)=  wslpi_temp (:,:,:)
+         wslpj (:,:,:)=  wslpj_temp (:,:,:)
+         uslp  (:,:,:)=  uslp_temp  (:,:,:)
+         vslp  (:,:,:)=  vslp_temp  (:,:,:)
+      ENDIF
       sshn  (:,:)     =  sshn_temp  (:,:)
       sshb  (:,:)     =  sshb_temp  (:,:)
@@ -396,25 +395,21 @@
       !
       hdivn (:,:,:)   =  hdivn_temp (:,:,:)
-      rotn  (:,:,:)   =  rotn_temp  (:,:,:)
-      hdivb (:,:,:)   =  hdivb_temp (:,:,:)
-      rotb  (:,:,:)   =  rotb_temp  (:,:,:)
       !                                      
-
       ! Start new averages
-         un_tm   (:,:,:)        = un   (:,:,:)        * fse3u(:,:,:) 
-         vn_tm   (:,:,:)        = vn   (:,:,:)        * fse3v(:,:,:) 
-         tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * fse3t(:,:,:)  
-         tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:)  
-         rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:)  
-         avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:)  
-# if defined key_zdfddm
-         avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)  
-# endif
-#if defined key_ldfslp
+         un_tm   (:,:,:)        = un   (:,:,:)        * e3u_n(:,:,:) 
+         vn_tm   (:,:,:)        = vn   (:,:,:)        * e3v_n(:,:,:) 
+         tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)  
+         tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)  
+         rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)  
+         avt_tm  (:,:,:)        = avt  (:,:,:)        * e3w_n(:,:,:)  
+# if defined key_zdfddm
+         avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)  
+# endif
+      IF( l_ldfslp ) THEN
+         uslp_tm (:,:,:)        = uslp (:,:,:)
+         vslp_tm (:,:,:)        = vslp (:,:,:)
          wslpi_tm(:,:,:)        = wslpi(:,:,:) 
          wslpj_tm(:,:,:)        = wslpj(:,:,:)
-         uslp_tm (:,:,:)        = uslp (:,:,:)
-         vslp_tm (:,:,:)        = vslp (:,:,:)
-#endif
+      ENDIF
       !
       sshb_hold  (:,:) = sshn  (:,:)
@@ -451,5 +446,5 @@
       !!                   
       !! ** Purpose :   compute the after ssh (ssha), the now vertical velocity
-      !!              and update the now vertical coordinate (lk_vvl=T).
+      !!              and update the now vertical coordinate (ln_linssh=F).
       !!
       !! ** Method  : - Using the incompressibility hypothesis, the vertical 
@@ -460,9 +455,8 @@
       !! ** action  :   ssha    : after sea surface height
       !!                wn      : now vertical velocity
-      !!                sshu_a, sshv_a, sshf_a  : after sea surface height (lk_vvl=T)
+      !!                sshu_a, sshv_a, sshf_a  : after sea surface height (ln_linssh=F)
       !!
       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
       !!----------------------------------------------------------------------
-      !
       INTEGER, INTENT(in) ::   kt   ! time step
       !
@@ -475,5 +469,5 @@
       !
       ! Allocate temporary workspace
-      CALL wrk_alloc( jpi, jpj, zhdiv )
+      CALL wrk_alloc( jpi,jpj,   zhdiv )
 
       IF( kt == nittrc000 ) THEN
@@ -487,5 +481,6 @@
       ENDIF
       !
-      CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity
+!!gm BUG here !   hdivn will include the runoff divergence at the wrong timestep !!!!
+      CALL div_hor( kt )                              ! Horizontal divergence & Relative vorticity
       !
       z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
@@ -497,5 +492,5 @@
       zhdiv(:,:) = 0._wp
       DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports
-        zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk)
+        zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk)
       END DO
       !                                                ! Sea surface elevation time stepping
@@ -515,6 +510,5 @@
 #endif
 #endif
-
-
+      !
       !                                           !------------------------------!
       !                                           !     Now Vertical Velocity    !
@@ -522,7 +516,7 @@
       z1_2dt = 1.e0 / z2dt
       DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence
-         ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise
-         wn(:,:,jk) = wn(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        &
-            &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    &
+         ! - ML - need 3 lines here because replacement of e3t by its expression yields too long lines otherwise
+         wn(:,:,jk) = wn(:,:,jk+1) -   e3t_n(:,:,jk) * hdivn(:,:,jk)        &
+            &                      - ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )    &
             &                         * tmask(:,:,jk) * z1_2dt
 #if defined key_bdy
@@ -530,11 +524,11 @@
 #endif
       END DO
-
-      !
-      CALL wrk_dealloc( jpi, jpj, zhdiv )
+      !
+      CALL wrk_dealloc( jpi,jpj,   zhdiv )
       !
       IF( nn_timing == 1 )  CALL timing_stop('trc_sub_ssh')
       !
    END SUBROUTINE trc_sub_ssh
+
 
    INTEGER FUNCTION trc_sub_alloc()
@@ -551,8 +545,4 @@
          &      sshn_temp(jpi,jpj)          ,  sshb_temp(jpi,jpj) ,      &
          &      ssha_temp(jpi,jpj)          ,                           &
-#if defined key_ldfslp
-         &      wslpi_temp(jpi,jpj,jpk)     ,  wslpj_temp(jpi,jpj,jpk),  &
-         &      uslp_temp(jpi,jpj,jpk)      ,  vslp_temp(jpi,jpj,jpk),   &
-#endif
 #if defined key_trabbl
          &      ahu_bbl_temp(jpi,jpj)       ,  ahv_bbl_temp(jpi,jpj),    &
@@ -569,5 +559,4 @@
 # endif
          &      hdivn_temp(jpi,jpj,jpk)     ,  hdivb_temp(jpi,jpj,jpk),  &
-         &      rotn_temp(jpi,jpj,jpk)      ,  rotb_temp(jpi,jpj,jpk),   &
          &      un_tm(jpi,jpj,jpk)          ,  vn_tm(jpi,jpj,jpk)  ,     &
          &      avt_tm(jpi,jpj,jpk)                                ,     &
@@ -577,16 +566,20 @@
          &      emp_b_hold(jpi,jpj)         ,                            &
          &      hmld_tm(jpi,jpj)            ,  qsr_tm(jpi,jpj) ,         &
-#if defined key_ldfslp
-         &      wslpi_tm(jpi,jpj,jpk)       ,  wslpj_tm(jpi,jpj,jpk),    &
-         &      uslp_tm(jpi,jpj,jpk)        ,  vslp_tm(jpi,jpj,jpk),     &
-#endif
 #if defined key_trabbl
          &      ahu_bbl_tm(jpi,jpj)         ,  ahv_bbl_tm(jpi,jpj),      &
          &      utr_bbl_tm(jpi,jpj)         ,  vtr_bbl_tm(jpi,jpj),      &
 #endif
-         &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) ,       &
-         &                                    STAT=trc_sub_alloc )  
+         &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) , STAT=trc_sub_alloc )  
+      !
       IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate arrays')
-
+      !
+      IF( l_ldfslp ) THEN
+         ALLOCATE( uslp_temp(jpi,jpj,jpk)   ,  wslpi_temp(jpi,jpj,jpk),      &
+            &      vslp_temp(jpi,jpj,jpk)   ,  wslpj_temp(jpi,jpj,jpk),      &
+            &      uslp_tm  (jpi,jpj,jpk)   ,  wslpi_tm  (jpi,jpj,jpk),      &
+            &      vslp_tm  (jpi,jpj,jpk)   ,  wslpj_tm  (jpi,jpj,jpk),  STAT=trc_sub_alloc )
+      ENDIF
+      !
+      IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate ldf_slp arrays')
       !
    END FUNCTION trc_sub_alloc
@@ -603,5 +596,4 @@
       WRITE(*,*) 'trc_sub_ini: You should not have seen this print! error?', kt
    END SUBROUTINE trc_sub_ini
-
 #endif
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 6808)
@@ -26,7 +26,4 @@
 
    PUBLIC trc_wri      
-
-   !! * Substitutions
-#  include "top_substitute.h90"
 
 CONTAINS
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC40_METO
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC40_METO	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC40_METO	(revision 6808)
@@ -2,7 +2,7 @@
 #!
 #PBS -N nemo_sette
-#PBS -l walltime=00:30:00
+#PBS -l walltime=00:08:00
 #PBS -j oe
-#PBS -q QUEUE
+#PBS -q normal
 #PBS -l SELECT
 
@@ -77,12 +77,6 @@
 # Run SPMD case
 #
-    if [ $OCORES -gt 32 ] ; then
-        #Still more than one node so run in parallel queue
-        echo time aprun -b  -n $OCORES -N $O_PER_NODE ./opa
-             time aprun -b  -n $OCORES -N $O_PER_NODE ./opa
-    else
-       echo time mpiexec -n $OCORES ./opa
-            time mpiexec -n $OCORES ./opa
-    fi
+    echo time aprun -b  -n $OCORES -N $O_PER_NODE ./opa
+         time aprun -b  -n $OCORES -N $O_PER_NODE ./opa
   fi
 #
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_MERCATOR_CLUSTER
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_MERCATOR_CLUSTER	(revision 6807)
+++ 	(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 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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena	(revision 6808)
@@ -0,0 +1,80 @@
+#!/bin/bash 
+#!
+#BSUB -q poe_short
+#BSUB -n NPROCS
+#BSUB -a poe
+#BSUB -J MPI_config
+#BSUB -o poe.stdout.%J
+#BSUB -e poe.stderr.%J
+
+ 
+
+###############################################################
+# 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)
+#
+
+# export MPIRUN="mpirun -n $OCEANCORES"
+
+export MPIRUN="mpirun.lsf"
+
+#
+# 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} " $OCEANCORES " ./opa"
+#
+
+  if [ MPI_FLAG == "yes" ]; then
+     time ${MPIRUN} ./opa
+  else
+     time ./opa
+  fi
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line 
+
+  exit
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena_xios
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena_xios	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena_xios	(revision 6808)
@@ -0,0 +1,106 @@
+#!/bin/bash 
+#!
+#BSUB -q poe_short
+#BSUB -n TOTAL_NPROCS
+#BSUB -a poe
+#BSUB -J MPI_config
+#BSUB -o poe.stdout.%J
+#BSUB -e poe.stderr.%J
+
+ 
+
+###############################################################
+# 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
+  XIOS_NUMPROCS=NXIOPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
+#
+
+# export MPIRUN="mpirun -n $OCEANCORES"
+
+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
+export MPIRUN="mpirun.lsf"
+
+export LD_LIBRARY_PATH=${XIOS}/lib:${LD_LIBRARY_PATH}
+
+XIOS_SERVER_PATHNAME="${XIOS}/bin/xios_server.exe"
+
+#
+# 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} " $OCEANCORES " ./opa"
+#
+
+  if [ MPI_FLAG == "yes" ]; then
+     if [ $XIOS_NUMPROCS -eq 0 ]; then
+       time ${MPIRUN} ./opa
+     else
+
+       export MP_PGMMODEL=mpmd
+       export MP_CMDFILE=xioscmdfile
+       rm xioscmdfile &> /dev/null
+       touch xioscmdfile
+       k=0
+       while (( k < $OCEANCORES )) ; do
+          echo ./opa >> xioscmdfile
+          k=`expr $k + 1`
+       done
+       k=0
+       while (( k < $XIOS_NUMPROCS )) ; do
+          echo $XIOS_SERVER_PATHNAME >> xioscmdfile
+          k=`expr $k + 1`
+       done
+
+       time ${MPIRUN}
+     fi
+  else
+     time ./opa
+  fi
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line 
+
+  exit
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR	(revision 6808)
@@ -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 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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/input_ORCA2_LIM.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/input_ORCA2_LIM.cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/input_ORCA2_LIM.cfg	(revision 6808)
@@ -1,1 +1,1 @@
-ORCA2_LIM_nemo_v3.6.tar ORCA2_LIM_nemo_v3.6
+ORCA2_LIM_nemo_v3.6st.tar ORCA2_LIM_nemo_v3.6
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/param.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/param.cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/param.cfg	(revision 6808)
@@ -1,8 +1,8 @@
-#- forcing files storing 
+#- forcing files storing
 FORCING_DIR=~/FORCING
-#- input files storing 
+#- input files storing
 INPUT_DIR=${CONFIG_DIR}/${NEW_CONF}/EXP00
 #- only for IBM
 #TMPDIR=${CONFIG_DIR}/${NEW_CONF}/EXP00
-#- VALIDATION files storing 
+#- VALIDATION files storing
 NEMO_VALIDATION_DIR=~/NEMO_VALIDATION
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/prepare_exe_dir.sh
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/prepare_exe_dir.sh	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/prepare_exe_dir.sh	(revision 6808)
@@ -70,5 +70,5 @@
 export EXE_DIR=${CONFIG_DIR}/${NEW_CONF}/${TEST_NAME}
 
-cp -r ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/.
+cp -rL ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/.
 cp -r ${SETTE_DIR}/iodef_sette.xml ${EXE_DIR}/iodef.xml
 cd ${EXE_DIR}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/prepare_job.sh
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/prepare_job.sh	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/prepare_job.sh	(revision 6808)
@@ -266,19 +266,9 @@
                                 echo NB_XNODES=${NB_XNODES} 
                                 echo Total NB_NODES=${NB_NODES}
-                                if [ ${NB_NODES} -eq 1 ] ; then
-                                   QUEUE=shared
-                                   #Not using XIOS in detatched mode and using less than one node so should be ok on shared node
-                                   #Load snplauncher module to allow use of mpiexec
-                                   SELECT="select=1:ncpus=$((NXIO_PROC + NB_PROC))":mem=15GB
-                                   module load cray-snplauncher
-                                   echo 'Shared Queue'
-                                else
-                                   QUEUE=normal
-                                   SELECT="select=$NB_NODES"
-                                   module unload cray-snplauncher #Make sure snplauncher module is not loaded
-                                   echo 'Normal Queue'
-                                fi
+                                QUEUE=normal
+                                SELECT="select=$NB_NODES"
+                                module unload cray-snplauncher #Make sure snplauncher module is not loaded
                                 ;;
-                        ifort_MERCATOR_CLUSTER)
+                        openmpi_NAVITI_MERCATOR)
                                 echo NB_PROCS ${NB_PROC}
                                 echo NB_NODES ${NB_NODES}
@@ -289,12 +279,12 @@
                                    NB_PROC_NODE=${NB_PROC}
                                 else
-                                   if [ ${NB_PROC} -le 8 ] ; then
+                                   if [ ${NB_PROC} -le 16 ] ; then
                                       NB_NODES=1
                                       QUEUE=mono
                                       NB_PROC_NODE=${NB_PROC}
                                    else
-                                      NB_NODES=$( echo $NB_PROC | awk '{print $1 - $1 % 8}'  | awk '{print $1 / 8 }')
+                                      NB_NODES=$( echo $NB_PROC | awk '{print $1 - $1 % 16}'  | awk '{print $1 / 16 }')
                                       QUEUE=multi
-                                      NB_PROC_NODE=8
+                                      NB_PROC_NODE=16
                                   fi
                                 fi
@@ -324,8 +314,5 @@
 
         case ${COMPILER} in
-              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
+              openmpi_NAVITI_MERCATOR)
                     cat run_sette_test.job | sed -e"s/NPROC_NODE/${NB_PROC_NODE}/" \
                                                  -e"s:QUEUE:${QUEUE}:" > run_sette_test1.job
@@ -333,6 +320,5 @@
                     ;;
               XC40_METO*)
-                    cat run_sette_test.job | sed -e"s/QUEUE/${QUEUE}/" \
-                                                 -e"s/SELECT/${SELECT}/" > run_sette_test1.job
+                    cat run_sette_test.job | sed -e"s/SELECT/${SELECT}/" > run_sette_test1.job
                     mv run_sette_test1.job run_sette_test.job
                     ;;
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/sette.sh
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/sette.sh	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/sette.sh	(revision 6808)
@@ -140,7 +140,9 @@
 # SAS             :11 & 12
 # ISOMIP          :13 & 14
-# 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
+# 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 15 16
 
 do
@@ -166,5 +168,5 @@
     set_namelist namelist_cfg ln_clobber .true.
     set_namelist namelist_cfg nn_fwb 0
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     set_namelist namelist_cfg jpni 2
     set_namelist namelist_cfg jpnj 2
@@ -190,5 +192,5 @@
     set_namelist namelist_cfg ln_clobber .true.
     set_namelist namelist_cfg nn_fwb 0
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     set_namelist namelist_cfg jpni 2
     set_namelist namelist_cfg jpnj 2
@@ -236,5 +238,5 @@
     set_namelist namelist_cfg ln_ctl .false.
     set_namelist namelist_cfg ln_clobber .true.
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     set_namelist namelist_cfg jpni 1
     set_namelist namelist_cfg jpnj 4
@@ -263,5 +265,5 @@
     set_namelist namelist_cfg ln_ctl .false.
     set_namelist namelist_cfg ln_clobber .true.
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     set_namelist namelist_cfg jpni 2
     set_namelist namelist_cfg jpnj 2
@@ -290,5 +292,5 @@
     . ./prepare_exe_dir.sh
     JOB_FILE=${EXE_DIR}/run_job.sh
-    NPROC=4
+    NPROC=8
     if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
     cd ${EXE_DIR}
@@ -300,7 +302,7 @@
     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 namelist_cfg jpnj 4
+    set_namelist namelist_cfg jpnij 8
+#   set_namelist namelist_cfg nn_solv 2
     set_namelist namelist_top_cfg ln_trcdta .false.
     set_namelist namelist_top_cfg ln_diatrc .false.
@@ -336,7 +338,7 @@
     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 namelist_cfg jpnj 4
+    set_namelist namelist_cfg jpnij 8
+#   set_namelist namelist_cfg nn_solv 2
     set_namelist namelist_top_cfg ln_diatrc .false.
     set_namelist namelist_top_cfg ln_rsttr .true.
@@ -396,5 +398,5 @@
     set_namelist namelist_cfg jpnj 4
     set_namelist namelist_cfg jpnij 16
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     set_namelist namelist_top_cfg ln_trcdta .false.
     set_namelist namelist_top_cfg ln_diatrc .false.
@@ -435,5 +437,5 @@
     set_namelist namelist_cfg jpnj 8
     set_namelist namelist_cfg jpnij 16
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     set_namelist namelist_top_cfg ln_trcdta .false.
     set_namelist namelist_top_cfg ln_diatrc .false.
@@ -472,5 +474,5 @@
     . ./prepare_exe_dir.sh
     JOB_FILE=${EXE_DIR}/run_job.sh
-    NPROC=4
+    NPROC=8
     if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
     cd ${EXE_DIR}
@@ -481,6 +483,6 @@
     set_namelist namelist_cfg ln_clobber .true.
     set_namelist namelist_cfg jpni 2
-    set_namelist namelist_cfg jpnj 2
-    set_namelist namelist_cfg jpnij 4
+    set_namelist namelist_cfg jpnj 4
+    set_namelist namelist_cfg jpnij 8
     set_namelist namelist_top_cfg ln_trcdta .false.
     set_namelist namelist_top_cfg ln_diatrc .false.
@@ -515,6 +517,6 @@
     set_namelist namelist_cfg ln_clobber .true.
     set_namelist namelist_cfg jpni 2
-    set_namelist namelist_cfg jpnj 2
-    set_namelist namelist_cfg jpnij 4
+    set_namelist namelist_cfg jpnj 4
+    set_namelist namelist_cfg jpnij 8
     set_namelist namelist_top_cfg ln_diatrc .false.
     set_namelist namelist_top_cfg ln_rsttr .true.
@@ -656,5 +658,5 @@
     set_namelist namelist_cfg jpnj 2
     set_namelist namelist_cfg jpnij 4
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     if [ ${USING_MPMD} == "yes" ] ; then
        set_xio_using_server iodef.xml true
@@ -680,5 +682,5 @@
     set_namelist namelist_cfg jpnj 2
     set_namelist namelist_cfg jpnij 4
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     set_namelist namelist_cfg cn_ocerst_in \"O2L3_LONG_00000075_restart\"
     set_namelist namelist_ice_cfg cn_icerst_in \"O2L3_LONG_00000075_restart_ice\"
@@ -721,5 +723,5 @@
     set_namelist namelist_cfg jpnj 4
     set_namelist namelist_cfg jpnij 16
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     if [ ${USING_MPMD} == "yes" ] ; then
        set_xio_using_server iodef.xml true
@@ -746,5 +748,5 @@
     set_namelist namelist_cfg jpnj 8
     set_namelist namelist_cfg jpnij 16
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     if [ ${USING_MPMD} == "yes" ] ; then
        set_xio_using_server iodef.xml true
@@ -1017,5 +1019,5 @@
     set_namelist namelist_cfg ln_clobber .true.
     set_namelist namelist_cfg nn_fwb 0
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     set_namelist namelist_cfg jpni 2
     set_namelist namelist_cfg jpnj 2
@@ -1041,5 +1043,5 @@
     set_namelist namelist_cfg ln_clobber .true.
     set_namelist namelist_cfg nn_fwb 0
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     set_namelist namelist_cfg jpni 2
     set_namelist namelist_cfg jpnj 2
@@ -1086,5 +1088,5 @@
     set_namelist namelist_cfg ln_ctl .false.
     set_namelist namelist_cfg ln_clobber .true.
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     set_namelist namelist_cfg jpni 1
     set_namelist namelist_cfg jpnj 4
@@ -1113,5 +1115,5 @@
     set_namelist namelist_cfg ln_ctl .false.
     set_namelist namelist_cfg ln_clobber .true.
-    set_namelist namelist_cfg nn_solv 2
+#   set_namelist namelist_cfg nn_solv 2
     set_namelist namelist_cfg jpni 2
     set_namelist namelist_cfg jpnj 2
@@ -1135,5 +1137,5 @@
     export TEST_NAME="REPRO_4_4"
     cd ${CONFIG_DIR}
-    . ./makenemo -m ${CMP_NAM} -n ORCA2_LIM_OBS -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_diaobs key_asminc" del_key ${DEL_KEYS}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2_LIM_OBS -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_asminc" del_key ${DEL_KEYS}
     cd ${SETTE_DIR}
     . ./param.cfg
@@ -1152,13 +1154,11 @@
     set_namelist namelist_cfg jpnj 4
     set_namelist namelist_cfg jpnij 16
-    set_namelist namelist_cfg nn_solv 2   
+    set_namelist namelist_cfg ln_diaobs .true.
     set_namelist namelist_cfg ln_t3d .true.
     set_namelist namelist_cfg ln_s3d .true.
-    set_namelist namelist_cfg ln_profb .true.
     set_namelist namelist_cfg ln_sst .true.
-    set_namelist namelist_cfg ln_sstfb .true.
     set_namelist namelist_cfg ln_sla .true.
-    set_namelist namelist_cfg ln_slafb .true.
-    set_namelist namelist_cfg ln_seaice .false.
+    set_namelist namelist_cfg ln_sic .true.
+    set_namelist namelist_cfg ln_vel3d .true.
     set_namelist namelist_cfg ln_bkgwri .true.
     set_namelist namelist_cfg ln_trainc .true.
@@ -1191,13 +1191,11 @@
     set_namelist namelist_cfg jpnj 8
     set_namelist namelist_cfg jpnij 16
-    set_namelist namelist_cfg nn_solv 2
+    set_namelist namelist_cfg ln_diaobs .true.
     set_namelist namelist_cfg ln_t3d .true.
     set_namelist namelist_cfg ln_s3d .true.
-    set_namelist namelist_cfg ln_profb .true.
     set_namelist namelist_cfg ln_sst .true.
-    set_namelist namelist_cfg ln_sstfb .true.
     set_namelist namelist_cfg ln_sla .true.
-    set_namelist namelist_cfg ln_slafb .true.
-    set_namelist namelist_cfg ln_seaice .false.
+    set_namelist namelist_cfg ln_sic .true.
+    set_namelist namelist_cfg ln_vel3d .true.
     set_namelist namelist_cfg ln_bkgwri .true.
     set_namelist namelist_cfg ln_trainc .true.
@@ -1237,8 +1235,10 @@
     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
@@ -1252,3 +1252,229 @@
 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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/sette_rpt
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/sette_rpt	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/sette_rpt	(revision 6808)
@@ -90,24 +90,48 @@
     set f1o = ./WORCA2LIMPIS_LONG/{$mach}/{$dorv}/LONG/ocean.output
     set f1s = ./WORCA2LIMPIS_LONG/{$mach}/{$dorv}/LONG/solver.stat
+    set f1t = ./WORCA2LIMPIS_LONG/{$mach}/{$dorv}/LONG/tracer.stat
     set f2o = ./WORCA2LIMPIS_LONG/{$mach}/{$dorv}/SHORT/ocean.output
     set f2s = ./WORCA2LIMPIS_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 "ORCA2LIMPIS restartability  passed"
-    else
-      echo "ORCA2LIMPIS 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
+    set f2t = ./WORCA2LIMPIS_LONG/{$mach}/{$dorv}/SHORT/tracer.stat
+
+    set stato = 0
+    set nl = `wc -l $f2s`
+    tail -$nl[1] $f1s > f1.tmp$$
+    cmp -s f1.tmp$$ $f2s
+    if ( $status == 0 ) then
+      echo "ORCA2LIMPIS solver.stat restartability  passed"
+    else
+      set stato = 1
+      echo "ORCA2LIMPIS solver.stat restartability  FAILED"
+      if ( $pass == 1 ) then
+        echo "<return> to view solver.stat differences"
+        set y = $<
+        sdiff f1.tmp$$ $f2s
+      endif
+    endif
+
+    set nl = `wc -l $f2t`
+    tail -$nl[1] $f1t > f1.tmp$$
+    cmp -s f1.tmp$$ $f2t
+    if ( $status == 0 ) then
+      echo "ORCA2LIMPIS tracer.stat restartability  passed"
+    else
+      set stato = 1
+      echo "ORCA2LIMPIS tracer.stat restartability  FAILED"
+      if ( $pass == 1 ) then
+        echo "<return> to view tracer.stat differences"
+        set y = $<
+        sdiff f1.tmp$$ $f2t
+      endif
+    endif
+    if ( $stato == 1 ) then
+      if ( $pass == 1 ) then
+        echo "<return> to view ocean.output differences"
+        set y = $<
+        sdiff $f1o $f2o | grep "|"
+        echo "<return> to continue"
+        set y = $<
+      endif
+      set stato = 0
     endif
     rm f1.tmp$$
@@ -293,22 +317,44 @@
     set f1o = ./WORCA2LIMPIS_16/{$mach}/{$dorv}/REPRO_2_8/ocean.output
     set f1s = ./WORCA2LIMPIS_16/{$mach}/{$dorv}/REPRO_2_8/solver.stat
+    set f1t = ./WORCA2LIMPIS_16/{$mach}/{$dorv}/REPRO_2_8/tracer.stat
     set f2o = ./WORCA2LIMPIS_16/{$mach}/{$dorv}/REPRO_4_4/ocean.output
     set f2s = ./WORCA2LIMPIS_16/{$mach}/{$dorv}/REPRO_4_4/solver.stat
-  
-    cmp -s $f1s $f2s
-    if ( $status == 0 ) then
-      echo "ORCA2LIMPIS reproducibility passed"
-    else
-      echo "ORCA2LIMPIS 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
+    set f2t = ./WORCA2LIMPIS_16/{$mach}/{$dorv}/REPRO_4_4/tracer.stat
+
+    set stato = 0
+    cmp -s $f1s $f2s
+    if ( $status == 0 ) then
+      echo "ORCA2LIMPIS solver.stat reproducibility  passed"
+    else
+      set stato = 1
+      echo "ORCA2LIMPIS solver.stat reproducibility  FAILED"
+      if ( $pass == 1 ) then
+        echo "<return> to view solver.stat differences"
+        set y = $<
+        sdiff $f1s $f2s
+      endif
+    endif
+
+    cmp -s $f1t $f2t
+    if ( $status == 0 ) then
+      echo "ORCA2LIMPIS tracer.stat reproducibility  passed"
+    else
+      set stato = 1
+      echo "ORCA2LIMPIS tracer.stat reproducibility  FAILED"
+      if ( $pass == 1 ) then
+        echo "<return> to view tracer.stat differences"
+        set y = $<
+        sdiff $f1t $f2t
+      endif
+    endif
+    if ( $stato == 1 ) then
+      if ( $pass == 1 ) then
+        echo "<return> to view ocean.output differences"
+        set y = $<
+        sdiff $f1o $f2o | grep "|"
+        echo "<return> to continue"
+        set y = $<
+      endif
+      set stato = 0
     endif
   endif
@@ -379,4 +425,31 @@
     else
       echo "ORCA2LIM3   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 ./WORCA2_LIM_OBS ) then
+    set dorv = `ls -1rtd ./WORCA2_LIM_OBS/{$mach}/* | tail -1l `
+    set dorv = $dorv:t
+    set f1o = ./WORCA2_LIM_OBS/{$mach}/{$dorv}/REPRO_2_8/ocean.output
+    set f1s = ./WORCA2_LIM_OBS/{$mach}/{$dorv}/REPRO_2_8/solver.stat
+    set f2o = ./WORCA2_LIM_OBS/{$mach}/{$dorv}/REPRO_4_4/ocean.output
+    set f2s = ./WORCA2_LIM_OBS/{$mach}/{$dorv}/REPRO_4_4/solver.stat
+
+    cmp -s $f1s $f2s
+    if ( $status == 0 ) then
+      echo "ORCA2_LIM_OBS   reproducibility passed"
+    else
+      echo "ORCA2_LIM_OBS   reproducibility FAILED"
       if ( $pass == 1 ) then
         echo "<return> to view solver.stat differences"
@@ -440,4 +513,88 @@
   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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/sette_rpt.sh
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/sette_rpt.sh	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/SETTE/sette_rpt.sh	(revision 6808)
@@ -0,0 +1,229 @@
+#!/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
+#
+  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
+#
+  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
+}
+########################### END of function definitions #################################
+##                                                                                     ##
+##    Main script                                                                      ##
+##                                                                                     ##
+#########################################################################################
+#
+  mach=`grep "COMPILER=" ./sette.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
+ 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
+ done
+#
+done
+exit
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 6808)
@@ -57,8 +57,15 @@
 #- 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 ${TOOLS_DIR}/conv.cfg || exit 1
-gmake -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB
+ #- CONV
+fcm build ${COMPIL_DIR}/conv.cfg || exit 1
+#C_COMPILER=${CC-cc}
+#gmake CC=${C_COMPILER} -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB
 
 #- AGRIF sources
@@ -67,5 +74,6 @@
 [ ! -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 ${MAIN_DIR}/EXTERNAL/AGRIF/conv  $2/$1/OPAFILES/
+cp -f -r $2/$1/AGRIFLIB/bin/conv  $2/$1/OPAFILES/
 
 fi
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/COMPILE/bld.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 6808)
@@ -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
+bld::tool::fppflags::agrif     %FPPFLAGS -include ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h
 
 # Ignore the following dependencies
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg	(revision 6808)
@@ -52,4 +52,5 @@
 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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/COMPILE/conv.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 6808)
@@ -8,6 +8,8 @@
 # Build information
 # ------------------------------------------------------------------------------
-inc $COMPIL_DIR/arch.fcm
+inc $COMPIL_DIR/arch_nemo.fcm
 
+bld::tool::cc        %CC
+bld::tool::cflags    %CFLAGS
 bld::tool::make      %MK
 
@@ -19,8 +21,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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/agulhas
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/agulhas	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/agulhas	(revision 6808)
@@ -17,4 +17,5 @@
     removeclosedseas = true
     type_bathy_interp = 0 
+    rn_hmin = -3 
 /   
 
@@ -39,4 +40,8 @@
     pa1  = 245.58132232490
     N  = 31
+    ldbletanh   = .FALSE.
+    ppa2        = 0.0
+    ppkth2      = 0.0
+    ppacr2      = 0.0
 /    
     
@@ -45,6 +50,6 @@
     parent_bathy_meter = 'bathy_meter.nc'
     parent_batmet_name = 'Bathymetry'
-    e3zps_min = 25.
-    e3zps_rat = 0.2
+    e3zps_min = 20.
+    e3zps_rat = 0.1
 /
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 6808)
@@ -105,5 +105,5 @@
     IMPLICIT NONE
     !
-    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax
     TYPE(Coordinates) :: Grid
     INTEGER :: i,j
@@ -134,4 +134,5 @@
        za0  = pa0
        za1  = pa1
+       za2  = pa2
        !
     ELSE
@@ -147,19 +148,49 @@
 
     zacr = ppacr
-    zkth = ppkth 
-
+    zkth = ppkth
+    zacr2 = ppacr2
+    zkth2 = ppkth2   
     !
     ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
     !
-    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
+    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
     !
     gdepw(1) = 0.0
     zmax = gdepw(N) + e3t(N)
-    zmin = gdepw(4)
+    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)
     !
     IF ( .NOT. ASSOCIATED(Grid%bathy_level)) &
@@ -227,5 +258,5 @@
     IMPLICIT NONE
     !
-    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax
     TYPE(Coordinates) :: Grid
     INTEGER :: i,j
@@ -257,4 +288,5 @@
        za0  = pa0
        za1  = pa1
+       za2  = pa2
        !
     ELSE
@@ -264,22 +296,48 @@
        WRITE(*,*) 'please check values of variables'
        WRITE(*,*) 'in namelist vertical_grid section'
-       WRITE(*,*) ' '
-       STOP      
+       WRITE(*,*) ' ' 
+       STOP     
        !       
     ENDIF
-    !
+
     zacr = ppacr
-    zkth = ppkth 
-
+    zkth = ppkth
+    zacr2 = ppacr2
+    zkth2 = ppkth2   
     !
     ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
     !
-    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
+    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
     !
     gdepw(1) = 0.0  
@@ -684,8 +742,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 gdepw(4) *
-  ! 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 rn_hmin  *
+  ! value						          *
   !								*
   ! - input :							*
@@ -704,5 +762,5 @@
     !
     INTEGER :: ideb,jdeb,ifin,jfin
-    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin
     INTEGER :: i,j
     INTEGER :: k1
@@ -727,4 +785,5 @@
        za0  = pa0
        za1  = pa1
+       za2  = pa2
        !
     ELSE
@@ -740,18 +799,47 @@
 
     zacr = ppacr
-    zkth = ppkth 
-
+    zkth = ppkth
+    zacr2 = ppacr2
+    zkth2 = ppkth2   
     !
     ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
     !
-    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)
+    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)
     !      
     diff = 0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart.f90	(revision 6808)
@@ -411,5 +411,5 @@
         ENDIF
         !
-     CASE('nfice','nfbulk','kt','ndastp','adatrj','rdt','rdttra1') 
+     CASE('nfice','nfbulk','kt','ndastp','adatrj','rdt') 
         IF(.NOT. dimg ) THEN
            WRITE(*,*) 'copy ',TRIM(Ncdf_varname(i))
@@ -417,5 +417,5 @@
               CALL Read_Ncdf_var(TRIM(Ncdf_varname(i)),TRIM(restart_file),tabtemp0dreal)  
               SELECT CASE (TRIM(Ncdf_varname(i)))
-              CASE('rdt','rdttra1')
+              CASE('rdt')
                  tabtemp0dreal = tabtemp0dreal/rhot
               CASE('kt')
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 6808)
@@ -36,5 +36,5 @@
     !       
     TYPE(Coordinates) :: Grid                     
-    REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
     INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt
     INTEGER, DIMENSION(1) :: k
@@ -76,4 +76,5 @@
        za0  = pa0
        za1  = pa1
+       za2  = pa2
        !
     ELSE
@@ -88,17 +89,41 @@
     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
-    !
-
+    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
     gdepw(1) = 0.0  
     !
@@ -106,5 +131,8 @@
     !
     zmax = gdepw(N) + e3t(N)
-    zmin = gdepw(4)
+    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)
     !
     ! Initialize bathy_level to the maximum ocean level available
@@ -235,11 +263,12 @@
     INTEGER :: i,j,ji,ij,ii,jj,jpt,ipt
     REAL,DIMENSION(N) :: gdepw,e3t
-    REAL :: za0,za1,zsur,zacr,zkth,zmin,zmax,zdepth
+    REAL :: za0,za1,za2,zsur,zacr,zacr2,zkth,zkth2,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) &
@@ -253,7 +282,9 @@
          pa0.NE.0 .AND. pa1.NE.0 ) THEN
        !       
+       WRITE(*,*) 'psur,pa0,pa1 given by namelist'
        zsur = psur
        za0  = pa0
        za1  = pa1
+       za2  = pa2
        !
     ELSE
@@ -263,19 +294,39 @@
        WRITE(*,*) 'please check values of variables'
        WRITE(*,*) 'in namelist vertical_grid section'
-       WRITE(*,*) ' '      
-       !       
-    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
-    !
+       WRITE(*,*) ' '  
+       STOP    
+       !       
+    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
     gdepw(1) = 0.0
-    !
     !
     diff = 0      
@@ -344,5 +395,8 @@
     !
     zmax = gdepw(N) + e3t(N)
-    zmin = gdepw(4) 
+    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)
     !
     ! check that interpolated value stays at the same level         
@@ -646,5 +700,5 @@
     REAL*8, DIMENSION(:,:,:) :: fse3u,fse3t,fse3v
     !                                  
-    REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
     INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt,jpk
     INTEGER, DIMENSION(1) :: k
@@ -660,5 +714,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 
@@ -668,6 +722,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 )  )
@@ -676,18 +730,53 @@
          pa0.NE.0 .AND. pa1.NE.0 ) THEN
        !       
+       WRITE(*,*) 'psur,pa0,pa1 given by namelist'
        zsur = psur
        za0  = pa0
-       za1  = pa1   
-       !       
-    ENDIF
-
-    zacr = ppacr
-    zkth = ppkth       
+       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    
+       !       
+    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         
     !         
     !                
     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)
@@ -700,5 +789,8 @@
     !
     zmax = gdepw(jpk) + e3t(jpk)
-    zmin = gdepw(4)
+    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 jj = 1, jpj
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 6808)
@@ -51,7 +51,9 @@
   INTEGER jpizoom,jpjzoom,nb_connection_pts
   !      
-  REAL*8 ppacr,ppdzmin,pphmax,ppkth,smoothing_factor,e3zps_min,e3zps_rat
-  REAL*8 psur,pa0,pa1,adatrj
+  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
   !       
+  LOGICAL ldbletanh
   LOGICAL partial_steps,smoothing,bathy_update
   LOGICAL new_topo,removeclosedseas,dimg,iom_activated
@@ -70,9 +72,9 @@
   !      
   NAMELIST /bathymetry/new_topo,elevation_database,elevation_name,smoothing,smoothing_factor, &
-       nb_connection_pts,removeclosedseas,type_bathy_interp      
+       nb_connection_pts,removeclosedseas,type_bathy_interp,rn_hmin      
   !      
   NAMELIST /nesting/imin,imax,jmin,jmax,rho,rhot,bathy_update,updated_parent_file      
   !
-  NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N
+  NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N,ldbletanh,ppa2,ppkth2,ppacr2
   ! 
   NAMELIST /partial_cells/partial_steps,parent_bathy_meter,parent_batmet_name,e3zps_min,e3zps_rat      
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/in_out_manager.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/in_out_manager.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/in_out_manager.F90	(revision 6808)
@@ -37,6 +37,4 @@
    INTEGER       ::   nn_write      =   10        !: model standard output frequency
    INTEGER       ::   nn_stock      =   10        !: restart file frequency
-   LOGICAL       ::   ln_dimgnnn    = .FALSE.     !: type of dimgout. (F): 1 file for all proc
-                                                       !:                  (T): 1 file per proc
    LOGICAL       ::   ln_mskland    = .FALSE.     !: mask land points in NetCDF outputs (costly: + ~15%)
    LOGICAL       ::   ln_clobber    = .FALSE.     !: clobber (overwrite) an existing file
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_prof_io.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_prof_io.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_prof_io.F90	(revision 6808)
@@ -1,1 +1,32 @@
-link ../../../NEMO/OPA_SRC/OBS/obs_prof_io.F90
+MODULE obs_prof_io
+   !!======================================================================
+   !!                       ***  MODULE obs_prof_io  ***
+   !! Observation operators : I/O for ENACT and Coriolis files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_enactfile    :  Read a obfbdata structure from an ENACT file.
+   !!   read_coriofile    :  Read a obfbdata structure from an Coriolis file.
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE obs_conv
+   USE netcdf
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER :: imaxlev = 10000
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obs_prof_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsprof_io.h90"
+
+END MODULE obs_prof_io
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_seaice_io.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_seaice_io.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_seaice_io.F90	(revision 6808)
@@ -0,0 +1,30 @@
+MODULE obs_seaice_io
+   !!======================================================================
+   !!                       ***  MODULE obs_seaice_io  ***
+   !! Observation operators : I/O for GHRSEAICE files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_seaicefile    :  Read a obfbdata structure from an GHRSEAICE file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE julian
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obs_seaice_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsseaice_io.h90"
+
+END MODULE obs_seaice_io
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_io.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_io.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_io.F90	(revision 6808)
@@ -1,1 +1,30 @@
-link ../../../NEMO/OPA_SRC/OBS/obs_sla_io.F90
+MODULE obs_sla_io
+   !!======================================================================
+   !!                       ***  MODULE obs_sla_io  ***
+   !! Observation operators : I/O for AVISO SLA files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_enactfile    :  Read a obfbdata structure from an AVISO SLA file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   use obs_sla_types
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obs_sla_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obssla_io.h90"
+
+END MODULE obs_sla_io
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_types.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_types.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_types.F90	(revision 6808)
@@ -1,1 +1,19 @@
-link ../../../NEMO/OPA_SRC/OBS/obs_sla_types.F90
+MODULE obs_sla_types
+   !!======================================================================
+   !!                       ***  MODULE obs_sla_type  ***
+   !! Observation operators : Satellite identifiers for SLA data
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obs_sla_types.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+
+#include "obssla_types.h90"
+
+END MODULE obs_sla_types
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sst_io.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sst_io.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sst_io.F90	(revision 6808)
@@ -0,0 +1,30 @@
+MODULE obs_sst_io
+   !!======================================================================
+   !!                       ***  MODULE obs_sst_io  ***
+   !! Observation operators : I/O for GHRSST files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_sstfile    :  Read a obfbdata structure from an GHRSST file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE julian
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obs_sst_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obssst_io.h90"
+
+END MODULE obs_sst_io
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_vel_io.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_vel_io.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obs_vel_io.F90	(revision 6808)
@@ -1,1 +1,32 @@
-link ../../../NEMO/OPA_SRC/OBS/obs_vel_io.F90
+MODULE obs_vel_io
+   !!======================================================================
+   !!                       ***  MODULE obs_vel_io  ***
+   !! Observation operators : I/O for TAO velocity data
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version based on obs_read_taovel
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_taofile    :  Read a obfbdata structure from an TAO velocity file.
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE obs_conv
+   USE in_out_manager
+   USE netcdf
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER :: imaxlev = 10000
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obs_vel_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsvel_io.h90"
+
+END MODULE obs_vel_io
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obsprof_io.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obsprof_io.h90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obsprof_io.h90	(revision 6808)
@@ -1,1 +1,834 @@
-link ../../../NEMO/OPA_SRC/OBS/obsprof_io.h90
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obsprof_io.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_enactfile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_enactfile **
+      !!
+      !! ** Purpose : Read from file the profile ENACT observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      INTEGER :: iobs                ! Number of observations
+      INTEGER :: ilev                      ! Number of levels
+      INTEGER :: i_file_id
+      INTEGER :: i_obs_id
+      INTEGER :: i_lev_id
+      INTEGER :: i_phi_id
+      INTEGER :: i_lam_id
+      INTEGER :: i_depth_id
+      INTEGER :: i_var_id
+      INTEGER :: i_pl_num_id
+      INTEGER :: i_reference_date_time_id
+      INTEGER :: i_format_version_id
+      INTEGER :: i_juld_id
+      INTEGER :: i_data_type_id
+      INTEGER :: i_wmo_inst_type_id
+      INTEGER :: i_qc_var_id
+      INTEGER :: i_dc_ref_id
+      INTEGER :: i_qc_flag_id
+      CHARACTER(LEN=40) :: cl_fld_lam
+      CHARACTER(LEN=40) :: cl_fld_phi
+      CHARACTER(LEN=40) :: cl_fld_depth 
+      CHARACTER(LEN=40) :: cl_fld_var_tp
+      CHARACTER(LEN=40) :: cl_fld_var_s
+      CHARACTER(LEN=40) :: cl_fld_var_ti
+      CHARACTER(LEN=40) :: cl_fld_var_juld_qc
+      CHARACTER(LEN=40) :: cl_fld_var_pos_qc
+      CHARACTER(LEN=40) :: cl_fld_var_depth_qc 
+      CHARACTER(LEN=40) :: cl_fld_var_qc_t
+      CHARACTER(LEN=40) :: cl_fld_var_qc_s
+      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_t
+      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_s
+      CHARACTER(LEN=40) :: cl_fld_reference_date_time
+      CHARACTER(LEN=40) :: cl_fld_juld
+      CHARACTER(LEN=40) :: cl_fld_data_type
+      CHARACTER(LEN=40) :: cl_fld_pl_num
+      CHARACTER(LEN=40) :: cl_fld_format_version
+      CHARACTER(LEN=40) :: cl_fld_wmo_inst_type
+      CHARACTER(LEN=40) :: cl_fld_qc_flags_profiles
+      CHARACTER(LEN=40) :: cl_fld_qc_flags_levels
+
+      CHARACTER(LEN=14), PARAMETER :: cl_name = 'read_enactfile'
+      CHARACTER(LEN=16)            :: cl_data_type = ''
+      CHARACTER(LEN=4 )            :: cl_format_version = ''
+      INTEGER, DIMENSION(1) :: istart1, icount1
+      INTEGER, DIMENSION(2) :: istart2, icount2
+      CHARACTER(len=imaxlev) :: clqc
+      CHARACTER(len=1) :: cqc
+      INTEGER :: ji, jk
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: iqc1
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iqc2
+
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      cl_fld_lam                 = 'LONGITUDE'
+      cl_fld_phi                 = 'LATITUDE'
+      cl_fld_depth               = 'DEPH_CORRECTED'
+      cl_fld_reference_date_time = 'REFERENCE_DATE_TIME'
+      cl_fld_juld                = 'JULD'
+      cl_fld_data_type           = 'DATA_TYPE'
+      cl_fld_format_version      = 'FORMAT_VERSION'
+      cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
+      cl_fld_pl_num              = 'PLATFORM_NUMBER'
+
+      cl_fld_var_qc_t            = 'POTM_CORRECTED_QC'
+      cl_fld_var_prof_qc_t       = 'PROFILE_POTM_QC'
+      cl_fld_var_tp              = 'POTM_CORRECTED'
+      cl_fld_var_qc_s            = 'PSAL_CORRECTED_QC'
+      cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
+      cl_fld_var_s               = 'PSAL_CORRECTED'
+      cl_fld_var_depth_qc        = 'DEPH_CORRECTED_QC'
+      cl_fld_var_juld_qc         = 'JULD_QC'
+      cl_fld_var_pos_qc          = 'POSITION_QC'
+      cl_fld_var_ti              = 'TEMP'
+      cl_fld_qc_flags_profiles   = 'QC_FLAGS_PROFILES'
+      cl_fld_qc_flags_levels     = 'QC_FLAGS_LEVELS'
+
+      icount1(1) = 1 
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_data_type,      &
+         &         i_data_type_id ),      cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_data_type_id,        &
+         &         cl_data_type ),        cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_format_version, &
+         &         i_format_version_id ), cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_format_version_id,   &
+         &         cl_format_version ),   cl_name, __LINE__ )
+      
+      CALL str_c_to_for( cl_data_type )
+      CALL str_c_to_for( cl_format_version )
+      
+      IF(ldwp)WRITE(kunit,*)
+      IF(ldwp)WRITE(kunit,*) ' read_enactfile :' 
+      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
+      IF(ldwp)WRITE(kunit,*) '               Data type           = ', &
+         &                TRIM( ADJUSTL( cl_data_type ) )
+      IF(ldwp)WRITE(kunit,*) '               Format version      = ',  &
+         &                TRIM( ADJUSTL( cl_format_version ) )
+      
+      IF ( ( ( INDEX( cl_data_type,"ENACT v1.0" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENACT v1.4" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENACT v1.5" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENSEMBLES EN3 v1" ) == 1 )      ) &
+         &   .AND.                                              &
+         &   ( INDEX( cl_format_version,"2.0"   ) == 1 ) ) THEN
+         IF(ldwp)WRITE(kunit,*)'               Valid input file'
+      ELSE
+         CALL fatal_error( 'Invalid input file', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the number of observations and levels to allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_PROF', i_obs_id ),         &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ),     &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_LEVELS', i_lev_id ),     &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
+         &         cl_name, __LINE__ )
+      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+      IF (ilev > imaxlev) THEN
+         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
+      inpfile%cname(1) = 'POTM'
+      inpfile%cname(2) = 'PSAL'
+      inpfile%coblong(1) = 'Potential temperature'
+      inpfile%coblong(2) = 'Practical salinity'
+      inpfile%cobunit(1) = 'Degrees Celsius'
+      inpfile%cobunit(2) = 'PSU'
+      inpfile%cextname(1) = 'TEMP'
+      inpfile%cextlong(1) = 'Insitu temperature'
+      inpfile%cextunit(1) = 'Degrees Celsius'
+
+      !---------------------------------------------------------------------
+      ! Read the QC atributes
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                         &
+         &         cl_name, __LINE__ )        
+      istart2(1) = 1
+      icount2(2) = 1
+      icount2(1) = ilev
+      DO ji = 1, iobs 
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ),                         &
+         &         cl_name, __LINE__ )
+      DO ji = 1, iobs
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      ! No depth QC in files
+      DO ji = 1, iobs
+         DO jk = 1, ilev
+            inpfile%idqc(jk,ji)  = 1
+            inpfile%idqcf(:,jk,ji) = 0
+         END DO
+      END DO
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
+         &         cl_name,  __LINE__ )
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                    & 
+         &         cl_name, __LINE__ ) 
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+!!      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_juld_qc, i_qc_var_id ),                       &
+!!         &         cl_name, __LINE__ ) 
+!!      !DO ji = 1,iobs
+!!         istart1(1) = ji
+!!         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+!!            &                         start = istart1, count = icount1),                              &
+!!            &         cl_name, __LINE__ )
+!!         inpfile%itqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
+!!         inpfile%itqcf(:,ji) = 0
+!!      END DO
+      ! Since the flags are not set in the ENACT files we reset them to 0
+      inpfile%itqc(:)    = 1      
+      inpfile%itqcf(:,:) = 0
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
+         &         cl_name, __LINE__ ) 
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ipqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
+         inpfile%ipqcf(:,ji) = 0
+      END DO
+      DO ji = 1,iobs
+         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
+      END DO
+      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_profiles, i_qc_flag_id ) == nf90_noerr ) THEN
+         ALLOCATE( &
+            & iqc1(iobs) &
+            & )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc1 ),                                &
+            &         cl_name, __LINE__ )
+         DO ji = 1,iobs
+            inpfile%ioqcf(1,ji)   = iqc1(ji)
+            inpfile%ivqcf(1,ji,:) = iqc1(ji)
+            inpfile%ioqcf(2,ji)   = 0
+            inpfile%ivqcf(2,ji,:) = 0
+         END DO
+         DEALLOCATE( &
+            & iqc1 &
+            & )
+      ELSE
+         IF(ldwp) WRITE(kunit,*)'No QC profile flags in file'
+         inpfile%ioqcf(:,:)   = 0
+         inpfile%ivqcf(:,:,:) = 0
+      ENDIF
+      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_levels, i_qc_flag_id ) == nf90_noerr ) THEN
+         ALLOCATE( &
+            & iqc2(ilev,iobs) &
+            & )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc2 ),                                &
+            &         cl_name, __LINE__ )
+         DO ji = 1,iobs
+            DO jk = 1,ilev
+               inpfile%ivlqcf(1,jk,ji,:) = iqc2(jk,ji)
+               inpfile%ivlqcf(2,jk,ji,:) = 0
+            END DO
+         END DO
+         DEALLOCATE( &
+            & iqc2 &
+            & )
+      ELSE
+         IF(ldwp) WRITE(kunit,*)'No QC level flags in file'
+         inpfile%ivlqcf(:,:,:,:) = 0
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ),                             &
+            &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                             &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_reference_date_time, i_reference_date_time_id ), &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_reference_date_time_id, inpfile%cdjuldref ),          &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the platform information
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
+         &         cl_name, __LINE__ )          
+      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
+         &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
+         &         cl_name, __LINE__ )         
+
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_tp, i_var_id ),                              &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,1) ),                         &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                         &
+         &         cl_name, __LINE__ )
+ 
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_ti, i_var_id ),                              &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         inpfile%kindex(ji) = ji
+      END DO
+
+   END SUBROUTINE read_enactfile
+
+   SUBROUTINE read_coriofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_coriofile **
+      !!
+      !! ** Purpose : Read from file the profile CORIO observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output enactfile structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      INTEGER  :: &
+         & iobs, &
+         & ilev
+      !! * Local declarations
+      INTEGER :: &
+         & i_file_id,                &
+         & i_obs_id,                 &
+         & i_lev_id,                 &
+         & i_phi_id,                 & 
+         & i_lam_id,                 &
+         & i_depth_id,               &
+         & i_pres_id,                &
+         & i_var_id,                 &
+         & i_pl_num_id,              &
+         & i_format_version_id,      &
+         & i_juld_id,                &
+         & i_data_type_id,           &
+         & i_wmo_inst_type_id,       &
+         & i_qc_var_id,              &
+         & i_dc_ref_id
+      CHARACTER(LEN=40) :: & 
+         & cl_fld_lam,                 &
+         & cl_fld_phi,                 &
+         & cl_fld_depth,               & 
+         & cl_fld_depth_qc,            & 
+         & cl_fld_pres,                & 
+         & cl_fld_pres_qc,             & 
+         & cl_fld_var_t,               &
+         & cl_fld_var_s,               &
+         & cl_fld_var_ti,              &
+         & cl_fld_var_pos_qc,          &
+         & cl_fld_var_qc_t,            &
+         & cl_fld_var_qc_s,            &
+         & cl_fld_var_prof_qc_t,       &
+         & cl_fld_var_prof_qc_s,       &
+         & cl_fld_dc_ref,              &
+         & cl_fld_juld,                &
+         & cl_fld_pl_num,              &
+         & cl_fld_wmo_inst_type
+      CHARACTER(LEN=14), PARAMETER :: &
+         & cl_name = 'read_coriofile'
+      CHARACTER(LEN=4 )            :: &
+         & cl_format_version = ''
+      INTEGER, DIMENSION(1) :: &
+         & istart1, icount1
+      INTEGER, DIMENSION(2) :: &
+         & istart2, icount2
+      CHARACTER(len=imaxlev) :: &
+         & clqc
+      CHARACTER(len=1) :: &
+         & cqc
+      CHARACTER(len=256) :: &
+         & cdjulref
+      INTEGER :: &
+         & ji, jk
+      INTEGER :: &
+         & iformat
+      LOGICAL :: & 
+         & lsal
+      REAL(fbdp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zpres
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
+         & ipresqc
+      CHARACTER(len=256) :: &
+         & cerr
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      icount1(1) = 1 
+      lsal = .TRUE.
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Check format and set variables accordingly
+      !-----------------------------------------------------------------------
+
+      IF ( ( nf90_inq_dimid( i_file_id, 'N_PROF', i_obs_id ) == nf90_noerr ) .AND. &
+         & ( nf90_inq_dimid( i_file_id, 'N_LEVELS', i_lev_id ) == nf90_noerr ) ) THEN
+         iformat = 1
+      ELSEIF ( ( nf90_inq_dimid( i_file_id, 'mN_PROF', i_obs_id ) == nf90_noerr ) .AND. &
+         & ( nf90_inq_dimid( i_file_id, 'mN_ZLEV', i_lev_id ) == nf90_noerr ) ) THEN
+         iformat = 2
+      ELSE
+         WRITE(cerr,'(2A)')'Invalid data format in ',cl_name
+         CALL fatal_error( cerr, __LINE__ )
+      ENDIF
+      IF ( iformat == 1 ) THEN
+         cl_fld_lam                 = 'LONGITUDE'
+         cl_fld_phi                 = 'LATITUDE'  
+         cl_fld_depth               = 'DEPH'
+         cl_fld_depth_qc            = 'DEPH_QC'
+         cl_fld_pres                = 'PRES'
+         cl_fld_pres_qc             = 'PRES_QC'
+         cl_fld_juld                = 'JULD'
+         cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
+         cl_fld_dc_ref              = 'DC_REFERENCE'
+         cl_fld_pl_num              = 'PLATFORM_NUMBER'
+         cl_fld_var_qc_t            = 'TEMP_QC'
+         cl_fld_var_prof_qc_t       = 'PROFILE_TEMP_QC'
+         cl_fld_var_t               = 'TEMP'
+         cl_fld_var_qc_s            = 'PSAL_QC'
+         cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
+         cl_fld_var_s               = 'PSAL'
+         cl_fld_var_pos_qc          = 'POSITION_QC'
+      ELSEIF ( iformat==2 ) THEN
+         cl_fld_lam                 = 'LONGITUDE'
+         cl_fld_phi                 = 'LATITUDE'  
+         cl_fld_depth               = 'DEPH'
+         cl_fld_depth_qc            = 'QC_DEPH'
+         cl_fld_pres                = 'PRES'
+         cl_fld_pres_qc             = 'QC_PRES'
+         cl_fld_juld                = 'JULD'
+         cl_fld_wmo_inst_type       = 'INST_TYPE'
+         cl_fld_dc_ref              = 'REFERENCE'
+         cl_fld_pl_num              = 'PLATFORM_NUMBER'
+         cl_fld_var_qc_t            = 'QC_TEMP'
+         cl_fld_var_prof_qc_t       = 'Q_PROFILE_TEMP'
+         cl_fld_var_t               = 'TEMP'
+         cl_fld_var_qc_s            = 'QC_PSAL'
+         cl_fld_var_prof_qc_s       = 'Q_PROFILE_PSAL'
+         cl_fld_var_s               = 'PSAL'
+         cl_fld_var_pos_qc          = 'Q_POSITION'
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+
+      IF(ldwp)WRITE(kunit,*)
+      IF(ldwp)WRITE(kunit,*) ' read_coriofile :' 
+      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
+      IF(ldwp)WRITE(kunit,*) '               Format version      = ', iformat
+
+      !---------------------------------------------------------------------
+      ! Read the number of observations and levels to allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ), &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
+         &         cl_name, __LINE__ )
+      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+      IF (ilev > imaxlev) THEN
+         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
+      inpfile%cname(1) = 'POTM'
+      inpfile%cname(2) = 'PSAL'
+      inpfile%coblong(1) = 'Potential temperature'
+      inpfile%coblong(2) = 'Practical salinity'
+      inpfile%cobunit(1) = 'Degrees Celsius'
+      inpfile%cobunit(2) = 'PSU'
+      inpfile%cextname(1) = 'TEMP'
+      inpfile%cextlong(1) = 'Insitu temperature'
+      inpfile%cextunit(1) = 'Degrees Celsius'
+      ALLOCATE( &
+         & zpres(ilev,iobs),  &
+         & ipresqc(ilev,iobs) &
+         & )
+      !---------------------------------------------------------------------
+      ! Get julian data reference (iformat==2)
+      !---------------------------------------------------------------------
+
+      IF (iformat==2) THEN
+         CALL chkerr ( nf90_get_att( i_file_id, nf90_global, &
+            &                        "Reference_date_time", cdjulref ), &
+            &         cl_name, __LINE__ )
+         inpfile%cdjuldref = cdjulref(7:10)//cdjulref(4:5)// &
+            & cdjulref(1:2)//cdjulref(12:13)//cdjulref(15:16)//cdjulref(18:19)
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the QC attributes
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                                &
+         &         cl_name, __LINE__ )
+      istart2(1) = 1
+      icount2(2) = 1
+      icount2(1) = ilev
+      DO ji = 1, iobs 
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ) == nf90_noerr ) THEN
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         inpfile%ivlqc(:,:,2) = 4
+         inpfile%pob(:,:,2) = fbrmdi
+         lsal = .FALSE.
+      ENDIF
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
+         &         cl_name,  __LINE__ )
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      IF (lsal) THEN
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                 & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1,iobs
+            istart1(1) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                 &
+               &                         start = istart1, count = icount1),                           &
+               &         cl_name, __LINE__ )
+            inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
+         END DO
+      ELSE
+         inpfile%ivqc(:,2) = 4
+      ENDIF
+      DO ji = 1,iobs
+         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
+         &         cl_name, __LINE__ ) 
+      DO ji = 1, iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ipqc(ji)  = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
+         &         cl_name, __LINE__ )
+      IF (iformat==1) THEN
+         CALL chkerr ( nf90_get_att( i_file_id, i_juld_id, &
+            &                        "units", cdjulref ), &
+            &         cl_name, __LINE__ )
+         inpfile%cdjuldref = cdjulref(12:15)//cdjulref(17:18)// &
+            & cdjulref(20:21)//cdjulref(23:24)//cdjulref(26:27)//&
+            & cdjulref(29:30)
+      ENDIF
+      
+      IF ( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ) == nf90_noerr ) THEN
+         CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                          &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth_qc, i_qc_var_id ),                      & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               inpfile%idqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         inpfile%pdep(:,:) = fbrmdi
+         inpfile%idqc(:,:) = 4
+      ENDIF
+
+      IF ( nf90_inq_varid( i_file_id, cl_fld_pres, i_pres_id ) == nf90_noerr ) THEN
+         CALL chkerr( nf90_get_var  ( i_file_id, i_pres_id, zpres ),                                  &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pres_qc, i_qc_var_id ),                       & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               ipresqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         zpres(:,:) = fbrmdi
+         ipresqc(:,:) = 4
+      ENDIF
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the platform information
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
+         &         cl_name, __LINE__ )          
+      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
+         &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
+         &         cl_name, __LINE__ )         
+
+      
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_t, i_var_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
+         &         cl_name, __LINE__ )
+
+      IF (lsal) THEN      
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                            &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                      &
+            &         cl_name, __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+         
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         inpfile%kindex(ji) = ji
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Coriolis data conversion from insitu to potential temperature
+      !---------------------------------------------------------------------
+      !---------------------------------------------------------------------
+      !  Convert pressure to depth if depth not present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
+            DO jk = 1, inpfile%nlev
+               IF ( inpfile%pdep(jk,ji) >= 9999.0 ) THEN
+                  IF ( zpres(jk,ji) < 9999.0 ) THEN
+                     inpfile%pdep(jk,ji) = &
+                        & p_to_dep( REAL(zpres(jk,ji),wp), REAL(inpfile%pphi(ji),wp) )
+                     inpfile%idqc(jk,ji) = ipresqc(jk,ji)
+                  ENDIF
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Convert depth to pressure if pressure not present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
+            DO jk = 1, inpfile%nlev
+               IF ( zpres(jk,ji) >= 9999.0 ) THEN
+                  IF ( inpfile%pdep(jk,ji) < 9999.0 ) THEN
+                     zpres(jk,ji) = dep_to_p( REAL(inpfile%pdep(jk,ji),wp), &
+                        &                            REAL(inpfile%pphi(ji),wp) )
+                     ipresqc(jk,ji) = inpfile%idqc(jk,ji)
+                  ENDIF
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Convert insitu temperature to potential temperature if
+      !  salinity, insitu temperature and pressure are present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         DO jk = 1, inpfile%nlev
+            IF (( inpfile%pob(jk,ji,2) < 9999.0 ) .AND. &
+               &( inpfile%pext(jk,ji,1) < 9999.0 ) .AND. &
+               &( zpres(jk,ji) < 9999.0 ) ) THEN
+               inpfile%pob(jk,ji,1) = potemp( REAL(inpfile%pob(jk,ji,2), wp),  &
+                  &                           REAL(inpfile%pext(jk,ji,1), wp), &
+                  &                           REAL(zpres(jk,ji),wp),  &
+                  &                           0.0_wp )
+            ELSE
+               inpfile%pob(jk,ji,1) = fbrmdi
+            ENDIF
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      !  Initialize flags since they are not in the CORIOLIS input files
+      !---------------------------------------------------------------------
+
+      inpfile%ioqcf(:,:)      = 0
+      inpfile%ipqcf(:,:)      = 0
+      inpfile%itqcf(:,:)      = 0
+      inpfile%idqcf(:,:,:)    = 0
+      inpfile%ivqcf(:,:,:)    = 0
+      inpfile%ivlqcf(:,:,:,:) = 0
+
+   END SUBROUTINE read_coriofile
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obsseaice_io.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obsseaice_io.h90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obsseaice_io.h90	(revision 6808)
@@ -0,0 +1,270 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obsseaice_io.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_seaice( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_seaice **
+      !!
+      !! ** Purpose : Read from file the SEAICE observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_seaice'
+      INTEGER :: i_file_id    ! netcdf IDS
+      INTEGER :: i_time_id
+      INTEGER :: i_ni_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER :: i_data       ! Number of data per parameter in current file
+      INTEGER :: i_time       ! Number of reference times in file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & i_dtime, &       ! Offset in seconds since reference time
+         & i_qc,    &       ! Quality control flag.
+         & i_type           ! Type of seaice measurement.            
+      REAL(wp), DIMENSION(:), POINTER :: &
+         & z_phi,   &       ! Latitudes
+         & z_lam            ! Longitudes
+      REAL(wp), DIMENSION(:,:), POINTER :: &
+         & z_seaice         ! Seaice data     
+      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
+      INTEGER :: iilen          ! Length of netCDF attributes
+      INTEGER :: itype          ! Typeof netCDF attributes
+      REAL(KIND=wp) :: zsca      ! Scale factor
+      REAL(KIND=wp) :: zoff      ! Offset for data in netcdf file
+      REAL(KIND=wp) :: z_offset  ! Offset for time conversion
+      REAL(KIND=wp) :: zfill     ! Fill value in netcdf file
+      CHARACTER (len=33) ::creftime     ! Reference time of file
+      INTEGER :: i_refyear       ! Integer version of reference time
+      INTEGER :: i_refmonth
+      INTEGER :: i_refday
+      INTEGER :: i_refhour
+      INTEGER :: i_refmin
+      INTEGER :: i_refsec
+      INTEGER :: ichunk
+      INTEGER :: jtim
+      INTEGER :: jobs
+      INTEGER :: iobs
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
+      
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
+         &                              len = i_time ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
+         &                              len = i_data ),  &
+         &      cpname, __LINE__ )
+      
+      
+      ! Allocate NetCDF variables
+      
+      ALLOCATE( &
+         & i_reftime    ( i_time                 ), &
+         & i_dtime      ( i_data,i_time  ), &      
+         & i_qc         ( i_data,i_time  ), & 
+         & i_type       ( i_data,i_time  ), &     
+         & z_phi        ( i_data                 ), &   
+         & z_lam        ( i_data                 ), &  
+         & z_seaice        ( i_data,i_time  )  &
+         & )
+      
+      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_time
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
+         &       cpname, __LINE__ )
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "units",creftime), cpname,  __LINE__ )
+      ELSE
+         creftime = "seconds since 1981-01-01 00:00:00"
+      ENDIF
+      READ(creftime(15:18),*)i_refyear
+      READ(creftime(20:21),*)i_refmonth
+      READ(creftime(23:24),*)i_refday
+      READ(creftime(26:27),*)i_refhour
+      READ(creftime(29:30),*)i_refmin
+      READ(creftime(32:33),*)i_refsec
+      !Work out offset in days between reference time and 1/1/1950.
+      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
+         &           i_refmonth, i_refyear, z_offset)
+      
+      ! Get list of times for each ob in seconds relative to reference time
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'SeaIce_dtime', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
+         &       cpname, __LINE__ )
+      zsca = 1.0      
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname,  __LINE__ )
+      ENDIF
+      zoff = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "add_offset",zoff), cpname,  __LINE__ )
+      ENDIF
+      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
+         &                 + zoff)
+      
+      ! Get longitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
+         &         cpname, __LINE__ )
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
+         &         cpname, __LINE__ )
+      
+      ! Get seaice data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_ice_concentration', &
+         &                         i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_seaice), &
+         &       cpname, __LINE__ )
+      zoff = 0.
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "_FillValue",zfill), cpname, __LINE__ )
+      ENDIF
+      WHERE(z_seaice(:,:) /=  zfill)
+         z_seaice(:,:) = (zsca * z_seaice(:,:)) + zoff
+      ELSEWHERE
+         z_seaice(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get QC flag
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
+            &       cpname, __LINE__ )
+      
+      ! Get seaice obs type
+      
+      i_type(:,:)=1
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Fill the obfbdata structure
+
+      ! Allocate obfbdata
+      
+      iobs = i_data * i_time
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SEAICE'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = "19500101000000"
+      iobs = 0
+      DO jtim = 1, i_time
+         DO jobs = 1, i_data
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'seaice','  '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
+            ! Real values
+            inpfile%plam(iobs)         = z_lam(jobs)
+            inpfile%pphi(iobs)         = z_phi(jobs)
+            inpfile%pob(1,iobs,1)      = z_seaice(jobs,jtim)
+            inpfile%ptim(iobs)         = &
+               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
+               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            IF ( z_seaice(jobs,jtim) == fbrmdi ) THEN
+               inpfile%ioqc(iobs)      = 4
+               inpfile%ivqc(iobs,1)    = 4 
+               inpfile%ivlqc(1,iobs,1) = 4
+            ELSE 
+               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
+               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
+               inpfile%ivlqc(1,iobs,1) = 1
+            ENDIF
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+   END SUBROUTINE read_seaice
+
+
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_io.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_io.h90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_io.h90	(revision 6808)
@@ -1,1 +1,378 @@
-link ../../../NEMO/OPA_SRC/OBS/obssla_io.h90
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obssla_io.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_avisofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_avisofile **
+      !!
+      !! ** Purpose : Read from file the AVISO SLA observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : http://www.aviso.oceanobs.com
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=14),PARAMETER :: cpname = 'read_avisofile'
+      INTEGER :: i_file_id     ! netcdf IDS
+      INTEGER :: i_tracks_id
+      INTEGER :: i_cycles_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
+      INTEGER :: iilen         ! Length of netCDF attributes
+      INTEGER :: itype         ! Typeof netCDF attributes
+      REAL(fbdp) :: zsca       ! Scale factor
+      REAL(fbdp) :: zfill      ! Fill value
+      CHARACTER(len=3) ::  cmission      ! Mission global attribute
+      INTEGER :: itracks       ! Maximum number of passes in file
+      INTEGER :: icycles       ! Maximum number of cycles for each pass
+      INTEGER :: idata         ! Number of data per parameter in current file
+      REAL(fbdp) :: zdeltat    ! Time gap getween two measurements in seconds
+      INTEGER, DIMENSION(:), POINTER :: & 
+         & iptracks,     &  ! List of passes contained in current file
+         & ipnbpoints,   &  ! Number of points per pass
+         & ipdataindexes    ! Index of data in theoretical profile
+      INTEGER, DIMENSION(:,:), POINTER :: & 
+         & ipcycles         ! List of cycles per pass
+      REAL(fbdp), DIMENSION(:), POINTER :: &
+         & zphi,   &        ! Latitudes
+         & zlam             ! Longitudes
+      REAL(fbdp), DIMENSION(:,:), POINTER :: &
+         & zbegindates      ! Date of point with index 0
+      REAL(fbdp) :: zbeginmiss    ! Missing data for dates
+      REAL(fbsp), DIMENSION(:,:), POINTER :: &
+         & zsla             ! SLA data
+      REAL(fbdp), DIMENSION(:), POINTER :: &
+         & zjuld            ! Julian date
+      LOGICAL, DIMENSION(:), POINTER :: &
+         & llskip           ! Skip observation
+      CHARACTER(len=14) :: cdjuldref    ! Julian data reference
+      INTEGER :: imission   ! Mission number converted from Mission global 
+                            ! netCDF atttribute.
+      CHARACTER(len=255) :: ctmp
+      INTEGER :: iobs
+      INTEGER :: jl
+      INTEGER :: jm
+      INTEGER :: jj
+      INTEGER :: ji
+      INTEGER :: jk
+      INTEGER :: jobs
+      INTEGER :: jcycle
+
+      ! Open the file
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, i_file_id ), &
+         &         cpname, __LINE__ )
+
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Tracks', i_tracks_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_tracks_id, &
+         &                                 len = itracks ),  &
+         &         cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Cycles', i_cycles_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_cycles_id, &
+         &                                 len = icycles ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Data', i_data_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_data_id, &
+         &                                 len = idata ),  &
+         &         cpname, __LINE__ )
+
+      ! Allocate memory for input data
+
+      ALLOCATE( &
+         & iptracks     ( itracks          ), &  
+         & ipnbpoints   ( itracks          ), &  
+         & ipcycles     ( icycles, itracks ), &
+         & zphi         ( idata            ), &   
+         & zlam         ( idata            ), &  
+         & zbegindates  ( icycles, itracks ), &
+         & ipdataindexes( idata            ), & 
+         & zsla         ( icycles, idata   ), &
+         & zjuld        ( idata*icycles    ), &
+         & llskip       ( idata*icycles    )  &
+         & )
+
+      ! Get time gap getween two measurements in seconds
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'DeltaT', i_var_id ), & 
+         &         cpname, __LINE__ )
+      CALL chkdim( i_file_id, i_var_id, 0, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zdeltat), &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zdeltat = zsca * zdeltat
+         
+      ! Get List of passes contained in current file      
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Tracks', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = itracks
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, iptracks), &
+         &         cpname, __LINE__ )
+      
+      ! Get Number of points per pass
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'NbPoints', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = itracks
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipnbpoints),&
+         &         cpname, __LINE__ )
+      
+      ! Get list of cycles per pass
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Cycles', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = itracks
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipcycles),   &
+         &         cpname, __LINE__ )
+
+      ! Get longitudes
+
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Longitudes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zlam),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                         == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zlam(:) = zsca * zlam(:)
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Latitudes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zphi),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zphi(:) = zsca * zphi(:)
+      
+      ! Get date of point with index 0
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'BeginDates', i_var_id ), & 
+         &        cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = itracks
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zbegindates), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, &
+         &                                 'units', len = iilen,  &
+         &                                  xtype = itype), cpname, __LINE__ )
+      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 255 )) THEN
+         CALL fatal_error('Error decoding BeginDates unit', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, i_var_id, 'units', &
+         &                       ctmp ), cpname, __LINE__ )
+      jl=1
+      DO jm = 1, LEN(TRIM(ctmp))
+         IF ((ctmp(jm:jm)>='0').AND.(ctmp(jm:jm)<='9')) THEN
+            cdjuldref(jl:jl) = ctmp(jm:jm)
+            jl=jl+1
+         ENDIF
+         IF (jl>14) EXIT
+      END DO
+      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue', &
+         &                                  xtype = itype), cpname, __LINE__ )
+      IF ( itype /= NF90_DOUBLE ) THEN
+         CALL fatal_error('Error decoding BeginDates missing data', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, i_var_id, '_FillValue', &
+         &                       zbeginmiss ), cpname, __LINE__ )
+
+      ! Get indices of data in theoretical profile
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'DataIndexes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipdataindexes),   &
+         &       cpname, __LINE__ )
+      
+      ! Get SLA data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'SLA', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = idata
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zsla),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                        == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       'scale_factor',zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue') &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     '_FillValue',zfill), cpname,  __LINE__ )
+      ENDIF
+      WHERE(zsla(:,:) /=  zfill)
+         zsla(:,:) = zsca * zsla(:,:)
+      ELSEWHERE
+         zsla(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get the global Mission netCDF attribute
+      
+      cmission='   '
+      CALL chkerr( nf90_inquire_attribute( i_file_id, nf90_global, &
+         &                                 'Mission', len = iilen,  &
+         &                                 xtype = itype), cpname, __LINE__ )
+      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 3 )) THEN
+         CALL fatal_error('Error decoding Mission global attribute', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, nf90_global, 'Mission', &
+         &                       cmission ), cpname, __LINE__ )
+      
+      ! Convert it to an integer
+      imission = 0
+      DO jm = 1, imaxmissions
+         IF (cmission==cmissions(jm)) THEN
+            imission = jm
+            EXIT
+         ENDIF
+      END DO
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Compute Julian dates for all observations
+      
+      jm = 0
+      jl = 0
+      DO jj = 1, itracks
+         DO ji = 1, ipnbpoints(jj)
+            jl = jl + 1
+            DO jk = 1, icycles
+               jm = jm + 1
+               IF (zbegindates(jk,jj)==zbeginmiss) THEN
+                  llskip(jm) = .TRUE.
+                  zjuld(jm)  = fbrmdi
+               ELSE
+                  llskip(jm) = .FALSE.
+                  zjuld(jm)  = zbegindates(jk,jj) + &
+                     &         (ipdataindexes(jl) * zdeltat / 86400._wp )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Get rid of missing data
+
+      jm = 0
+      DO jobs = 1, idata
+         DO jcycle = 1, icycles
+            jm = jm + 1
+            IF (zsla(jcycle,jobs) == fbrmdi) llskip(jm) = .TRUE.
+         END DO
+      END DO
+      
+      ! Allocate obfbdata
+
+      iobs = COUNT( .NOT.llskip(:) )
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SLA'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = cdjuldref
+      iobs = 0
+      jm = 0
+      DO jobs = 1, idata
+         DO jcycle = 1, icycles
+            jm = jm + 1
+            IF (llskip(jm)) CYCLE
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A3,A5)') cmissions(imission), '     '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') imission
+            ! Real values
+            inpfile%plam(iobs)         = zlam(jobs)
+            inpfile%pphi(iobs)         = zphi(jobs)
+            inpfile%pob(1,iobs,1)      = zsla(jcycle,jobs)
+            inpfile%ptim(iobs)         = zjuld(jm)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            inpfile%ioqc(iobs)      = 1
+            inpfile%ivqc(iobs,1)    = 1
+            inpfile%ivlqc(1,iobs,1) = 1
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+
+      ! Deallocate memory for input data
+
+      DEALLOCATE( &
+         & iptracks,      &
+         & ipnbpoints,    &
+         & ipcycles,      &
+         & zphi,          &
+         & zlam,          &  
+         & zbegindates,   &
+         & ipdataindexes, &
+         & zsla,          &
+         & zjuld,         &
+         & llskip         &
+         & )
+
+   END SUBROUTINE read_avisofile
+
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_types.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_types.h90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_types.h90	(revision 6808)
@@ -1,1 +1,9 @@
-link ../../../NEMO/OPA_SRC/OBS/obssla_types.h90
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obssla_types.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   INTEGER, PARAMETER :: imaxmissions=8
+   CHARACTER(len=3) :: cmissions(0:imaxmissions) = &
+      & (/ 'XXX', 'E1 ', 'E2 ', 'TP ', 'TPM', 'G2 ', 'J1 ', 'EN ', 'J2 ' /)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obssst_io.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obssst_io.h90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obssst_io.h90	(revision 6808)
@@ -0,0 +1,286 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obssst_io.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_ghrsst( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_ghrsst **
+      !!
+      !! ** Purpose : Read from file the GHRSST observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_ghrsst'
+      INTEGER :: i_file_id        ! netcdf IDS
+      INTEGER :: i_time_id
+      INTEGER :: i_ni_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER :: i_data           ! Number of data per parameter in current file
+      INTEGER :: i_time           ! Number of reference times in file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & i_dtime, &       ! Offset in seconds since reference time
+         & i_qc,    &       ! Quality control flag.
+         & i_type           ! Type of SST measurement.            
+      REAL(wp), DIMENSION(:), POINTER :: &
+         & z_phi,   &       ! Latitudes
+         & z_lam            ! Longitudes
+      REAL(wp), DIMENSION(:,:), POINTER :: &
+         & z_sst            ! SST data     
+      INTEGER, PARAMETER :: imaxdim = 2      ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims         ! Dimensions in file
+      INTEGER :: iilen            ! Length of netCDF attributes
+      INTEGER :: itype            ! Typeof netCDF attributes
+      REAL(KIND=wp) :: zsca           ! Scale factor
+      REAL(KIND=wp) :: zoff           ! Offset for data in netcdf file
+      REAL(KIND=wp) :: z_offset       ! Offset for time conversion
+      REAL(KIND=wp) :: zfill          ! Fill value in netcdf file
+      CHARACTER (len=33) :: creftime  ! Reference time of file
+      INTEGER :: i_refyear            ! Integer version of reference time
+      INTEGER :: i_refmonth
+      INTEGER :: i_refday
+      INTEGER :: i_refhour
+      INTEGER :: i_refmin
+      INTEGER :: i_refsec
+      INTEGER :: ichunk
+      INTEGER :: jtim
+      INTEGER :: jobs
+      INTEGER :: iobs
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
+      
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
+         &                              len = i_time ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
+         &                              len = i_data ),  &
+         &      cpname, __LINE__ )
+      
+      
+      ! Allocate NetCDF variables
+      
+      ALLOCATE( &
+         & i_reftime    ( i_time                 ), &
+         & i_dtime      ( i_data,i_time  ), &      
+         & i_qc         ( i_data,i_time  ), & 
+         & i_type       ( i_data,i_time  ), &     
+         & z_phi        ( i_data                 ), &   
+         & z_lam        ( i_data                 ), &  
+         & z_sst        ( i_data,i_time  )  &
+         & )
+      
+      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_time
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
+         &       cpname, __LINE__ )
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "units",creftime), cpname,  __LINE__ )
+      ELSE
+         creftime = "seconds since 1981-01-01 00:00:00"
+      ENDIF
+      READ(creftime(15:18),*)i_refyear
+      READ(creftime(20:21),*)i_refmonth
+      READ(creftime(23:24),*)i_refday
+      READ(creftime(26:27),*)i_refhour
+      READ(creftime(29:30),*)i_refmin
+      READ(creftime(32:33),*)i_refsec
+      !Work out offset in days between reference time and 1/1/1950.
+      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
+         &           i_refmonth, i_refyear, z_offset)
+      
+      ! Get list of times for each ob in seconds relative to reference time
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sst_dtime', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
+         &       cpname, __LINE__ )
+      zsca = 1.0      
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname,  __LINE__ )
+      ENDIF
+      zoff = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "add_offset",zoff), cpname,  __LINE__ )
+      ENDIF
+      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
+         &                 + zoff)
+      
+      ! Get longitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
+         &         cpname, __LINE__ )
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
+         &         cpname, __LINE__ )
+      
+      ! Get SST data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_surface_temperature', &
+         &                         i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_sst), &
+         &       cpname, __LINE__ )
+      zoff = 0.
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "_FillValue",zfill), cpname, __LINE__ )
+      ENDIF
+      WHERE(z_sst(:,:) /=  zfill)
+         z_sst(:,:) = (zsca * z_sst(:,:)) + zoff
+      ELSEWHERE
+         z_sst(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get QC flag
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
+            &       cpname, __LINE__ )
+      
+      ! Get SST obs type
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'data_source', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_type),   &
+         &       cpname, __LINE__ )
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Fill the obfbdata structure
+
+      ! Allocate obfbdata
+      
+      iobs = i_data * i_time
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SST'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = "19500101000000"
+      iobs = 0
+      DO jtim = 1, i_time
+         DO jobs = 1, i_data
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'ghrsst','  '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
+            ! Real values
+            inpfile%plam(iobs)         = z_lam(jobs)
+            inpfile%pphi(iobs)         = z_phi(jobs)
+            inpfile%pob(1,iobs,1)      = z_sst(jobs,jtim)
+            inpfile%ptim(iobs)         = &
+               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
+               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            IF ( z_sst(jobs,jtim) == fbrmdi ) THEN
+               inpfile%ioqc(iobs)      = 4
+               inpfile%ivqc(iobs,1)    = 4 
+               inpfile%ivlqc(1,iobs,1) = 4
+            ELSE 
+               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
+               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
+               inpfile%ivlqc(1,iobs,1) = 1
+            ENDIF
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+      DEALLOCATE( &
+         & i_reftime, &
+         & i_dtime,   &
+         & i_qc,      &
+         & i_type,    &
+         & z_phi,     &
+         & z_lam,     &
+         & z_sst      &
+         & )
+
+   END SUBROUTINE read_ghrsst
+
+
Index: anches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obsvel_io.h90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/obsvel_io.h90	(revision 6807)
+++ 	(revision )
@@ -1,1 +1,0 @@
-link ../../../NEMO/OPA_SRC/OBS/obsvel_io.h90
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/par_oce.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/par_oce.F90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/OBSTOOLS/src/par_oce.F90	(revision 6808)
@@ -25,130 +25,45 @@
    INTEGER, PUBLIC, PARAMETER ::   jprecj = 1   !: number of rows    for overlap 
 
-   !! Ocean Domain sizes
-   !! ------------------
-   !!   data           domain   (jpidta,jpjdta)
-   !!   global or zoom domain   (jpiglo,jpjglo)
-   !!   local          domain   ( jpi  , jpj  )
-   
-!#if   defined key_orca_r4
-!   !!---------------------------------------------------------------------
-!   !!   'key_orca_r4'   :                           global ocean : ORCA R4
-!   !!---------------------------------------------------------------------
-!#             include "par_ORCA_R4.h90"
-!#elif defined key_orca_r2
-!   !!---------------------------------------------------------------------
-!   !!   'key_orca_r2'   :                           global ocean : ORCA R4
-!   !!---------------------------------------------------------------------
-!#             include "par_ORCA_R2.h90"
-!#elif defined key_orca_r1
-!   !!---------------------------------------------------------------------
-!   !!   'key_orca_r1'   :                           global ocean : ORCA R1
-!   !!---------------------------------------------------------------------
-!#             include "par_ORCA_R1.h90"
-!#elif defined key_orca_r05
-!   !!---------------------------------------------------------------------
-!   !!   'key_orca_r05'  :                          global ocean : ORCA R05
-!   !!---------------------------------------------------------------------
-!#             include "par_ORCA_R05.h90"
-!#elif defined key_orca_r025
-!   !!---------------------------------------------------------------------
-!   !!   'key_orca_r025' :                         global ocean : ORCA R025
-!   !!---------------------------------------------------------------------
-!#             include "par_ORCA_R025.h90"
-!#elif defined key_eel_r2
-!   !!---------------------------------------------------------------------
-!   !!   'key_eel_r2'    :                                 channel : EEL R2
-!   !!---------------------------------------------------------------------
-!#             include "par_EEL_R2.h90"
-!#elif defined key_eel_r5
-!   !!---------------------------------------------------------------------
-!   !!   'key_eel_r5'    :                                 channel : EEL R5
-!   !!---------------------------------------------------------------------
-!#             include "par_EEL_R5.h90"
-!#elif defined key_eel_r6
-!   !!---------------------------------------------------------------------
-!   !!   'key_eel_r6'    :                                 channel : EEL R6
-!   !!---------------------------------------------------------------------
-!#             include "par_EEL_R6.h90"
-!#elif defined key_gyre
-!   !!---------------------------------------------------------------------
-!   !!   'key_gyre'      :                        mid-latitude basin : GYRE
-!   !!---------------------------------------------------------------------
-!#             include "par_GYRE.h90"
-!#elif defined key_pomme_r025
-!   !!---------------------------------------------------------------------
-!   !!   'key_pomme_r025':                        regional basin : POMME025
-!   !!---------------------------------------------------------------------
-!#             include "par_POMME_R025.h90"
-!#else
-   !!---------------------------------------------------------------------
-   !!   default option  :                               small closed basin
-   !!---------------------------------------------------------------------
-   CHARACTER(len=16), PUBLIC, PARAMETER ::   cp_cfg = "default"   !: name of the configuration
-   INTEGER          , PUBLIC, PARAMETER ::   jp_cfg = 0           !: resolution of the configuration
+   !!----------------------------------------------------------------------
+   !!                   namcfg namelist parameters
+   !!----------------------------------------------------------------------
+   CHARACTER(lc) ::   cp_cfg           !: name of the configuration
+   CHARACTER(lc) ::   cp_cfz           !: name of the zoom of configuration
+   INTEGER       ::   jp_cfg           !: resolution of the configuration
 
    ! data size                                       !!! * size of all input files *
-   INTEGER, PUBLIC, PARAMETER ::   jpidta  = 10       !: 1st lateral dimension ( >= jpi )
-   INTEGER, PUBLIC, PARAMETER ::   jpjdta  = 12       !: 2nd    "         "    ( >= jpj )
-   INTEGER, PUBLIC, PARAMETER ::   jpkdta  = 31       !: number of levels      ( >= jpk )
+   INTEGER       ::   jpidta           !: 1st lateral dimension ( >= jpi )
+   INTEGER       ::   jpjdta           !: 2nd    "         "    ( >= jpj )
+   INTEGER       ::   jpkdta           !: number of levels      ( >= jpk )
 
    ! global or zoom domain size                      !!! * computational domain *
-   INTEGER, PUBLIC, PARAMETER ::   jpiglo  = jpidta   !: 1st dimension of global domain --> i
-   INTEGER, PUBLIC, PARAMETER ::   jpjglo  = jpjdta   !: 2nd    -                  -    --> j
-   INTEGER, PUBLIC            ::   jpk     = jpkdta   !: number of vertical levels
+   INTEGER       ::   jpiglo           !: 1st dimension of global domain --> i
+   INTEGER       ::   jpjglo           !: 2nd    -                  -    --> j
+
    ! zoom starting position 
-   INTEGER, PUBLIC, PARAMETER ::   jpizoom =   1      !: left bottom (i,j) indices of the zoom
-   INTEGER, PUBLIC, PARAMETER ::   jpjzoom =   1      !: in data domain indices
+   INTEGER       ::   jpizoom          !: left bottom (i,j) indices of the zoom
+   INTEGER       ::   jpjzoom          !: in data domain indices
 
    ! Domain characteristics
-   INTEGER, PUBLIC, PARAMETER ::   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
+   INTEGER       ::   jperio           !: 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
+
+   ! Input file read offset
+   LOGICAL       ::   ln_use_jattr     !: Use file global attribute: open_ocean_jstart to determine start j-row 
+                                           ! when reading input from those netcdf files that have the 
+                                           ! attribute defined. This is designed to enable input files associated 
+                                           ! with the extended grids used in the under ice shelf configurations to 
+                                           ! be used without redundant rows when the ice shelves are not in use.
 
    !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
    !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
-   REAL(wp), PUBLIC, PARAMETER ::   pp_not_used       = 999999._wp   !: vertical grid parameter
-   REAL(wp), PUBLIC, PARAMETER ::   pp_to_be_computed = 999999._wp   !:    -      -       -
+   REAL(wp)      ::   pp_not_used       = 999999._wp   !: vertical grid parameter
+   REAL(wp)      ::   pp_to_be_computed = 999999._wp   !:    -      -       -
 
 
-   !! Horizontal grid parameters for domhgr
-   !! =====================================
-   INTEGER, PUBLIC, PARAMETER  ::   jphgr_msh = 0   !: type of horizontal mesh
-   !                                                !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
-   !                                                !  = 1 geographical mesh on the sphere with regular grid-spacing
-   !                                                !  = 2 f-plane with regular grid-spacing
-   !                                                !  = 3 beta-plane with regular grid-spacing
-   !                                                !  = 4 Mercator grid with T/U point at the equator
-
-   REAL(wp) , PUBLIC, PARAMETER ::   ppglam0  =    0.0_wp   !: longitude of first raw and column T-point (jphgr_msh = 1)
-   REAL(wp) , PUBLIC, PARAMETER ::   ppgphi0  =  -35.0_wp   !: latitude  of first raw and column T-point (jphgr_msh = 1)
-   !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3)
-   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_deg =    1.0_wp   !: zonal      grid-spacing (degrees)
-   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_deg =    0.5_wp   !: meridional grid-spacing (degrees)
-   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_m   = 5000.0_wp   !: zonal      grid-spacing (degrees)
-   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_m   = 5000.0_wp   !: meridional grid-spacing (degrees)
-
-   !! Vertical grid parameter for domzgr
-   !! ==================================
-   REAL(wp), PUBLIC, PARAMETER ::   ppsur = -4762.96143546300_wp   !: ORCA r4, r2 and r05 coefficients
-   REAL(wp), PUBLIC, PARAMETER ::   ppa0  =   255.58049070440_wp   !: (default coefficients)
-   REAL(wp), PUBLIC, PARAMETER ::   ppa1  =   245.58132232490_wp   !:
-   REAL(wp), PUBLIC, PARAMETER ::   ppkth =    21.43336197938_wp   !:
-   REAL(wp), PUBLIC, PARAMETER ::   ppacr =     3.00000000000_wp   !:
-   !
-   !  If both ppa0 ppa1 and ppsur are specified to 0, then
-   !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
-   REAL(wp), PUBLIC, PARAMETER ::   ppdzmin = 10._wp     !: Minimum vertical spacing
-   REAL(wp), PUBLIC, PARAMETER ::   pphmax  = 5000._wp   !: Maximum depth
-   !
-   LOGICAL , PUBLIC, PARAMETER ::   ldbletanh = .TRUE.   !: Use/do not use double tanf function for vertical coordinates
-   REAL(wp), PUBLIC, PARAMETER ::   ppa2  =   100.760928500000_wp   !: Double tanh function parameters
-   REAL(wp), PUBLIC, PARAMETER ::   ppkth2=    48.029893720000_wp   !:
-   REAL(wp), PUBLIC, PARAMETER ::   ppacr2=    13.000000000000_wp   !:
-   !
-!#endif
 
 
@@ -171,5 +86,5 @@
    INTEGER, PUBLIC  ::   jpi   ! = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension
    INTEGER, PUBLIC  ::   jpj   ! = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension
-   INTEGER, PUBLIC  ::   jpk   ! = jpkdta                                             !: third dimension
+   INTEGER, PUBLIC  ::   jpk   ! = jpkdta
    INTEGER, PUBLIC  ::   jpim1 ! = jpi-1                                            !: inner domain indices
    INTEGER, PUBLIC  ::   jpjm1 ! = jpj-1                                            !:   -     -      -
@@ -177,22 +92,7 @@
    INTEGER, PUBLIC  ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj
 
-   !!---------------------------------------------------------------------
-   !! Optimization/control flags
-   !!---------------------------------------------------------------------
-#if defined key_esopa
-   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .TRUE.   !: flag to activate the all options
-#else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .FALSE.  !: flag to activate the all options
-#endif
-
-#if defined key_vectopt_loop
-   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .TRUE.   !: vector optimization flag
-#else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .FALSE.  !: vector optimization flag
-#endif
-
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: par_oce.F90 2715 2011-03-30 15:58:35Z rblod $ 
+   !! $Id: par_oce.F90 5974 2015-12-02 10:52:05Z timgraham $ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/REBUILD_NEMO/icb_combrest.py
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/REBUILD_NEMO/icb_combrest.py	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/REBUILD_NEMO/icb_combrest.py	(revision 6808)
@@ -0,0 +1,255 @@
+from netCDF4 import Dataset
+from argparse import ArgumentParser
+import numpy as np
+import sys
+
+#
+# Basic iceberg trajectory restart post-processing python script.
+# This script collects iceberg information from the distributed restarts written
+# out by each processing region and writes the information into a global restart file.
+# The global restart file must already exist and contain the collated 2D spatial fields
+# as prepared by utilities such as rebuild_nemo. This python script simply adds the
+# iceberg position and state data that is held using the unlimited dimension 'n' which
+# has been ignored by rebuild_nemo. Each processing region that contains icebergs will
+# (probably) have a different number of icebergs (indicated by differing values for the
+# current size of the unlimited dimension). This script collects all icebergs into a 
+# single unordered list.
+#
+
+parser = ArgumentParser(description='produce a global trajectory restart file from distributed output\
+                                     files, e.g. \n python ./icb_pp.py \
+                                     -f  icebergs_00692992_restart_ -n 480 -o icebergs_restart.nc [-O]')
+
+parser.add_argument('-f',dest='froot',help='fileroot_of_distrbuted_data; root name of \
+                     distributed trajectory restart file (usually completed with XXXX.nc, where \
+                     XXXX is the 4 digit processor number)', 
+                     default='icebergs_00692992_restart_')
+
+parser.add_argument('-n',dest='fnum',help='number of distributed files to process', 
+                     type=int, default=None)
+
+parser.add_argument('-o',dest='fout',help='global_iceberg_restart; file name to append the \
+                     global iceberg restart data to.', default='icebergs_restart.nc')
+
+parser.add_argument('-O',dest='fcre',help='Create the output file from scratch rather than \
+                     append to an existing file.', \
+                     action='store_true', default=False)
+
+args = parser.parse_args()
+
+default_used = 0
+if args.froot is None:
+    pathstart = 'icebergs_00692992_restart_'
+    default_used = 1
+else:
+    pathstart = args.froot
+
+if args.fnum is None:
+    procnum = 0
+    default_used = 1
+else:
+    procnum = args.fnum
+
+if args.fout is None:
+    pathout = 'icebergs_restart.nc'
+    default_used = 1
+else:
+    pathout = args.fout
+
+if default_used == 1:
+   print('At least one default value will be used; command executing is:')
+   print('icb_combrest.py -f ',pathstart,' -n ',procnum,' -o ',pathout)
+
+if procnum < 1:
+   print('Need some files to collate! procnum = ',procnum)
+   sys.exit()
+
+icu = []
+times = []
+ntraj = 0
+nk = 0
+#
+# Loop through all distributed datasets to obtain the total number 
+# of icebergs to transfer
+#
+for n in range(procnum):
+ nn = '%4.4d' % n
+ try:
+   fw = Dataset(pathstart+nn+'.nc')
+ except:
+   print 'Error: unable to open input file: ' + pathstart+nn+'.nc'
+   sys.exit()
+ for d in fw.dimensions :
+  if d == 'n' :
+   if len(fw.dimensions['n']) > 0:
+#    print 'icebergs found in: ' + pathstart+nn+'.nc' 
+     if len(fw.dimensions['k']) > nk :
+       nk = len(fw.dimensions['k'])
+     ntraj = ntraj + len(fw.dimensions['n'])
+ fw.close()
+#
+print(ntraj, ' icebergs found across all datasets')
+#
+# Declare 2-D arrays to receive the data from all files
+#
+lons = np.zeros(ntraj)
+lats = np.zeros(ntraj)
+xis  = np.zeros(ntraj)
+yjs  = np.zeros(ntraj)
+uvs  = np.zeros(ntraj)
+vvs  = np.zeros(ntraj)
+mas  = np.zeros(ntraj)
+ths  = np.zeros(ntraj)
+wis  = np.zeros(ntraj)
+les  = np.zeros(ntraj)
+dys  = np.zeros(ntraj)
+mss  = np.zeros(ntraj)
+msb  = np.zeros(ntraj)
+hds  = np.zeros(ntraj)
+yrs  = np.zeros(ntraj      , dtype=int)
+num  = np.zeros((ntraj, nk), dtype=int)
+#
+# loop through distributed datasets again, this time
+# collecting all trajectory data
+#
+nt = 0
+for n in range(procnum):
+ nn = '%4.4d' % n
+ fw = Dataset(pathstart+nn+'.nc')
+ for d in fw.dimensions :
+  if d == 'n' :
+# Note many distributed datafiles will contain no iceberg data
+# so skip quickly over these
+    m  = len(fw.dimensions['n'])
+    if m > 0:
+#     print pathstart+nn+'.nc'
+      lons[nt:nt+m]  = fw.variables['lon'][:]
+      lats[nt:nt+m]  = fw.variables['lat'][:]
+      xis[nt:nt+m]   = fw.variables['xi'][:]
+      yjs[nt:nt+m]   = fw.variables['yj'][:]
+      uvs[nt:nt+m]   = fw.variables['uvel'][:]
+      vvs[nt:nt+m]   = fw.variables['vvel'][:]
+      mas[nt:nt+m]   = fw.variables['mass'][:]
+      ths[nt:nt+m]   = fw.variables['thickness'][:]
+      wis[nt:nt+m]   = fw.variables['width'][:]
+      les[nt:nt+m]   = fw.variables['length'][:]
+      dys[nt:nt+m]   = fw.variables['day'][:]
+      mss[nt:nt+m]   = fw.variables['mass_scaling'][:]
+      msb[nt:nt+m]   = fw.variables['mass_of_bits'][:]
+      hds[nt:nt+m]   = fw.variables['heat_density'][:]
+      yrs[nt:nt+m]   = fw.variables['year'][:]
+      num[nt:nt+m,:] = fw.variables['number'][:,:]
+      nt = nt + m
+ fw.close()
+
+# Finally create the output file and write out the collated sets
+#
+if args.fcre :
+  try:
+    fo = Dataset(pathout, 'w', format='NETCDF4')
+  except:
+    print 'Error accessing output file: ' + pathout
+    print 'Check it is a writable location.'
+    sys.exit()
+else :
+  try:
+    fo = Dataset(pathout, 'r+', format='NETCDF4')
+  except:
+    print 'Error accessing output file: ' + pathout
+    print 'Check it exists and is writable.'
+    print 'Or run adding the -O option to create an output file which will'
+    print 'contain the iceberg state data only.'
+    sys.exit()
+#
+add_k = 1
+for d in fo.dimensions :
+  if d == 'n' :
+    print 'Error: dimension n already exists in output file'
+    sys.exit()
+  if d == 'k' :
+    add_k = 0
+onn  = fo.createDimension('n', None)
+if add_k > 0 :
+ onk = fo.createDimension('k', nk)
+olon = fo.createVariable('lon', 'f8',('n'))
+olat = fo.createVariable('lat', 'f8',('n'))
+oxis = fo.createVariable('xi', 'f8',('n'))
+oyjs = fo.createVariable('yj', 'f8',('n'))
+ouvs = fo.createVariable('uvel', 'f8',('n'))
+ovvs = fo.createVariable('vvel', 'f8',('n'))
+omas = fo.createVariable('mass', 'f8',('n'))
+oths = fo.createVariable('thickness', 'f8',('n'))
+owis = fo.createVariable('width', 'f8',('n'))
+oles = fo.createVariable('length', 'f8',('n'))
+odys = fo.createVariable('day', 'f8',('n'))
+omss = fo.createVariable('mass_scaling', 'f8',('n'))
+omsb = fo.createVariable('mass_of_bits', 'f8',('n'))
+ohds = fo.createVariable('heat_density', 'f8',('n'))
+oyrs = fo.createVariable('year', 'i4',('n'))
+onum = fo.createVariable('number', 'i4',('n','k'))
+#
+olon[:] = lons
+olon.long_name = "longitude"
+olon.units = "degrees_E" 
+#
+olat[:] = lats
+olat.long_name = "latitude"
+olat.units = "degrees_N"
+#
+oxis[:] = xis
+oxis.long_name = "x grid box position"
+oxis.units = "fractional"
+#
+oyjs[:] = yjs
+oyjs.long_name = "y grid box position"
+oyjs.units = "fractional"
+#
+ouvs[:] = uvs
+ouvs.long_name = "zonal velocity"
+ouvs.units = "m/s"
+#
+ovvs[:] = vvs
+ovvs.long_name = "meridional velocity"
+ovvs.units = "m/s"
+#
+omas[:] = mas
+omas.long_name = "mass"
+omas.units = "kg"
+#
+oths[:] = ths
+oths.long_name = "thickness"
+oths.units = "m"
+#
+owis[:] = wis
+owis.long_name = "width"
+owis.units = "m"
+#
+oles[:] = les
+oles.long_name = "length"
+oles.units = "m"
+#
+odys[:] = dys
+odys.long_name = "year day of calving event"
+odys.units = "days"
+#
+omss[:] = mss
+omss.long_name = "scaling factor for mass of calving berg"
+omss.units = "none"
+#
+omsb[:] = msb
+omsb.long_name = "mass of bergy bits"
+omsb.units = "kg"
+#
+ohds[:] = hds
+ohds.long_name = "heat density"
+ohds.units = "J/kg"
+#
+oyrs[:] = yrs
+oyrs.long_name = "calendar year of calving event"
+oyrs.units = "years"
+#
+onum[:,:] = num
+onum.long_name = "iceberg number on this processor"
+onum.units = "count"
+#
+fo.close()
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SCOORD_GEN/namelist
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SCOORD_GEN/namelist	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SCOORD_GEN/namelist	(revision 6808)
@@ -0,0 +1,28 @@
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+   ln_s_sh94   = .false.    !  Song & Haidvogel 1994 hybrid S-sigma   (T)|
+   ln_s_sf12   = .true.   !  Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied
+   ln_sigcrit  = .true.    !  use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
+                           !  stretching coefficients for all functions
+   rn_jpk      =  51       ! Number of S levels
+   ln_eq_taper = .false.   !  Tapering of S coords near equator
+   cn_coord_hgr = 'coordinates.nc'  ! File containing gphit (latitude) coordinate for use if ln_eq_taper=.true.
+   rn_sbot_min =   10.0    !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 7000.0    !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_hc       =   50.0    !  critical depth for transition to stretched coordinates
+                        !!!!!!!  Envelop bathymetry
+   rn_rmax     =    0.3    !  maximum cut-off r-value allowed (0<r_max<1)
+                        !!!!!!!  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   
+                        !!!!!!!  SF12 stretching coefficient  (ln_s_sf12 = .true.)
+   rn_alpha    =    4.4    !  stretching with SF12 s-sigma
+   rn_efold    =    0.0    !  efold length scale for transition to stretched coord
+   rn_zs       =    1.0    !  depth of surface grid box
+                           !  bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
+   rn_zb_a     =    0.024  !  bathymetry scaling factor for calculating Zb
+   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) 
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SCOORD_GEN/src/scoord_gen.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SCOORD_GEN/src/scoord_gen.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SCOORD_GEN/src/scoord_gen.F90	(revision 6808)
@@ -0,0 +1,664 @@
+PROGRAM SCOORD_GEN
+      !!----------------------------------------------------------------------
+      !!                  ***  PROGRAM scoord_gen  ***
+      !!                     
+      !! ** Purpose :   define the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate
+      !!         The depth of model levels is defined as the product of an
+      !!      analytical function by the local bathymetry, while the vertical
+      !!      scale factors are defined as the product of the first derivative
+      !!      of the analytical function by the bathymetry.
+      !!      (this solution save memory as depth and scale factors are not
+      !!      3d fields)
+      !!          - Read bathymetry (in meters) at t-point and compute the
+      !!         bathymetry at u-, v-, and f-points.
+      !!            hbatu = mi( hbatt )
+      !!            hbatv = mj( hbatt )
+      !!            hbatf = mi( mj( hbatt ) )
+      !!          - Compute z_gsigt, z_gsigw, z_esigt, z_esigw from an analytical
+      !!         function and its derivative given as function.
+      !!            z_gsigt(k) = fssig (k    )
+      !!            z_gsigw(k) = fssig (k-0.5)
+      !!            z_esigt(k) = fsdsig(k    )
+      !!            z_esigw(k) = fsdsig(k-0.5)
+      !!      Three options for stretching are give, and they can be modified
+      !!      following the users requirements. Nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order accuracy
+      !!      schemes.
+      !!
+      !!      The three methods for stretching available are:
+      !! 
+      !!           s_sh94 (Song and Haidvogel 1994)
+      !!                a sinh/tanh function that allows sigma and stretched sigma
+      !!
+      !!           s_sf12 (Siddorn and Furner 2012?)
+      !!                allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !! 
+      !!          s_tanh  (Madec et al 1996)
+      !!                a cosh/tanh function that gives stretched coordinates        
+      !!
+      !! ** History: 2015: Tim Graham - Code created based on online zdf_sco routine
+      !!
+      !!
+      !!----------------------------------------------------------------------
+      !
+      USE utils
+      IMPLICIT NONE
+
+
+     !!----------------------------------------------------------------------
+      !
+      !
+      OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
+      READ( numnam, namzgr_sco )
+      CLOSE( numnam )
+      jpk = INT(rn_jpk)
+
+      WRITE(*,*)
+      WRITE(*,*) 'scoord_gen : s-coordinate or hybrid z-s-coordinate'
+      WRITE(*,*) '~~~~~~~~~~~'
+      WRITE(*,*) '   Namelist namzgr_sco'
+      WRITE(*,*) '     stretching coeffs '
+      WRITE(*,*) '        Number of levels                             rn_jpk        = ',rn_jpk
+      WRITE(*,*) '        maximum depth of s-bottom surface (>0)       rn_sbot_max   = ',rn_sbot_max
+      WRITE(*,*) '        minimum depth of s-bottom surface (>0)       rn_sbot_min   = ',rn_sbot_min
+      WRITE(*,*) '        Critical depth                               rn_hc         = ',rn_hc
+      WRITE(*,*) '        maximum cut-off r-value allowed              rn_rmax       = ',rn_rmax
+      WRITE(*,*) '        Tapering in vicinity of equator              ln_eq_taper   = ',ln_eq_taper
+      WRITE(*,*) '        Horizontal Coordinate File                   cn_coord_hgr  = ',cn_coord_hgr
+      WRITE(*,*) '     Song and Haidvogel 1994 stretching              ln_s_sh94     = ',ln_s_sh94
+      WRITE(*,*) '        Song and Haidvogel 1994 stretching coefficients'
+      WRITE(*,*) '        surface control parameter (0<=rn_theta<=20)  rn_theta      = ',rn_theta
+      WRITE(*,*) '        bottom  control parameter (0<=rn_thetb<= 1)  rn_thetb      = ',rn_thetb
+      WRITE(*,*) '        stretching parameter (song and haidvogel)    rn_bb         = ',rn_bb
+      WRITE(*,*) '     Siddorn and Furner 2012 stretching              ln_s_sf12     = ',ln_s_sf12
+      WRITE(*,*) '        switching to sigma (T) or Z (F) at H<Hc      ln_sigcrit    = ',ln_sigcrit
+      WRITE(*,*) '        Siddorn and Furner 2012 stretching coefficients'
+      WRITE(*,*) '        stretchin parameter ( >1 surface; <1 bottom) rn_alpha      = ',rn_alpha
+      WRITE(*,*) '        e-fold length scale for transition region    rn_efold      = ',rn_efold
+      WRITE(*,*) '        Surface cell depth (Zs) (m)                  rn_zs         = ',rn_zs
+      WRITE(*,*) '        Bathymetry multiplier for Zb                 rn_zb_a       = ',rn_zb_a
+      WRITE(*,*) '        Offset for Zb                                rn_zb_b       = ',rn_zb_b
+      WRITE(*,*) '        Bottom cell (Zb) (m) = H*rn_zb_a + rn_zb_b'
+
+      
+      ! Read in bathy, jpi and jpj from bathy.nc
+      CALL read_bathy()
+
+      !Allocate all other allocatable variables
+      ios = dom_oce_alloc()
+      IF( ios .NE. 0) THEN
+         WRITE(0,*) 'Unable to allocate all arrays'
+         STOP 1
+      ENDIF
+
+      hift(:,:) = rn_sbot_min                     ! set the minimum depth for the s-coordinate
+      hifu(:,:) = rn_sbot_min
+      hifv(:,:) = rn_sbot_min
+      hiff(:,:) = rn_sbot_min
+
+      !                                        ! set maximum ocean depth
+      bathy(:,:) = MIN( rn_sbot_max, bathy(:,:) )
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+           IF( bathy(ji,jj) > 0. )   bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) )
+         END DO
+      END DO
+      !                                        ! =============================
+      !                                        ! Define the envelop bathymetry   (hbatt)
+      !                                        ! =============================
+      ! use r-value to create hybrid coordinates
+      zenv(:,:) = bathy(:,:)
+      !
+      ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+           IF( bathy(ji,jj) == 0. ) THEN
+             iip1 = MIN( ji+1, jpi )
+             ijp1 = MIN( jj+1, jpj )
+             iim1 = MAX( ji-1, 1 )
+             ijm1 = MAX( jj-1, 1 )
+             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. ) THEN
+               zenv(ji,jj) = rn_sbot_min
+             ENDIF
+           ENDIF
+         END DO
+      END DO
+      ! 
+      ! smooth the bathymetry (if required)
+      scosrf(:,:) = 0.             ! ocean surface depth (here zero: no under ice-shelf sea)
+      scobot(:,:) = bathy(:,:)        ! ocean bottom  depth
+      !
+      jl = 0
+      zrmax = 1.
+      !   
+      !     
+      ! set scaling factor used in reducing vertical gradients
+      zrfact = ( 1. - rn_rmax ) / ( 1. + rn_rmax )
+      !
+      ! initialise temporary evelope depth arrays
+      ztmpi1(:,:) = zenv(:,:)
+      ztmpi2(:,:) = zenv(:,:)
+      ztmpj1(:,:) = zenv(:,:)
+      ztmpj2(:,:) = zenv(:,:)
+      !
+      ! initialise temporary r-value arrays
+      zri(:,:) = 1.
+      zrj(:,:) = 1.
+
+      !                                                            ! ================ !
+      DO WHILE( jl <= 10000 .AND. ( zrmax - rn_rmax ) > 1.e-8 ) !  Iterative loop  !
+         !                                                         ! ================ !
+         jl = jl + 1
+         zrmax = 0.
+         ! we set zrmax from previous r-values (zri and zrj) first
+         ! if set after current r-value calculation (as previously)
+         ! we could exit DO WHILE prematurely before checking r-value
+         ! of current zenv
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
+               zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) )
+            END DO
+         END DO
+         zri(:,:) = 0.
+         zrj(:,:) = 0.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               iip1 = MIN(ji+1,jpi) 
+               ijp1 = MIN(jj+1,jpj)     
+               IF( (zenv(ji,jj) > 0.) .AND. (zenv(iip1,jj) > 0.)) THEN
+                  zri(ji,jj) = ( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
+               END IF
+               IF( (zenv(ji,jj) > 0.) .AND. (zenv(ji,ijp1) > 0.)) THEN
+                  zrj(ji,jj) = ( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) )
+               END IF
+               IF( zri(ji,jj) >  rn_rmax )   ztmpi1(ji  ,jj  ) = zenv(iip1,jj  ) * zrfact
+               IF( zri(ji,jj) < -rn_rmax )   ztmpi2(iip1,jj  ) = zenv(ji  ,jj  ) * zrfact
+               IF( zrj(ji,jj) >  rn_rmax )   ztmpj1(ji  ,jj  ) = zenv(ji  ,ijp1) * zrfact
+               IF( zrj(ji,jj) < -rn_rmax )   ztmpj2(ji  ,ijp1) = zenv(ji  ,jj  ) * zrfact
+            END DO
+         END DO
+         !
+         WRITE(*,*) 'zgr_sco :   iter= ',jl, ' rmax= ', zrmax
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zenv(ji,jj) = MAX(zenv(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) )
+            END DO
+         END DO
+         !                                                  ! ================ !
+      END DO                                                !     End loop     !
+      !                                                     ! ================ !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zenv(ji,jj) = MAX( zenv(ji,jj), rn_sbot_min ) ! set all points to avoid undefined scale value warnings
+         END DO
+      END DO
+      !
+      ! Envelope bathymetry saved in hbatt
+      hbatt(:,:) = zenv(:,:) 
+      IF( ln_eq_taper) THEN
+        CALL READ_GPHIT()
+        IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0. ) THEN
+          WRITE(*,*) 's-coordinates are tapered in vicinity of the Equator' 
+          DO jj = 1, jpj
+             DO ji = 1, jpi
+                ztaper = EXP( -(gphit(ji,jj)/8.)**2. )
+                hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1. - ztaper )
+             END DO
+          END DO
+        ENDIF
+      ENDIF
+      !
+      !                                        ! ==============================
+      !                                        !   hbatu, hbatv, hbatf fields
+      !                                        ! ==============================
+      WRITE(*,*)
+      WRITE(*,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min
+      hbatu(:,:) = rn_sbot_min
+      hbatv(:,:) = rn_sbot_min
+      hbatf(:,:) = rn_sbot_min
+      DO jj = 1, jpj-1
+        DO ji = 1, jpi-1   ! NO vector opt.
+           hbatu(ji,jj) = 0.50 * ( hbatt(ji  ,jj) + hbatt(ji+1,jj  ) )
+           hbatv(ji,jj) = 0.50 * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1) )
+           hbatf(ji,jj) = 0.25 * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1)   &
+              &                     + hbatt(ji+1,jj) + hbatt(ji+1,jj+1) )
+        END DO
+      END DO
+      ! 
+      zhbat(:,:) = hbatu(:,:)   
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatu(ji,jj) == 0. ) THEN
+               IF( zhbat(ji,jj) == 0. )   hbatu(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0. )   hbatu(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatv(:,:)  
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatv(ji,jj) == 0. ) THEN
+               IF( zhbat(ji,jj) == 0. )   hbatv(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0. )   hbatv(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatf(:,:)   
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatf(ji,jj) == 0. ) THEN
+               IF( zhbat(ji,jj) == 0. )   hbatf(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0. )   hbatf(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+
+!!bug:  key_helsinki a verifer
+      hift(:,:) = MIN( hift(:,:), hbatt(:,:) )
+      hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) )
+      hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) )
+      hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) )
+
+         WRITE(*,*) ' MAX val hif   t ', MAXVAL( hift (:,:) ), ' f ', MAXVAL( hiff (:,:) ),  &
+            &                        ' u ',   MAXVAL( hifu (:,:) ), ' v ', MAXVAL( hifv (:,:) )
+         WRITE(*,*) ' MIN val hif   t ', MINVAL( hift (:,:) ), ' f ', MINVAL( hiff (:,:) ),  &
+            &                        ' u ',   MINVAL( hifu (:,:) ), ' v ', MINVAL( hifv (:,:) )
+         WRITE(*,*) ' MAX val hbat  t ', MAXVAL( hbatt(:,:) ), ' f ', MAXVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MAXVAL( hbatu(:,:) ), ' v ', MAXVAL( hbatv(:,:) )
+         WRITE(*,*) ' MIN val hbat  t ', MINVAL( hbatt(:,:) ), ' f ', MINVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MINVAL( hbatu(:,:) ), ' v ', MINVAL( hbatv(:,:) )
+      
+      ! Create the output file
+      CALL make_coord_file()
+
+      !                                            ! =======================
+      !                                            !   s-coordinate fields     (gdep., e3.)
+      !                                            ! =======================
+      !
+      ! non-dimensional "sigma" for model level depth at w- and t-levels
+
+
+!========================================================================
+! Song and Haidvogel  1994 (ln_s_sh94=T)
+! Siddorn and Furner 2012 (ln_sf12=T)
+! or  tanh function       (both false)                    
+! To reduce memory loop over jpk and write each level to file
+!========================================================================
+      IF      ( ln_s_sh94 ) THEN 
+                           CALL s_sh94()
+      ELSE IF ( ln_s_sf12 ) THEN
+                           CALL s_sf12()
+      ELSE                 
+                           CALL s_tanh()
+      ENDIF
+
+!Write all 2D variables to output file
+      CALL write_netcdf_2d_vars()
+      CALL check_nf90( nf90_close(ncout) )
+
+ 
+      !
+END PROGRAM SCOORD_GEN
+
+!!======================================================================
+   SUBROUTINE s_sh94()
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sh94  ***
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Song and Haidvogel 1994
+      !!                mixed S/sigma coordinate
+      !!
+      !! Reference : Song and Haidvogel 1994. 
+      !!----------------------------------------------------------------------
+      !
+      USE utils
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gsigw3p1, z_gsigt3m1, z_gsi3w3m1
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_esigt3, z_esigw3, z_esigtu3 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
+
+      ALLOCATE( z_gsigw3(jpi,jpj), z_gsigt3(jpi,jpj), z_gsi3w3(jpi,jpj) )
+      ALLOCATE( z_esigt3(jpi,jpj), z_esigw3(jpi,jpj), z_esigtu3(jpi,jpj)) 
+      ALLOCATE( z_esigtv3(jpi,jpj), z_esigtf3(jpi,jpj), z_esigwu3(jpi,jpj)) 
+      ALLOCATE( z_esigwv3(jpi,jpj), z_gsigw3p1(jpi,jpj), z_gsigt3m1(jpi,jpj) )
+      ALLOCATE( z_gsi3w3m1(jpi,jpj) )
+ 
+      z_gsigw3  = 0.   ;   z_gsigt3  = 0.   ;   z_gsi3w3  = 0.
+      z_esigt3  = 0.   ;   z_esigw3  = 0. 
+      z_esigtu3 = 0.   ;   z_esigtv3 = 0.   ;   z_esigtf3 = 0.
+      z_esigwu3 = 0.   ;   z_esigwv3 = 0.
+
+      DO jk = 1,jpk
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+
+               IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma
+                     z_gsigw3(ji,jj) = -fssig1( REAL(jk,wp)-0.5, rn_bb )
+                     z_gsigw3p1(ji,jj) = -fssig1( REAL(jk+1,wp)-0.5, rn_bb )
+                     z_gsigt3(ji,jj) = -fssig1( REAL(jk,wp)    , rn_bb )
+               ELSE ! shallow water, uniform sigma
+                     z_gsigw3(ji,jj) =   REAL(jk-1,wp)            / REAL(jpk-1,wp)
+                     z_gsigw3p1(ji,jj) =   REAL(jk,wp)            / REAL(jpk-1,wp)
+                     z_gsigt3(ji,jj) = ( REAL(jk-1,wp) + 0.5 ) / REAL(jpk-1,wp)
+               ENDIF
+               !
+             !gsi3w3m1 & gsigt3m1 only used if jk /= 1 and is set at the end of the loop over jk
+               IF( jk .EQ. 1) THEN
+                  z_esigw3(ji,jj ) = 2. * ( z_gsigt3(ji,jj ) - z_gsigw3(ji,jj ) )
+                  z_gsi3w3(ji,jj) = 0.5 * z_esigw3(ji,jj)
+               ELSE
+                  z_esigw3(ji,jj) = z_gsigt3(ji,jj) - z_gsigt3m1(ji,jj)
+                  z_gsi3w3(ji,jj) = z_gsi3w3m1(ji,jj) + z_esigw3(ji,jj)
+               ENDIF
+               IF( jk .EQ. jpk) THEN
+                  z_esigt3(ji,jj) = 2. * ( z_gsigt3(ji,jj) - z_gsigw3(ji,jj) )
+               ELSE
+                  z_esigt3(ji,jj ) = z_gsigw3p1(ji,jj) - z_gsigw3(ji,jj)
+               ENDIF
+               !
+
+               zcoeft = ( REAL(jk,wp) - 0.5 ) / REAL(jpk-1,wp)
+               zcoefw = ( REAL(jk,wp) - 1.0 ) / REAL(jpk-1,wp)
+               gdept_0(ji,jj) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj)+rn_hc*zcoeft )
+               gdepw_0(ji,jj) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj)+rn_hc*zcoefw )
+               gdep3w_0(ji,jj) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj)+rn_hc*zcoeft )
+              !
+            END DO   ! for all jj's
+         END DO    ! for all ji's
+
+         DO ji = 1, jpi-1
+            DO jj = 1, jpj-1
+               z_esigtu3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigtv3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+               z_esigtf3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj)     &
+                  &                + hbatt(ji,jj+1)*z_esigt3(ji,jj+1)+hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+               z_esigwu3(ji,jj) = ( hbatt(ji,jj)*z_esigw3(ji,jj)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigwv3(ji,jj) = ( hbatt(ji,jj)*z_esigw3(ji,jj)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+               !
+               e3t_0(ji,jj) = ( (hbatt(ji,jj)-rn_hc)*z_esigt3 (ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3u_0(ji,jj) = ( (hbatu(ji,jj)-rn_hc)*z_esigtu3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3v_0(ji,jj) = ( (hbatv(ji,jj)-rn_hc)*z_esigtv3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3f_0(ji,jj) = ( (hbatf(ji,jj)-rn_hc)*z_esigtf3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               !
+               e3w_0 (ji,jj) = ( (hbatt(ji,jj)-rn_hc)*z_esigw3 (ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3uw_0(ji,jj) = ( (hbatu(ji,jj)-rn_hc)*z_esigwu3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3vw_0(ji,jj) = ( (hbatv(ji,jj)-rn_hc)*z_esigwv3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+            END DO
+         END DO
+
+         z_gsigt3m1 = z_gsigt3
+         z_gsi3w3m1 = z_gsi3w3
+ 
+         where (e3t_0   (:,:).eq.0.0)  e3t_0(:,:) = 1.0
+         where (e3u_0   (:,:).eq.0.0)  e3u_0(:,:) = 1.0
+         where (e3v_0   (:,:).eq.0.0)  e3v_0(:,:) = 1.0
+         where (e3f_0   (:,:).eq.0.0)  e3f_0(:,:) = 1.0
+         where (e3w_0   (:,:).eq.0.0)  e3w_0(:,:) = 1.0
+         where (e3uw_0  (:,:).eq.0.0)  e3uw_0(:,:) = 1.0
+         where (e3vw_0  (:,:).eq.0.0)  e3vw_0(:,:) = 1.0
+        
+         CALL write_netcdf_3d_vars(jk)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+                  IF( scobot(ji,jj) >= gdept_0(ji,jj) )   mbathy(ji,jj) = MAX( 2, jk )
+                  IF( scobot(ji,jj) == 0.             )   mbathy(ji,jj) = 0
+            END DO
+         END DO
+      END DO !End of loop over jk
+
+      DEALLOCATE( z_gsigw3, z_gsigt3, z_gsi3w3, z_gsigw3p1, z_gsigt3m1, z_gsi3w3m1)
+      DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+
+   END SUBROUTINE s_sh94
+
+   SUBROUTINE s_sf12
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sf12 *** 
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Siddorn and Furner 2012?
+      !!                mixed S/sigma/Z coordinate
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !!
+      !! Reference : Siddorn and Furner 2012 (submitted Ocean modelling).
+      !!----------------------------------------------------------------------
+      !
+      USE utils
+      REAL(wp) ::   zsmth               ! smoothing around critical depth
+      REAL(wp) ::   zzs, zzb           ! Surface and bottom cell thickness in sigma space
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gsigw3p1, z_gsigt3m1, z_gsi3w3m1
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_esigt3, z_esigw3, z_esigtu3 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
+
+      ALLOCATE( z_gsigw3(jpi,jpj), z_gsigt3(jpi,jpj), z_gsi3w3(jpi,jpj) )
+      ALLOCATE( z_esigt3(jpi,jpj), z_esigw3(jpi,jpj), z_esigtu3(jpi,jpj)) 
+      ALLOCATE( z_esigtv3(jpi,jpj), z_esigtf3(jpi,jpj), z_esigwu3(jpi,jpj)) 
+      ALLOCATE( z_esigwv3(jpi,jpj), z_gsigw3p1(jpi,jpj), z_gsigt3m1(jpi,jpj) )
+      ALLOCATE( z_gsi3w3m1(jpi,jpj) )
+
+      z_gsigw3  = 0.   ;   z_gsigt3  = 0.   ;   z_gsi3w3  = 0.
+      z_esigt3  = 0.   ;   z_esigw3  = 0. 
+      z_esigtu3 = 0.   ;   z_esigtv3 = 0.   ;   z_esigtf3 = 0.
+      z_esigwu3 = 0.   ;   z_esigwv3 = 0.
+      
+
+      DO jk = 1,jpk
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+             IF (hbatt(ji,jj)>rn_hc) THEN !deep water, stretched sigma
+              
+                zzb = hbatt(ji,jj)*rn_zb_a + rn_zb_b   ! this forces a linear bottom cell depth relationship with H,.
+                                                     ! could be changed by users but care must be taken to do so carefully
+                zzb = 1.0-(zzb/hbatt(ji,jj))
+            
+                zzs = rn_zs / hbatt(ji,jj) 
+              
+                IF (rn_efold /= 0.0) THEN
+                   zsmth   = tanh( (hbatt(ji,jj)- rn_hc ) / rn_efold )
+                ELSE
+                   zsmth = 1.0 
+                ENDIF
+                  
+                z_gsigw3(ji,jj) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)
+                z_gsigw3p1(ji,jj) =  REAL(jk,wp)        /REAL(jpk-1,wp)
+                z_gsigt3(ji,jj) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)
+                z_gsigw3(ji,jj) = fgamma( z_gsigw3(ji,jj), zzb, zzs, zsmth  )
+                z_gsigw3p1(ji,jj) = fgamma( z_gsigw3p1(ji,jj), zzb, zzs, zsmth  )
+                z_gsigt3(ji,jj) = fgamma( z_gsigt3(ji,jj), zzb, zzs, zsmth  )
+ 
+             ELSE IF(ln_sigcrit) THEN ! shallow water, uniform sigma
+
+                z_gsigw3(ji,jj) =  REAL(jk-1,wp)     /REAL(jpk-1,wp)
+                z_gsigw3p1(ji,jj) =  REAL(jk,wp)     /REAL(jpk-1,wp)
+                z_gsigt3(ji,jj) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)
+
+             ELSE  ! shallow water, z coordinates
+
+               z_gsigw3(ji,jj) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+               z_gsigw3p1(ji,jj) =  REAL(jk,wp)        /REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+               z_gsigt3(ji,jj) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+
+             ENDIF
+
+             !gsi3w3m1 & z_gsigt3m1 only used if jk /= 1 and is set at the end of the loop over jk
+             IF( jk .EQ. 1) THEN
+                z_esigw3(ji,jj  ) = 2.0 * (z_gsigt3(ji,jj ) - z_gsigw3(ji,jj ))
+                z_gsi3w3(ji,jj) = 0.5 * z_esigw3(ji,jj) 
+             ELSE
+                z_esigw3(ji,jj) = z_gsigt3(ji,jj) - z_gsigt3m1(ji,jj)
+                z_gsi3w3(ji,jj) = z_gsi3w3m1(ji,jj) + z_esigw3(ji,jj)
+             ENDIF
+             IF( jk .EQ. jpk) THEN
+                z_esigt3(ji,jj) = 2.0 * (z_gsigt3(ji,jj) - z_gsigw3(ji,jj))
+             ELSE
+                z_esigt3(ji,jj) = z_gsigw3p1(ji,jj) - z_gsigw3(ji,jj)
+             ENDIF
+
+             gdept_0(ji,jj) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj)
+             gdepw_0(ji,jj) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj)
+             gdep3w_0(ji,jj) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj)
+
+            ENDDO   ! for all jj's
+         ENDDO    ! for all ji's
+
+         DO ji=1,jpi-1
+            DO jj=1,jpj-1
+
+               z_esigtu3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigtv3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+               z_esigtf3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj) +  &
+                                       hbatt(ji,jj+1)*z_esigt3(ji,jj+1)+hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+               z_esigwu3(ji,jj) = ( hbatt(ji,jj)*z_esigw3(ji,jj)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigwv3(ji,jj) = ( hbatt(ji,jj)*z_esigw3(ji,jj)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+
+               e3t_0(ji,jj)=(scosrf(ji,jj)+hbatt(ji,jj))*z_esigt3(ji,jj)
+               e3u_0(ji,jj)=(scosrf(ji,jj)+hbatu(ji,jj))*z_esigtu3(ji,jj)
+               e3v_0(ji,jj)=(scosrf(ji,jj)+hbatv(ji,jj))*z_esigtv3(ji,jj)
+               e3f_0(ji,jj)=(scosrf(ji,jj)+hbatf(ji,jj))*z_esigtf3(ji,jj)
+               !
+               e3w_0(ji,jj)=hbatt(ji,jj)*z_esigw3(ji,jj)
+               e3uw_0(ji,jj)=hbatu(ji,jj)*z_esigwu3(ji,jj)
+               e3vw_0(ji,jj)=hbatv(ji,jj)*z_esigwv3(ji,jj)
+            ENDDO
+         ENDDO
+         ! Keep some arrays for next level
+         z_gsigt3m1 = z_gsigt3
+         z_gsi3w3m1 = z_gsi3w3
+ 
+         where (e3t_0   (:,:).eq.0.0)  e3t_0(:,:) = 1.0
+         where (e3u_0   (:,:).eq.0.0)  e3u_0(:,:) = 1.0
+         where (e3v_0   (:,:).eq.0.0)  e3v_0(:,:) = 1.0
+         where (e3f_0   (:,:).eq.0.0)  e3f_0(:,:) = 1.0
+         where (e3w_0   (:,:).eq.0.0)  e3w_0(:,:) = 1.0
+         where (e3uw_0  (:,:).eq.0.0)  e3uw_0(:,:) = 1.0
+         where (e3vw_0  (:,:).eq.0.0)  e3vw_0(:,:) = 1.0
+         
+         CALL write_netcdf_3d_vars(jk)
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+                  IF( scobot(ji,jj) >= gdept_0(ji,jj) )   mbathy(ji,jj) = MAX( 2, jk )
+                  IF( scobot(ji,jj) == 0.             )   mbathy(ji,jj) = 0
+            END DO
+         END DO
+
+      ENDDO ! End of loop over jk
+
+      DEALLOCATE( z_gsigw3, z_gsigt3, z_gsi3w3, z_gsigw3p1, z_gsigt3m1, z_gsi3w3m1)
+      DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+
+   END SUBROUTINE s_sf12
+
+   SUBROUTINE s_tanh()
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_tanh*** 
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch 
+      !!
+      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.
+      !!----------------------------------------------------------------------
+
+      USE utils
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_esigt, z_esigw
+
+      ALLOCATE( z_gsigw(jpk), z_gsigt(jpk), z_gsi3w(jpk) )
+      ALLOCATE( z_esigt(jpk), z_esigw(jpk) )
+
+      z_gsigw  = 0.   ;   z_gsigt  = 0.   ;   z_gsi3w  = 0.
+      z_esigt  = 0.   ;   z_esigw  = 0. 
+
+      DO jk = 1, jpk
+        z_gsigw(jk) = -fssig( REAL(jk,wp)-0.5 )
+        z_gsigt(jk) = -fssig( REAL(jk,wp)        )
+      END DO
+      WRITE(*,*) 'z_gsigw 1 jpk    ', z_gsigw(1), z_gsigw(jpk)
+      !
+      ! Coefficients for vertical scale factors at w-, t- levels
+!!gm bug :  define it from analytical function, not like juste bellow....
+!!gm        or betteroffer the 2 possibilities....
+      DO jk = 1, jpk-1
+         z_esigt(jk  ) = z_gsigw(jk+1) - z_gsigw(jk)
+         z_esigw(jk+1) = z_gsigt(jk+1) - z_gsigt(jk)
+      END DO
+      z_esigw( 1 ) = 2. * ( z_gsigt(1  ) - z_gsigw(1  ) ) 
+      z_esigt(jpk) = 2. * ( z_gsigt(jpk) - z_gsigw(jpk) )
+      !
+      ! Coefficients for vertical depth as the sum of e3w scale factors
+      z_gsi3w(1) = 0.5 * z_esigw(1)
+      DO jk = 2, jpk
+         z_gsi3w(jk) = z_gsi3w(jk-1) + z_esigw(jk)
+      END DO
+!!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays)
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              zcoeft = ( REAL(jk,wp) - 0.5 ) / REAL(jpk-1,wp)
+              zcoefw = ( REAL(jk,wp) - 1.0 ) / REAL(jpk-1,wp)
+              gdept_0(ji,jj) = ( scosrf(ji,jj) + (hbatt(ji,jj)-hift(ji,jj))*z_gsigt(jk) + hift(ji,jj)*zcoeft )
+              gdepw_0(:,:) = ( scosrf(ji,jj) + (hbatt(ji,jj)-hift(ji,jj))*z_gsigw(jk) + hift(ji,jj)*zcoefw )
+              gdep3w_0(:,:) = ( scosrf(ji,jj) + (hbatt(ji,jj)-hift(ji,jj))*z_gsi3w(jk) + hift(ji,jj)*zcoeft )
+              e3t_0(ji,jj) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigt(jk) + hift(ji,jj)/REAL(jpk-1,wp) )
+              e3u_0(ji,jj) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigt(jk) + hifu(ji,jj)/REAL(jpk-1,wp) )
+              e3v_0(ji,jj) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigt(jk) + hifv(ji,jj)/REAL(jpk-1,wp) )
+              e3f_0(ji,jj) = ( (hbatf(ji,jj)-hiff(ji,jj))*z_esigt(jk) + hiff(ji,jj)/REAL(jpk-1,wp) )
+              !
+              e3w_0(ji,jj) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigw(jk) + hift(ji,jj)/REAL(jpk-1,wp) )
+              e3uw_0(ji,jj) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigw(jk) + hifu(ji,jj)/REAL(jpk-1,wp) )
+              e3vw_0(ji,jj) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigw(jk) + hifv(ji,jj)/REAL(jpk-1,wp) )
+              IF( scobot(ji,jj) >= gdept_0(ji,jj) )   mbathy(ji,jj) = MAX( 2, jk )
+              IF( scobot(ji,jj) == 0.             )   mbathy(ji,jj) = 0
+            END DO
+         END DO
+         where (e3t_0   (:,:).eq.0.0)  e3t_0(:,:) = 1.0
+         where (e3u_0   (:,:).eq.0.0)  e3u_0(:,:) = 1.0
+         where (e3v_0   (:,:).eq.0.0)  e3v_0(:,:) = 1.0
+         where (e3f_0   (:,:).eq.0.0)  e3f_0(:,:) = 1.0
+         where (e3w_0   (:,:).eq.0.0)  e3w_0(:,:) = 1.0
+         where (e3uw_0  (:,:).eq.0.0)  e3uw_0(:,:) = 1.0
+         where (e3vw_0  (:,:).eq.0.0)  e3vw_0(:,:) = 1.0
+ 
+         CALL write_netcdf_3d_vars(jk)
+      ENDDO ! End of loop over jk
+
+
+      DEALLOCATE( z_gsigw, z_gsigt, z_gsi3w )
+      DEALLOCATE( z_esigt, z_esigw )
+
+   END SUBROUTINE s_tanh
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90	(revision 6808)
@@ -0,0 +1,330 @@
+MODULE utils
+
+   USE netcdf
+
+   IMPLICIT NONE
+   PUBLIC             ! allows the acces to par_oce when dom_oce is used
+   !                  ! exception to coding rules... to be suppressed ???
+
+!   PUBLIC dom_oce_alloc
+
+   INTEGER, PARAMETER   :: dp=8 , sp=4, wp=dp
+
+   !! All coordinates
+   !! ---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gdep3w_0           !: depth of t-points (sum of e3w) (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gdept_0, gdepw_0   !: analytical (time invariant) depth at t-w  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gphit              !: latitude at t points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3v_0  , e3f_0     !: analytical (time invariant) vertical scale factors at  v-f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_0  , e3u_0     !:                                      t-u  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3vw_0             !: analytical (time invariant) vertical scale factors at  vw
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3w_0  , e3uw_0    !:                                      w-uw points (m)
+
+   !! s-coordinate and hybrid z-s-coordinate
+   !! =----------------======---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatv , hbatf      !: ocean depth at the vertical of  v--f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatt , hbatu      !:                                 t--u points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   scosrf, scobot     !: ocean surface and bottom topographies 
+   !                                                                           !  (if deviating from coordinate surfaces in HYBRID)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hifv  , hiff       !: interface depth between stretching at v--f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu       !: and quasi-uniform spacing             t--u points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rx1                !: Maximum grid stiffness ratio
+
+   !!----------------------------------------------------------------------
+   !! masks, bathymetry
+   !! ---------------------------------------------------------------------
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy             !: number of ocean level (=0, 1, ... , jpk-1)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy              !: ocean depth (meters - read from file)
+
+   !! Other variables needed by scoord_gen
+   INTEGER  ::   jpi, jpj, jpk            ! Size of the domain - read from bathy or namelist?
+   INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument
+   INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers
+   INTEGER  ::   ios                      ! Local integer output status for namelist read and allocation
+   INTEGER,PARAMETER  ::   numnam=8       ! File handle for namelist 
+   REAL(wp) ::   zrmax, ztaper   ! temporary scalars
+   REAL(wp) ::   zrfact
+   !
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zenv, ztmp, zmsk, zri, zrj, zhbat
+
+   !Namelist variables
+   REAL(wp) :: rn_jpk, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax, rn_theta
+   REAL(wp) :: rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b
+   LOGICAL :: ln_s_sh94, ln_s_sf12, ln_sigcrit, ln_eq_taper
+   CHARACTER(len=50) :: cn_coord_hgr
+
+   NAMELIST/namzgr_sco/rn_jpk, ln_s_sh94, ln_s_sf12, ln_sigcrit, ln_eq_taper, & 
+                  &      cn_coord_hgr, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, &
+                  &      rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b
+
+  ! IDs for output netcdf file
+  INTEGER :: id_x, id_y, id_z
+  INTEGER :: ncout
+  INTEGER, DIMENSION(20) :: var_ids  !Array to contain all variable IDs
+
+   CONTAINS
+
+   INTEGER FUNCTION dom_oce_alloc()
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(4) :: ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( zenv(jpi,jpj), ztmp(jpi,jpj), zmsk(jpi,jpj), zri(jpi,jpj), zrj(jpi,jpj), &
+         &      zhbat(jpi,jpj) , ztmpi1(jpi,jpj), ztmpi2(jpi,jpj), ztmpj1(jpi,jpj), ztmpj2(jpi,jpj), STAT=ierr(1) )
+         !
+      ALLOCATE( gdep3w_0(jpi,jpj) , e3v_0(jpi,jpj) , e3f_0(jpi,jpj) ,                         &
+         &      gdept_0(jpi,jpj) , e3t_0(jpi,jpj) , e3u_0 (jpi,jpj) ,                         &
+         &      gdepw_0(jpi,jpj) , e3w_0(jpi,jpj) , e3vw_0(jpi,jpj) ,                         &
+         &      gphit(jpi,jpj)   , e3uw_0(jpi,jpj) , STAT=ierr(2) )
+         !
+         !
+      ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     &
+         &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     &
+         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     &
+         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     &
+         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(3) )
+
+      ALLOCATE( mbathy(jpi,jpj) , STAT=ierr(4) )
+     !
+      dom_oce_alloc = MAXVAL(ierr)
+      !
+   END FUNCTION dom_oce_alloc
+ 
+
+   SUBROUTINE read_bathy()
+     !! Read bathymetry from input netcdf file
+     INTEGER :: var_id, ncin
+
+     CALL check_nf90( nf90_open('bathy_meter.nc', NF90_NOWRITE, ncin), 'Error opening bathy_meter.nc file' )
+
+     ! Find the size of the input bathymetry
+     CALL dimlen(ncin, 'lon', jpi)    
+     CALL dimlen(ncin, 'lat', jpj)    
+     
+     ALLOCATE( bathy(jpi, jpj) )
+     
+     ! Read the bathymetry variable from file
+     CALL check_nf90( nf90_inq_varid( ncin, 'Bathymetry', var_id ), 'Cannot get variable ID for bathymetry')
+     CALL check_nf90( nf90_get_var( ncin, var_id, bathy, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+     CALL check_nf90( nf90_close(ncin), 'Error closing bathy.nc file' )
+
+   END SUBROUTINE read_bathy
+
+   SUBROUTINE read_gphit()
+   !! Read gphit from horizontal coordinate file if required
+     INTEGER :: var_id, ncin
+
+     CALL check_nf90( nf90_open(cn_coord_hgr, NF90_NOWRITE, ncin), 'Error opening horizontal coordinate file' )
+
+     ! Read gphit variable from file
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphit', var_id ), 'Cannot get variable ID for bathymetry')
+     CALL check_nf90( nf90_get_var( ncin, var_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+     CALL check_nf90( nf90_close(ncin), 'Error closing horizontal coordinate file' )
+
+   END SUBROUTINE read_gphit
+
+   SUBROUTINE dimlen( ncid, dimname, len )
+     ! Determine the length of dimension dimname
+     INTEGER, INTENT(in)          :: ncid
+     CHARACTER(LEN=*), INTENT(in) :: dimname
+     INTEGER, INTENT(out)         :: len
+     ! Local variables
+     INTEGER :: id_var
+
+     id_var = 1
+     CALL check_nf90( nf90_inq_dimid(ncid, dimname, id_var), 'Dimension not found in file')
+     CALL check_nf90( nf90_inquire_dimension(ncid,id_var,len=len))
+
+   END SUBROUTINE dimlen
+  
+ 
+   SUBROUTINE make_coord_file()
+     ! Create new coordinates file and define dimensions and variables ready for
+     ! writing
+     
+
+     !Create the file
+     CALL check_nf90( nf90_create('coord_zgr.nc', NF90_NETCDF4, ncout), 'Could not create output file')
+     !
+     !Define dimensions
+     CALL check_nf90( nf90_def_dim(ncout, 'x', jpi, id_x) )
+     CALL check_nf90( nf90_def_dim(ncout, 'y', jpj, id_y) )
+     CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) )
+     !
+     !Define variables - include all varibles that would be put into the mesh
+     !mask file
+     CALL check_nf90( nf90_def_var(ncout, 'gdept_0', nf90_double, (/id_x, id_y,id_z/), var_ids(1)) )
+     CALL check_nf90( nf90_def_var(ncout, 'gdepw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(2)) )
+     CALL check_nf90( nf90_def_var(ncout, 'gdep3w_0', nf90_double, (/id_x, id_y,id_z/), var_ids(3)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3f_0', nf90_double, (/id_x, id_y,id_z/), var_ids(4)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3t_0', nf90_double, (/id_x, id_y,id_z/), var_ids(5)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3u_0', nf90_double, (/id_x, id_y,id_z/), var_ids(6)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3v_0', nf90_double, (/id_x, id_y,id_z/), var_ids(7)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3w_0', nf90_double, (/id_x, id_y,id_z/), var_ids(8)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3uw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(9)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3vw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(10)) )
+     ! 2D fields
+     CALL check_nf90( nf90_def_var(ncout, 'mbathy', nf90_double, (/id_x, id_y/), var_ids(11)) )
+     CALL check_nf90( nf90_def_var(ncout, 'hbatt', nf90_double, (/id_x, id_y/), var_ids(12)) )
+     CALL check_nf90( nf90_def_var(ncout, 'hbatu', nf90_double, (/id_x, id_y/), var_ids(13)) )
+     CALL check_nf90( nf90_def_var(ncout, 'hbatv', nf90_double, (/id_x, id_y/), var_ids(14)) )
+     CALL check_nf90( nf90_def_var(ncout, 'hbatf', nf90_double, (/id_x, id_y/), var_ids(15)) )
+     CALL check_nf90( nf90_def_var(ncout, 'rx1', nf90_double, (/id_x, id_y/), var_ids(16)) )
+
+     
+     ! End define mode
+     CALL check_nf90( nf90_enddef(ncout) )
+     
+     WRITE(*,*) 'Opened coord_zgr.nc file and defined variables'
+
+   END SUBROUTINE make_coord_file
+
+   SUBROUTINE write_netcdf_2d_vars()
+
+     CALL check_nf90( nf90_put_var(ncout, var_ids(11), mbathy, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(12), hbatt, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(13), hbatu, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(14), hbatv, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(15), hbatf, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(16), rx1, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+   END SUBROUTINE write_netcdf_2d_vars
+
+   SUBROUTINE write_netcdf_3d_vars(kk)
+   ! Write  variables to the netcdf file at level kk
+     INTEGER, INTENT(in) :: kk
+
+     CALL check_nf90( nf90_put_var(ncout, var_ids(1), gdept_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(2), gdepw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(3), gdep3w_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(4), e3f_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(5), e3t_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(6), e3u_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(7), e3v_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(8), e3w_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(9), e3uw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(10), e3vw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+
+   END SUBROUTINE write_netcdf_3d_vars
+
+   SUBROUTINE check_nf90( istat, message )
+      !Check for netcdf errors
+      INTEGER, INTENT(in) :: istat
+      CHARACTER(LEN=*), INTENT(in), OPTIONAL :: message
+
+      IF (istat /= nf90_noerr) THEN
+         WRITE(*,*) 'ERROR! : '//TRIM(nf90_strerror(istat))
+         IF ( PRESENT(message) ) THEN ; WRITE(*,*) message ; ENDIF
+         STOP
+      ENDIF
+
+   END SUBROUTINE check_nf90
+   FUNCTION fssig( pk ) RESULT( pf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig ***
+      !!       
+      !! ** Purpose :   provide the analytical function in s-coordinate
+      !!          
+      !! ** Method  :   the function provide the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+!     USE utils, ONLY : wp,rn_theta,rn_thetb,jpk
+      IMPLICIT NONE
+      REAL(wp), INTENT(in) ::   pk   ! continuous "k" coordinate
+      REAL(wp)             ::   pf   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      pf =   (   TANH( rn_theta * ( -(pk-0.5) / REAL(jpk-1) + rn_thetb )  )   &
+         &     - TANH( rn_thetb * rn_theta                                )  )   &
+         & * (   COSH( rn_theta                           )                      &
+         &     + COSH( rn_theta * ( 2. * rn_thetb - 1. ) )  )              &
+         & / ( 2. * SINH( rn_theta ) )
+      !
+   END FUNCTION fssig
+
+   FUNCTION fssig1( pk1, pbb ) RESULT( pf1 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig1 ***
+      !!
+      !! ** Purpose :   provide the Song and Haidvogel version of the analytical function in s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+!     USE utils, ONLY : wp, jpk, rn_theta
+      IMPLICIT NONE
+      REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate
+      REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient
+      REAL(wp)             ::   pf1   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      IF ( rn_theta == 0 ) then      ! uniform sigma
+         pf1 = - ( pk1 - 0.5 ) / REAL( jpk-1 )
+      ELSE                        ! stretched sigma
+         pf1 =   ( 1. - pbb ) * ( SINH( rn_theta*(-(pk1-0.5)/REAL(jpk-1)) ) ) / SINH( rn_theta )              &
+            &  + pbb * (  (TANH( rn_theta*( (-(pk1-0.5)/REAL(jpk-1)) + 0.5) ) - TANH( 0.5 * rn_theta )  )  &
+            &        / ( 2. * TANH( 0.5 * rn_theta ) )  )
+      ENDIF
+      !
+   END FUNCTION fssig1
+
+   FUNCTION fgamma( pk1, pzb, pzs, psmth) RESULT( p_gamma )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fgamma  ***
+      !!
+      !! ** Purpose :   provide analytical function for the s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !! Reference  :   Siddorn and Furner, in prep
+      !!----------------------------------------------------------------------
+!     USE utils, ONLY : jpk,wp,rn_alpha
+      IMPLICIT NONE
+      REAL(wp), INTENT(in   ) ::   pk1           ! continuous "k" coordinate
+      REAL(wp)                ::   p_gamma       ! stretched coordinate
+      REAL(wp), INTENT(in   ) ::   pzb           ! Bottom box depth
+      REAL(wp), INTENT(in   ) ::   pzs           ! surface box depth
+      REAL(wp), INTENT(in   ) ::   psmth         ! Smoothing parameter
+      REAL(wp)                ::   za1,za2,za3   ! local variables
+      REAL(wp)                ::   zn1,zn2       ! local variables
+      REAL(wp)                ::   za,zb,zx      ! local variables
+      !!----------------------------------------------------------------------
+      !
+
+      zn1  =  1./(jpk-1.)
+      zn2  =  1. -  zn1
+
+      za1 = (rn_alpha+2.0)*zn1**(rn_alpha+1.0)-(rn_alpha+1.0)*zn1**(rn_alpha+2.0) 
+      za2 = (rn_alpha+2.0)*zn2**(rn_alpha+1.0)-(rn_alpha+1.0)*zn2**(rn_alpha+2.0)
+      za3 = (zn2**3.0 - za2)/( zn1**3.0 - za1)
+     
+      za = pzb - za3*(pzs-za1)-za2
+      za = za/( zn2-0.5*(za2+zn2**2.0) - za3*(zn1-0.5*(za1+zn1**2.0) ) )
+      zb = (pzs - za1 - za*( zn1-0.5*(za1+zn1**2.0 ) ) ) / (zn1**3.0 - za1)
+      zx = 1.0-za/2.0-zb
+
+      p_gamma = za*(pk1*(1.0-pk1/2.0))+zb*pk1**3.0 +  &
+                  & zx*( (rn_alpha+2.0)*pk1**(rn_alpha+1.0)- &
+                  &      (rn_alpha+1.0)*pk1**(rn_alpha+2.0) )
+      p_gamma = p_gamma*psmth+pk1*(1.0-psmth)
+
+      !
+   END FUNCTION fgamma
+
+
+END MODULE utils
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg	(revision 6808)
@@ -1,73 +1,158 @@
-# 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 |                                  |                    |               
+# 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          |                |      |   |                 |                                       |                                  
+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        |                |      |   |                 |                                       |                                  
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/attribute.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/attribute.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/attribute.f90	(revision 6808)
@@ -81,5 +81,6 @@
 ! 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)
@@ -130,10 +131,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
@@ -181,5 +182,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) 
    !
@@ -234,5 +235,5 @@
 
       ! local variable
-      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_value
+      REAL(dp)         , DIMENSION(:), ALLOCATABLE :: dl_value
       !----------------------------------------------------------------
 
@@ -300,6 +301,7 @@
    !> @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
@@ -355,6 +357,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)) )
@@ -368,5 +370,5 @@
    !>
    !> @author J.Paul
-   !> @dtae November, 2013 - Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_name   attribute name
@@ -1068,5 +1070,6 @@
    !> @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
@@ -1114,4 +1117,5 @@
 
             CASE(NF90_CHAR)
+
                cl_value=td_att%c_value
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/boundary.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/boundary.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/boundary.f90	(revision 6808)
@@ -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 north boundary [optional]
-!>       - cd_east  is string character description of north boundary [optional]
-!>       - cd_west  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]
 !>       - ld_oneseg is logical to force to use only one segment for each boundary [optional]
 !>
@@ -36,4 +36,7 @@
 !>    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/>
@@ -105,6 +108,12 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
-!> @date September, 2014 - add boundary description
-!> @date November, 2014 - Fix memory leaks bug
+!> @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
 !> 
 !> @todo add schematic to boundary structure description
@@ -157,5 +166,5 @@
    PRIVATE :: seg__init       ! initialise segment structure
    PRIVATE :: seg__clean      ! clean segment structure
-   PRIVATE :: seg__clean_unit ! clean segment structure
+   PRIVATE :: seg__clean_unit ! clean one segment structure
    PRIVATE :: seg__clean_arr  ! clean array of segment structure
    PRIVATE :: seg__copy       ! copy segment structure in another
@@ -173,8 +182,10 @@
       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
 
@@ -223,5 +234,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)
    !
@@ -260,5 +271,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)
    !
@@ -353,8 +364,20 @@
    END SUBROUTINE boundary__clean_arr
    !------------------------------------------------------------------- 
-   !> @brief This function put cardinal name inside file name.
+   !> @brief This function put cardinal name and date 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 
@@ -385,4 +408,8 @@
       CHARACTER(LEN=lc) :: cl_date
       CHARACTER(LEN=lc) :: cl_name
+
+      INTEGER(i4)       :: il_ind
+      INTEGER(i4)       :: il_indend
+
       ! loop indices 
       !---------------------------------------------------------------- 
@@ -400,18 +427,31 @@
          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
 
-         cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//&
-         &        TRIM(cl_date)//"."//TRIM(cl_suffix)
+         ! 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
 
          boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name)
@@ -442,6 +482,6 @@
    !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2'
    !>
-   !> @note boundaries are compute on T point. change will be done to get data
-   !> on other point when need be. 
+   !> @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. 
    !>
    !> @author J.Paul 
@@ -581,8 +621,13 @@
 
                ! get namelist information
-               tl_tmp=boundary__get_info(cl_card(jk))
+               tl_tmp=boundary__get_info(cl_card(jk),jk)
+
+               ! get segments indices
                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)
 
@@ -642,9 +687,10 @@
    !> @return boundary structure
    !------------------------------------------------------------------- 
-   FUNCTION boundary__init( cd_card, ld_use, td_seg ) 
+   FUNCTION boundary__init( cd_card, ld_use, ld_nam, 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
 
@@ -664,4 +710,7 @@
             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
@@ -778,16 +827,21 @@
    !> 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) 
+   FUNCTION boundary__get_info(cd_card, id_jcard) 
       IMPLICIT NONE 
       ! Argument 
       CHARACTER(LEN=lc), INTENT(IN) :: cd_card
+      INTEGER(i4)      , INTENT(IN) :: id_jcard
 
       ! function 
@@ -802,4 +856,5 @@
       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 
@@ -818,4 +873,9 @@
       ! 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
@@ -831,4 +891,5 @@
             ENDIF
          ENDIF
+
       ENDIF 
 
@@ -839,5 +900,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:))
@@ -848,9 +909,13 @@
          ENDIF
       
-         cl_first=fct_split(cl_seg,2,',')
+         
+         cl_tmp=fct_split(cl_seg,2,',')
+
+
+         cl_first=fct_split(cl_tmp,1,':')
          ! 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:))
@@ -861,9 +926,9 @@
          ENDIF         
          
-         cl_last =fct_split(cl_seg,3,',')
+         cl_last =fct_split(cl_tmp,2,':')
          ! 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:))
@@ -879,4 +944,10 @@
          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. &
@@ -943,5 +1014,5 @@
 
       DO jk=1,ip_ncard
-         IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%i_nseg > 1 )THEN
+         IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%l_nam )THEN
             ! nothing to be done
          ELSE
@@ -1480,5 +1551,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
@@ -1515,5 +1586,5 @@
          ENDIF
       ENDDO
-      
+ 
       CALL boundary_check_corner(td_bdy, td_var)
 
@@ -1650,5 +1721,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)
    !
@@ -1687,5 +1758,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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90	(revision 6808)
@@ -20,5 +20,11 @@
 !>    ./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)
@@ -37,5 +43,5 @@
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal')
+!> 'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -52,18 +58,21 @@
 !>       - cn_coord1 : coordinate file
 !>       - in_perio1 : periodicity index
-!>       - ln_fillclosed : fill closed sea or not
+!>       - ln_fillclosed : fill closed sea or not (default is .TRUE.)
 !>
 !>    * _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.<br/>
+!>          each elements of *cn_varinfo* is a string character
+!>          (separated by ',').<br/>
 !>          it is composed of the variable name follow by ':', 
 !>          then request(s) to be used on this variable.<br/> 
 !>          request could be:
-!>             - interpolation method
-!>             - extrapolation method
-!>             - filter method
-!>             - > minimum value
-!>             - < maximum value
+!>             - 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)
 !>
 !>                requests must be separated by ';'.<br/>
@@ -72,5 +81,5 @@
 !>          informations about available method could be find in @ref interp,
 !>          @ref extrap and @ref filter modules.<br/>
-!>          Example: 'Bathymetry: 2*hamming(2,3); > 0'
+!>          Example: 'Bathymetry: flt=2*hamming(2,3); min=0'
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -90,5 +99,4 @@
 !>                - ',' for line
 !>                - '/' for row
-!>                - '\' for level<br/>
 !>                Example:<br/>
 !>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
@@ -99,7 +107,4 @@
 !>             - '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/>
@@ -119,5 +124,13 @@
 !> - 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)
 !----------------------------------------------------------------------
@@ -482,5 +495,10 @@
    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))
@@ -557,5 +575,5 @@
 
    ! add other variables
-   DO jk=1,tl_multi%i_nvar
+   DO jk=tl_multi%i_nvar,1,-1
       CALL file_add_var(tl_fileout, tl_var(jk))
       CALL var_clean(tl_var(jk))
@@ -623,5 +641,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_var    variable structure 
@@ -759,5 +777,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_var    variable structure 
@@ -878,5 +896,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_var    variable structure
@@ -897,10 +915,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
@@ -989,5 +1007,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure 
@@ -1073,7 +1091,5 @@
 
       ! extrapolate variable
-      CALL extrap_fill_value( td_var, id_offset=id_offset(:,:), &
-      &                               id_rho=id_rho(:),         &
-      &                               id_iext=il_iext, id_jext=il_jext )
+      CALL extrap_fill_value( td_var )
 
       ! interpolate Bathymetry
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90	(revision 6808)
@@ -23,5 +23,11 @@
 !>    ./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)
@@ -42,5 +48,5 @@
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal')
+!> 'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -79,12 +85,14 @@
 !>    * _variable namelist (namvar)_:<br/>
 !>       - cn_varinfo : list of variable and extra information about request(s)
-!> to be used.<br/>
+!>          to be used (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:
-!>             - interpolation method
-!>             - extrapolation method
-!>             - filter method
+!>             - int = interpolation method
+!>             - ext = extrapolation method
+!>             - flt = filter method
+!>             - unt = new units
+!>             - unf = unit scale factor (linked to new units)
 !>
 !>                requests must be separated by ';'.<br/>
@@ -94,5 +102,5 @@
 !>          @ref extrap and @ref filter.<br/>
 !>
-!>          Example: 'votemper:linear;hann;dist_weight', 'vosaline:cubic'
+!>          Example: 'votemper:int=linear;flt=hann;ext=dist_weight', 'vosaline:int=cubic'
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -136,9 +144,9 @@
 !>          segments are separated by '|'.<br/>
 !>          each segments of the boundary is composed of:
-!>             - 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/>
+!>             - 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/>
 !>             - optionally, boundary size could be added between '(' and ')' 
 !>             in the first segment defined.
@@ -147,19 +155,26 @@
 !>
 !>          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
-!>       - in_extrap : number of mask point to be extrapolated
-!>
-!>   * _output namelist (namout)_:<br/>
+!>
+!>    * _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
@@ -169,5 +184,10 @@
 !> - add header for user
 !> - take into account grid point to compue boundaries
-!> - reorder output dimension for north and south 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.  
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -191,5 +211,5 @@
    USE dom                             ! domain manager
    USE grid                            ! grid manager
-   USE vgrid                           ! vartical grid manager
+   USE vgrid                           ! vertical grid manager
    USE extrap                          ! extrapolation manager
    USE interp                          ! interpolation manager
@@ -213,5 +233,4 @@
    INTEGER(i4)                                        :: il_status
    INTEGER(i4)                                        :: il_fileid
-   INTEGER(i4)                                        :: il_dim
    INTEGER(i4)                                        :: il_imin0
    INTEGER(i4)                                        :: il_imax0
@@ -239,4 +258,6 @@
 
    TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+   TYPE(TDATE)                                        :: tl_date
    
    TYPE(TBDY)       , DIMENSION(ip_ncard)             :: tl_bdy
@@ -265,22 +286,37 @@
    ! 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
-   INTEGER(i4)                             :: in_nlevel = 75
+   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
 
    ! namvar
@@ -289,21 +325,22 @@
 
    ! 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.
-   INTEGER(i4)                             :: in_extrap  = 0
+   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.
 
    ! namout
-   CHARACTER(LEN=lc)                       :: cn_fileout = 'boundary.nc' 
+   CHARACTER(LEN=lc) :: cn_fileout = 'boundary.nc' 
+   REAL(dp)          :: dn_dayofs  = 0._dp
+   LOGICAL           :: ln_extrap  = .FALSE.
    !-------------------------------------------------------------------
 
@@ -319,5 +356,5 @@
    &  cn_coord0,     &  !< coordinate file
    &  in_perio0         !< periodicity index
-   
+ 
    NAMELIST /namfin/ &  !< fine grid namelist
    &  cn_coord1,     &  !< coordinate file
@@ -326,10 +363,25 @@
  
    NAMELIST /namzgr/ &
-   &  in_nlevel
+   &  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
 
    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
@@ -345,9 +397,10 @@
    &  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
-   &  in_extrap         !< number of mask point to be extrapolated
+   &  ln_oneseg         !< use only one segment for each boundary or not
 
    NAMELIST /namout/ &  !< output namelist
-   &  cn_fileout    !< fine grid boundary file basename   
+   &  cn_fileout,    &  !< fine grid boundary file basename   
+   &  dn_dayofs,     &  !< date offset in day (change only ouput file name)
+   &  ln_extrap         !< extrapolate or not
    !-------------------------------------------------------------------
 
@@ -448,7 +501,16 @@
    ! 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
@@ -490,9 +552,10 @@
 
    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, &
@@ -505,8 +568,8 @@
    tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist )
 
-   ! get coordinate on each segment of each boundary
+   ! get coordinate for 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
@@ -516,4 +579,11 @@
             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)
@@ -523,8 +593,4 @@
                &                  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
@@ -594,8 +660,4 @@
                         &                          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), &
@@ -654,5 +716,6 @@
                   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
@@ -662,5 +725,6 @@
                            
                            cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name
-                           WRITE(*,'(4x,a,a)') "work on variable "//TRIM(cl_name)
+                           WRITE(*,'(4x,a,a)') "work on (extract) variable "//&
+                              &  TRIM(cl_name)
 
                            cl_point=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_point
@@ -678,5 +742,4 @@
 
                            tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl))
-                           tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl))
 
                            ! open mpp files
@@ -687,8 +750,4 @@
                            &                     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), &
@@ -699,11 +758,14 @@
 
                            ! 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)
 
@@ -736,11 +798,12 @@
                   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 variable "//&
+ 
+                           WRITE(*,'(4x,a,a)') "work on (interp) variable "//&
                            &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
 
@@ -759,5 +822,4 @@
 
                            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, &
@@ -795,5 +857,6 @@
                            &                 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)
 
@@ -815,8 +878,4 @@
                            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
@@ -889,20 +948,11 @@
 
    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
@@ -911,4 +961,8 @@
             &                               '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) )
@@ -924,7 +978,9 @@
             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))
@@ -933,9 +989,23 @@
                CALL filter_fill_value(tl_segvar1(jvar,jk,jl))
 
-               ! extrapolate
-               CALL extrap_fill_value( tl_segvar1(jvar,jk,jl), &
-               &                       id_iext=in_extrap,      &
-               &                       id_jext=in_extrap,      &
-               &                       id_kext=in_extrap )
+               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))
 
             ENDDO
@@ -944,13 +1014,32 @@
             ! create file structure
             ! set file namearray of level variable structure
-            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) )
+            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
             ELSE
-               cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
-               &                                TRIM(tl_bdy(jl)%c_card), jk )
+               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
             ENDIF
             ! 
@@ -960,19 +1049,9 @@
             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
 
@@ -992,16 +1071,22 @@
             ENDIF
             
+
+
             IF( tl_dim(3)%l_use )THEN
-               ! add depth
-               CALL file_add_var(tl_fileout, tl_depth)
+               IF( ASSOCIATED(tl_depth%d_value) )THEN
+                  ! add depth
+                  CALL file_add_var(tl_fileout, tl_depth)
+               ENDIF
             ENDIF
 
             IF( tl_dim(4)%l_use )THEN
-               ! add time
-               CALL file_add_var(tl_fileout, tl_time)
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  ! add time
+                  CALL file_add_var(tl_fileout, tl_time)
+               ENDIF
             ENDIF
 
             ! add other variable
-            DO jvar=1,tl_multi%i_nvar
+            DO jvar=tl_multi%i_nvar,1,-1
                CALL file_add_var(tl_fileout, tl_segvar1(jvar,jk,jl))
                CALL var_clean(tl_segvar1(jvar,jk,jl))
@@ -1048,5 +1133,5 @@
 
             ! write file
-            CALL iom_write_file(tl_fileout)
+            CALL iom_write_file(tl_fileout, cl_dimorder)
 
             ! close file
@@ -1066,4 +1151,7 @@
    DEALLOCATE( tl_segdom1 )
    DEALLOCATE( tl_segvar1 )
+   CALL var_clean(tl_seglvl1(:,:,:))
+   DEALLOCATE( tl_seglvl1 )
+
 
    CALL mpp_clean(tl_coord1)
@@ -1082,5 +1170,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - take into account grid point to compute boundary indices
@@ -1186,9 +1274,10 @@
    !-------------------------------------------------------------------
    !> @brief
-   !> This subroutine get coordinates over boudnary domain
+   !> This subroutine get coordinates over boundary domain
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !> @date September, 2014 - take into account grid point
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - take into account grid point
    !>
    !> @param[in] td_coord1 coordinates file structure
@@ -1237,10 +1326,10 @@
    !-------------------------------------------------------------------
    !> @brief
-   !> This subroutine interpolate variable over boundary
+   !> This subroutine interpolate variable on boundary
    !> 
    !> @details 
    !>
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure 
@@ -1296,5 +1385,5 @@
 
       ! extrapolate variable
-      CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext )
+      CALL extrap_fill_value( td_var )
 
       ! interpolate Bathymetry
@@ -1303,5 +1392,6 @@
 
       ! 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
@@ -1317,5 +1407,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_var    variable structure 
@@ -1422,5 +1512,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure 
@@ -1475,5 +1565,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_level  array of level variable structure
@@ -1537,5 +1627,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !>
    !> @param[in] td_mpp       mpp structure
@@ -1588,5 +1678,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !>
    !> @param[in] td_mpp      mpp structure
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/create_coord.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/create_coord.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/create_coord.f90	(revision 6808)
@@ -24,4 +24,7 @@
 !> @endcode
 !>    
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
 !>    create_coord.nam comprise 6 namelists:<br/>
 !>       - logger namelist (namlog)
@@ -39,5 +42,5 @@
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal')
+!> 'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -54,11 +57,12 @@
 !>       - cn_varinfo : list of variable and extra information about request(s)
 !> to be used.<br/>
-!>          each elements of *cn_varinfo* is a string character.<br/>
+!>          each elements of *cn_varinfo* is a string character 
+!>          (separated by ',').<br/>
 !>          it is composed of the variable name follow by ':', 
 !>          then request(s) to be used on this variable.<br/> 
 !>          request could be:
-!>             - interpolation method
-!>             - extrapolation method
-!>             - filter method
+!>             - int = interpolation method
+!>             - ext = extrapolation method
+!>             - flt = filter method
 !> 
 !>                requests must be separated by ';' .<br/>
@@ -68,6 +72,6 @@
 !>          @ref extrap and @ref filter modules.<br/>
 !>
-!>          Example: 'votemper: linear; hann(2,3); dist_weight', 
-!>          'vosaline: cubic'<br/>
+!>          Example: 'votemper: int=linear; flt=hann(2,3); ext=dist_weight', 
+!>          'vosaline: int=cubic'<br/>
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -90,5 +94,5 @@
 !>
 !>    * _output namelist (namout)_:
-!>       - cn_fileout : output coordinate file
+!>       - cn_fileout : output coordinate file name
 !>
 !> @author J.Paul
@@ -152,12 +156,4 @@
    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
@@ -165,15 +161,20 @@
 
    ! 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
 
-   CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg' 
-
+   ! namvar
    CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
 
+   !namnst
    INTEGER(i4)       :: in_imin0 = 0
    INTEGER(i4)       :: in_imax0 = 0
@@ -183,4 +184,5 @@
    INTEGER(i4)       :: in_rhoj  = 1
 
+   !namout
    CHARACTER(LEN=lc) :: cn_fileout= 'coord_fine.nc'
    !-------------------------------------------------------------------
@@ -305,5 +307,4 @@
 
       il_offset(:,:,:)=create_coord_get_offset(il_rho(:))
-
    ENDIF
 
@@ -348,8 +349,4 @@
       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))      
@@ -375,9 +372,8 @@
 
    ! add variables
-   DO ji=1,il_nvar
+   DO ji=il_nvar,1,-1
       CALL file_add_var(tl_fileout, tl_var(ji))
+      CALL var_clean(tl_var(ji))
    ENDDO
-
-   ! recompute some attribute
 
    ! add some attribute
@@ -440,37 +436,4 @@
 
    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
@@ -539,4 +502,6 @@
    !> @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,          &
@@ -626,5 +591,5 @@
 
          ! extrapolate variable
-         CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext )
+         CALL extrap_fill_value( td_var )
 
          ! interpolate variable
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/create_restart.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/create_restart.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/create_restart.f90	(revision 6808)
@@ -25,4 +25,7 @@
 !> @endcode
 !>    
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
 !>    create_restart.nam comprise 9 namelists:<br/>
 !>       - logger namelist (namlog)
@@ -43,5 +46,5 @@
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal')
+!> 'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -59,6 +62,4 @@
 !>       - 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/>
@@ -83,13 +84,16 @@
 !>       - cn_varinfo : list of variable and extra information about request(s) 
 !>       to be used.<br/>
-!>          each elements of *cn_varinfo* is a string character.<br/>
+!>          each elements of *cn_varinfo* is a string character
+!>          (separated by ',').<br/>
 !>          it is composed of the variable name follow by ':', 
 !>          then request(s) to be used on this variable.<br/> 
 !>          request could be:
-!>             - interpolation method
-!>             - extrapolation method
-!>             - filter method
-!>             - > minimum value
-!>             - < maximum value
+!>             - 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)
 !>
 !>             requests must be separated by ';'.<br/>
@@ -98,5 +102,5 @@
 !>          informations about available method could be find in @ref interp,
 !>          @ref extrap and @ref filter.<br/>
-!>          Example: 'votemper: linear; hann; dist_weight','vosaline: cubic'
+!>          Example: 'votemper: int=linear; flt=hann; ext=dist_weight','vosaline: int=cubic'
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -136,7 +140,8 @@
 !>    * _output namelist (namout)_:<br/>
 !>       - cn_fileout : output file
-!>       - in_nproc  : total number of processor to be used
+!>       - ln_extrap : extrapolate land point or not
 !>       - 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')
 !>
@@ -148,4 +153,7 @@
 !> - 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)
@@ -165,5 +173,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
@@ -249,5 +257,4 @@
    CHARACTER(LEN=lc) :: cn_bathy1 = ''
    INTEGER(i4)       :: in_perio1 = -1
-   INTEGER(i4)       :: in_extrap = 0
 
    !namzgr
@@ -279,4 +286,5 @@
    ! namout
    CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc' 
+   LOGICAL           :: ln_extrap  = .FALSE.
    INTEGER(i4)       :: in_nproc   = 0
    INTEGER(i4)       :: in_niproc  = 0
@@ -301,6 +309,5 @@
    &  cn_coord1,   &    !< coordinate file
    &  cn_bathy1,   &    !< bathymetry file
-   &  in_perio1,   &    !< periodicity index
-   &  in_extrap
+   &  in_perio1         !< periodicity index
  
    NAMELIST /namzgr/ &
@@ -332,7 +339,8 @@
    NAMELIST /namout/ &  !< output namlist
    &  cn_fileout, &     !< fine grid bathymetry file
-   &  in_nproc,   &     !< number of processor to be used
+   &  ln_extrap,  &     !< extrapolate or not
    &  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)
    !-------------------------------------------------------------------
@@ -347,5 +355,5 @@
       CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
    ENDIF
-   
+
    ! read namelist
    INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
@@ -434,5 +442,9 @@
    ! check
    ! check output file do not already exist
-   cl_fileout=file_rename(cn_fileout,1)
+   IF( in_nproc > 0 )THEN
+      cl_fileout=file_rename(cn_fileout,1)
+   ELSE
+      cl_fileout=file_rename(cn_fileout)
+   ENDIF
    INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist)
    IF( ll_exist )THEN
@@ -468,16 +480,6 @@
    &                            il_rho(:) )
 
-   ! compute level
-   ALLOCATE(tl_level(ip_npoint))
-   tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist )
-
-   ! remove ghost cell
+   ! fine grid 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
@@ -514,5 +516,8 @@
                tl_var(jvar) = create_restart_matrix( &
                &  tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj), tl_coord1, &
-               &  in_nlevel, tl_level(:) )
+               &  in_nlevel, il_xghost(:,:) )
+
+               ! add ghost cell
+               CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:))
 
             ENDDO
@@ -535,4 +540,5 @@
             ! open mpp file
             CALL iom_mpp_open(tl_mpp)
+
 
             ! get or check depth value
@@ -579,5 +585,5 @@
                DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
 
-                  WRITE(*,'(2x,a,a)') "work on variable "//&
+                  WRITE(*,'(2x,a,a)') "work on (extract) variable "//&
                   &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
 
@@ -600,9 +606,6 @@
                   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
@@ -631,5 +634,5 @@
                DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
 
-                  WRITE(*,'(2x,a,a)') "work on variable "//&
+                  WRITE(*,'(2x,a,a)') "work on (interp) variable "//&
                   &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
 
@@ -646,8 +649,7 @@
                   &                                   id_rho=il_rho(:), &
                   &                                   cd_point=TRIM(tl_var(jvar)%c_point))
-                  
 
                   ! interpolate variable
-                  CALL create_restart_interp(tl_var(jvar), tl_level(:), &
+                  CALL create_restart_interp(tl_var(jvar), & 
                   &                          il_rho(:), &
                   &                          id_offset=il_offset(:,:))
@@ -675,11 +677,6 @@
                   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
 
@@ -705,7 +702,19 @@
    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))
@@ -714,8 +723,8 @@
       CALL filter_fill_value(tl_var(jvar))
 
-      ! extrapolate
-      CALL extrap_fill_value(tl_var(jvar), id_iext=in_extrap, &
-      &                                    id_jext=in_extrap, &
-      &                                    id_kext=in_extrap)
+      IF( .NOT. ln_extrap )THEN
+         ! use mask
+         CALL create_restart_mask(tl_var(jvar), tl_level(:))
+      ENDIF
 
    ENDDO
@@ -724,5 +733,5 @@
    IF( in_niproc == 0 .AND. &
    &   in_njproc == 0 .AND. &
-   &   in_nproc  == 0 )THEN
+   &   in_nproc == 0 )THEN
       in_niproc = 1
       in_njproc = 1
@@ -782,5 +791,5 @@
          CALL mpp_add_var(tl_mppout, tl_depth)
       ELSE
-         CALL logger_error("CREATE RESTART: no value for depth variable.")
+         CALL logger_warn("CREATE RESTART: no value for depth variable.")
       ENDIF
    ENDIF
@@ -792,5 +801,5 @@
          CALL mpp_add_var(tl_mppout, tl_time)
       ELSE
-         CALL logger_error("CREATE RESTART: no value for time variable.")
+         CALL logger_warn("CREATE RESTART: no value for time variable.")
       ENDIF
    ENDIF
@@ -798,5 +807,5 @@
 
    ! add other variable
-   DO jvar=1,il_nvar
+   DO jvar=il_nvar,1,-1
       ! check if variable already add
       il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name)
@@ -807,9 +816,4 @@
    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")
@@ -839,4 +843,7 @@
    ENDIF
 
+   ! print
+   CALL mpp_print(tl_mppout)
+
    ! create file
    CALL iom_mpp_create(tl_mppout)
@@ -847,13 +854,12 @@
    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)
-   CALL var_clean(tl_level(:))
-   DEALLOCATE(tl_level)
+   IF( .NOT. ln_extrap )THEN
+      CALL var_clean(tl_level(:))
+      DEALLOCATE(tl_level)
+   ENDIF
 
    CALL mpp_clean(tl_mppout)
@@ -876,19 +882,21 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - do not use level anymore 
    !>
    !> @param[in] td_var    variable structure 
    !> @param[in] td_coord  coordinate file structure 
    !> @param[in] id_nlevel number of vertical level  
-   !> @param[in] td_level  array of level on T,U,V,F point (variable structure) 
+   !> @param[in] id_xghost ghost cell array
    !> @return variable structure 
    !-------------------------------------------------------------------
-   FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, td_level)
+   FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, id_xghost)
       IMPLICIT NONE
       ! Argument
-      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
+      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
 
       ! function
@@ -899,5 +907,4 @@
       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
@@ -915,7 +922,4 @@
       !----------------------------------------------------------------
 
-      ! look for ghost cell
-      il_xghost(:,:)=grid_get_ghost( td_coord )
-
       ! write value on grid
       ! get matrix dimension
@@ -929,6 +933,6 @@
 
       ! remove ghost cell
-      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
+      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
 
       ! split output domain in N subdomain depending of matrix dimension 
@@ -992,10 +996,4 @@
       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)
@@ -1009,5 +1007,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -1071,8 +1069,9 @@
    !> 
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - do not use level anymore (for extrapolation)
    !>
    !> @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
@@ -1080,5 +1079,5 @@
    !> @param[in] id_jext      j-direction size of extra bands (default=im_minext)
    !-------------------------------------------------------------------
-   SUBROUTINE create_restart_interp( td_var, td_level,&
+   SUBROUTINE create_restart_interp( td_var, & 
    &                                 id_rho,          &
    &                                 id_offset,       &
@@ -1089,5 +1088,4 @@
       ! 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
@@ -1119,5 +1117,4 @@
          il_jext=2
       ENDIF
-
       ! work on variable
       ! add extraband
@@ -1125,8 +1122,5 @@
 
       ! extrapolate variable
-      CALL extrap_fill_value( td_var, td_level(:),    &
-      &                               id_offset(:,:), &
-      &                               id_rho(:),      &
-      &                               id_iext=il_iext, id_jext=il_jext )
+      CALL extrap_fill_value( td_var )
 
       ! interpolate variable
@@ -1146,5 +1140,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !>
    !> @param[in] td_mpp       mpp structure
@@ -1197,5 +1191,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !>
    !> @param[in] td_mpp      mpp structure
@@ -1220,4 +1214,5 @@
 
       ! get or check depth value
+
       IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/dimension.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/dimension.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/dimension.f90	(revision 6808)
@@ -78,5 +78,5 @@
 !>
 !>    This subroutine filled dimension structure with unused dimension, 
-!>    then switch from "unordered" dimension to "ordered" dimension.<br/>
+!>    then switch from "disordered" 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 unordered
+!>    to switch dimension array from ordered dimension to disordered
 !> dimension:<br/>
 !> @code
-!>    CALL dim_unorder(tl_dim(:))
+!>    CALL dim_disorder(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 "unordered"
-!>
-!>    to reshape array of value in "unordered" dimension:<br/>
+!>       - value must be a 4D array of real(8) value "disordered"
+!>
+!>    to reshape array of value in "disordered" 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 "unordered".
+!>       - tab must be a 1D array with 4 elements "disordered".
 !>       It could be composed of character, integer(4), or logical
 !> 
-!>    to reorder a 1D array of 4 elements in "unordered" dimension:<br/>
-!> @code
-!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
+!>    to reorder a 1D array of 4 elements in "disordered" dimension:<br/>
+!> @code
+!>    CALL dim_reorder_xyzt2(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 unordered to ordered dimension
-   PUBLIC :: dim_unorder       !< switch dimension array from ordered to unordered dimension
+   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_fill_unused   !< filled dimension structure with unused dimension 
    PUBLIC :: dim_reshape_2xyzt !< reshape array dimension to ('x','y','z','t')
@@ -321,5 +321,6 @@
    !> @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
@@ -502,8 +503,14 @@
    !> Optionally length could be inform, as well as short name and if dimension
    !> is unlimited or not.<br/>
-   !> define dimension is supposed to be used.
-   !>
-   !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> 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
    !
    !> @param[in] cd_name   dimension name
@@ -511,7 +518,8 @@
    !> @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)
+   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use)
       IMPLICIT NONE
 
@@ -521,4 +529,5 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_uld
       CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_use
 
       ! local variable
@@ -543,5 +552,9 @@
 
       ! define dimension is supposed to be used
-      dim_init%l_use=.TRUE.
+      IF( PRESENT(ld_use) )THEN
+         dim_init%l_use=ld_use
+      ELSE
+         dim_init%l_use=.TRUE.
+      ENDIF
 
       IF( PRESENT(cd_sname) )THEN
@@ -590,6 +603,6 @@
       ENDIF
       
-      ! get dimension orderer index
-      dim_init%i_2xyzt=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname))
+      ! get dimension order indices
+      dim_init%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname))
 
    END FUNCTION dim_init
@@ -655,4 +668,6 @@
    !> @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
@@ -686,6 +701,6 @@
          ! search missing dimension
          IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN
-            ! search first empty dimension
-            il_ind(:)=MINLOC( tl_dim(:)%i_2xyzt, tl_dim(:)%i_2xyzt == 0 )
+            ! search first empty dimension (see dim_init)
+            il_ind(:)=MINLOC( tl_dim(:)%i_xyzt2, tl_dim(:)%i_xyzt2 == 0 )
 
             ! put missing dimension instead of empty one
@@ -693,5 +708,5 @@
             ! update output structure
             tl_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji))
-            tl_dim(il_ind(1))%i_2xyzt=ji
+            tl_dim(il_ind(1))%i_xyzt2=ji
             tl_dim(il_ind(1))%i_len=1
             tl_dim(il_ind(1))%l_use=.FALSE.
@@ -711,5 +726,5 @@
    !> This subroutine switch element of an array (4 elts) of dimension 
    !> structure 
-   !> from unordered dimension to ordered dimension <br/>
+   !> from disordered dimension to ordered dimension <br/>
    !>
    !> @details
@@ -722,5 +737,6 @@
    !> @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
@@ -811,5 +827,5 @@
    !-------------------------------------------------------------------
    !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t')
-   !> to unordered dimension. <br/>
+   !> to disordered dimension. <br/>
    !> @details
    !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/>
@@ -822,5 +838,5 @@
    !> @param[inout] td_dim array of dimension structure
    !-------------------------------------------------------------------
-   SUBROUTINE dim_unorder(td_dim)
+   SUBROUTINE dim_disorder(td_dim)
       IMPLICIT NONE
       ! Argument      
@@ -835,5 +851,5 @@
 
       IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
-         CALL logger_error("DIM UNORDER: invalid dimension of array dimension.")
+         CALL logger_error("DIM DISORDER: invalid dimension of array dimension.")
       ELSE      
          ! add dummy xyzt2 id to unused dimension
@@ -868,5 +884,5 @@
       ENDIF
 
-   END SUBROUTINE dim_unorder
+   END SUBROUTINE dim_disorder
    !-------------------------------------------------------------------
    !> @brief This function reshape real(8) 4D array   
@@ -908,5 +924,6 @@
 
       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      
 
@@ -914,6 +931,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
@@ -972,5 +989,5 @@
    !-------------------------------------------------------------------
    !> @brief This function reshape ordered real(8) 4D array with dimension 
-   !> (/'x','y','z','t'/) to an "unordered" array.<br/>
+   !> (/'x','y','z','t'/) to an "disordered" array.<br/>
    !> @details
    !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)
@@ -1009,5 +1026,6 @@
 
       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
 
@@ -1015,6 +1033,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        
@@ -1104,6 +1122,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        
@@ -1116,5 +1134,5 @@
    END FUNCTION dim__reorder_2xyzt_i4
    !-------------------------------------------------------------------
-   !> @brief This function unordered integer(4) 1D array to be suitable with
+   !> @brief This function disordered 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
@@ -1143,12 +1161,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        
@@ -1166,5 +1184,5 @@
    !
    !> @author J.Paul
-   !> @date Nov, 2013 - Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_dim array of dimension structure
@@ -1193,6 +1211,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        
@@ -1205,5 +1223,5 @@
    END FUNCTION dim__reorder_2xyzt_l
    !-------------------------------------------------------------------
-   !> @brief This function unordered logical 1D array to be suitable with
+   !> @brief This function disordered 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
@@ -1238,6 +1256,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        
@@ -1294,10 +1312,10 @@
    END FUNCTION dim__reorder_2xyzt_c
    !-------------------------------------------------------------------
-   !> @brief This function unordered string 1D array to be suitable with
+   !> @brief This function disordered 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 Nov, 2013 - Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_dim array of dimension structure
@@ -1326,6 +1344,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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md	(revision 6808)
@@ -13,6 +13,6 @@
 # Fortran Compiler
    SIREN codes were succesfully tested with :
-   - ifort (version 12.0.4)
-   - gfortran (version 4.7.2 20121109)
+   - ifort (version 15.0.1)
+   - gfortran (version 4.8.2 20140120) 
 <!--   - pgf95 (version 13.9-0) -->
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md	(revision 6808)
@@ -80,5 +80,5 @@
 
 # Implicit none {#implicit}
-All subroutines and functions will include an IMPLICTI NONE statement.
+All subroutines and functions will include an IMPLICIT NONE statement.
 
 # Header {#header}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/domain.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/domain.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/domain.f90	(revision 6808)
@@ -246,5 +246,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_dom dom structure
@@ -294,5 +294,5 @@
    !
    !> @author J.Paul
-   !> - June, 2013- Initial Version
+   !> @date June, 2013 - Initial Version
    !> @date September, 2014
    !> - add boundary index
@@ -362,6 +362,7 @@
 
          IF( td_mpp%i_perio < 0 .OR. td_mpp%i_perio > 6 )THEN
-            CALL logger_error("DOM INIT: invalid grid periodicity. "//&
-            &  "you should use grid_get_perio to compute it")
+            CALL logger_error("DOM INIT: invalid grid periodicity ("//&
+            &  TRIM(fct_str(td_mpp%i_perio))//&
+            &  ") you should use grid_get_perio to compute it")
          ELSE
             dom__init_mpp%i_perio0=td_mpp%i_perio
@@ -424,5 +425,5 @@
    !
    !> @author J.Paul
-   !> - June, 2013- Initial Version
+   !> @date June, 2013 - Initial Version
    !> @date September, 2014
    !> - add boundary index
@@ -489,6 +490,7 @@
 
          IF( td_file%i_perio < 0 .OR. td_file%i_perio > 6 )THEN
-            CALL logger_error("DOM INIT: invalid grid periodicity. "//&
-            &  "you should use grid_get_perio to compute it")
+            CALL logger_error("DOM INIT: invalid grid periodicity ("//&
+            &  TRIM(fct_str(td_file%i_perio))//&
+            &  ") you should use grid_get_perio to compute it")
          ELSE
             dom__init_file%i_perio0=td_file%i_perio
@@ -548,5 +550,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain structure
@@ -653,5 +655,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !> @date September, 2014
    !> - use zero indice to defined cyclic or global domain
@@ -721,5 +723,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial verison
    !
    !> @param[inout] td_dom domain strcuture
@@ -755,5 +757,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -774,5 +776,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -806,5 +808,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -824,5 +826,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -862,5 +864,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -912,5 +914,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -951,5 +953,5 @@
    !>
    !> @author J.Paul
-   !> - April, 2013- Subroutine written
+   !> @date April, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -979,5 +981,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -1041,5 +1043,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -1082,5 +1084,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -1180,5 +1182,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -1292,5 +1294,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !> @date September, 2014
    !> - take into account number of ghost cell
@@ -1433,5 +1435,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -1476,5 +1478,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !> @date September, 2014
    !> - take into account boundary for one point size domain
@@ -1715,5 +1717,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/extrap.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/extrap.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/extrap.f90	(revision 6808)
@@ -19,30 +19,19 @@
 !>    defining string character _cn\_varinfo_. By default _dist_weight_.<br/>
 !>    Example:
-!>       - cn_varinfo='varname1:dist_weight', 'varname2:min_error'
+!>       - cn_varinfo='varname1:ext=dist_weight', 'varname2:ext=min_error'
 !>
 !>    to detect point to be extrapolated:<br/>
 !> @code
-!>    il_detect(:,:,:)=extrap_detect(td_var, [td_level], [id_offset,] [id_rho,] [id_ext]) 
+!>    il_detect(:,:,:)=extrap_detect(td_var)
 !> @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, [td_level], [id_offset], [id_rho], [id_iext], [id_jext], [id_kext], [id_radius], [id_maxiter])
+!>    CALL extrap_fill_value( td_var, [id_radius])
 !> @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/>
@@ -62,30 +51,4 @@
 !>       - 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())
 !>
@@ -93,10 +56,17 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date Nov, 2013 - Initial Version
+!> @date November, 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)
@@ -110,4 +80,5 @@
    USE date                            ! date manager
    USE logger                          ! log file manager
+   USE math                            ! mathematical function
    USE att                             ! attribute manager
    USE dim                             ! dimension manager
@@ -118,5 +89,4 @@
 
    ! 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
@@ -127,7 +97,4 @@
    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
@@ -141,5 +108,4 @@
    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
@@ -171,22 +137,15 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - do not use level to select points to be extrapolated
    !
    !> @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, td_level1, &
-   &                        id_offset, id_rho, id_ext )
+   FUNCTION extrap__detect( td_var0 ) 
       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
@@ -196,180 +155,12 @@
 
       ! 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
       !----------------------------------------------------------------
 
-      ! 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 )
+      ! force to extrapolated all points
+      extrap__detect(:,:,:)=1
 
       ! do not compute grid point already inform
@@ -377,17 +168,10 @@
          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)=0
+               IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill )THEN
+                  extrap__detect(ji0,jj0,jk0)=0
+               ENDIF
             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
@@ -398,23 +182,16 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - select all land points for extrapolation
    !>
    !> @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, td_level, &
-   &                                id_offset, id_rho, id_ext )
+   FUNCTION extrap__detect_wrapper( td_var )
 
       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
@@ -439,8 +216,5 @@
          &              " for variable "//TRIM(td_var%c_name) )
          
-         extrap__detect_wrapper(:,:,:)=extrap__detect( td_var, td_level, &
-         &                                             id_offset, &
-         &                                             id_rho,    &
-         &                                             id_ext     )
+         extrap__detect_wrapper(:,:,:)=extrap__detect( td_var )
 
       ELSE IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
@@ -450,8 +224,5 @@
          &              " for variable "//TRIM(td_var%c_name) )
          
-         extrap__detect_wrapper(:,:,1:1)=extrap__detect( td_var , td_level,&
-         &                                               id_offset, &
-         &                                               id_rho,    &
-         &                                               id_ext     )
+         extrap__detect_wrapper(:,:,1:1)=extrap__detect( td_var )
 
       ELSE IF( td_var%t_dim(3)%l_use )THEN
@@ -461,8 +232,5 @@
          &              " for variable "//TRIM(td_var%c_name) )
          
-         extrap__detect_wrapper(1:1,1:1,:)=extrap__detect( td_var , td_level, &
-         &                                                 id_offset, &
-         &                                                 id_rho,    &
-         &                                                 id_ext     )
+         extrap__detect_wrapper(1:1,1:1,:)=extrap__detect( td_var )
 
       ENDIF              
@@ -489,39 +257,20 @@
    !>
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - select all land points for extrapolation
    !
    !> @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 
-   !> @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 )
+   !-------------------------------------------------------------------
+   SUBROUTINE extrap__fill_value_wrapper( td_var, & 
+   &                                      id_radius )
       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
@@ -544,66 +293,18 @@
          END SELECT
 
-         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
+         ! 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
 
-         IF( il_iext < 0 )THEN
-            CALL logger_error("EXTRAP FILL VALUE: invalid "//&
-            &  " number of points to be extrapolated in i-direction "//&
-            &  "("//TRIM(fct_str(il_iext))//")")
-         ENDIF
-
-         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
+         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 )
  
       ENDIF
@@ -621,35 +322,19 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - select all land points for extrapolation
    !
    !> @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_iext, id_jext, id_kext, &
-   &                              id_radius, id_maxiter, &
-   &                              td_level,          &
-   &                              id_offset,         &
-   &                              id_rho )
+   &                              id_radius )
       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
@@ -668,8 +353,6 @@
       &                    td_var%t_dim(3)%i_len) )
 
-      il_detect(:,:,:) = extrap_detect( td_var, td_level, &
-      &                                 id_offset,        &
-      &                                 id_rho,           &
-      &                                 id_ext=(/id_iext, id_jext, id_kext/) )
+      il_detect(:,:,:) = extrap_detect( td_var )
+
       !2- add attribute to variable
       cl_extrap=fct_concat(td_var%c_extrap(:))
@@ -679,12 +362,21 @@
       CALL att_clean(tl_att)
 
-      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  )
+      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
 
       DEALLOCATE(il_detect)
@@ -705,5 +397,8 @@
    !>
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @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
    !
    !> @param[inout] dd_value  3D array of variable to be extrapolated
@@ -714,26 +409,31 @@
    !-------------------------------------------------------------------
    SUBROUTINE extrap__3D( dd_value, dd_fill, id_detect,&
-   &                      cd_method, id_radius, id_maxiter )
+   &                      cd_method, id_radius )
       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
-      INTEGER(i4),                   INTENT(IN   ) :: id_maxiter
+      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
 
       ! 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), 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)                                :: 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), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
@@ -743,4 +443,6 @@
       REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dfdz
       REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_coef
+
+      LOGICAL                                    :: ll_iter
 
       ! loop indices
@@ -765,5 +467,6 @@
             DO WHILE( ANY(il_detect(:,:,:)==1) )
                ! change extend value to minimize number of iteration
-               il_radius=id_radius+(il_iter/id_maxiter)
+               il_radius=id_radius+(il_iter-1)
+               ll_iter=.TRUE.
 
                ALLOCATE( dl_dfdx(il_shape(1), il_shape(2), il_shape(3)) ) 
@@ -774,5 +477,6 @@
                dl_dfdx(:,:,:)=dd_fill
                IF( il_shape(1) > 1 )THEN
-                  dl_dfdx(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'I' )
+                  dl_dfdx(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
+                     &                          dd_fill, 'I' )
                ENDIF
 
@@ -780,5 +484,6 @@
                dl_dfdy(:,:,:)=dd_fill
                IF( il_shape(2) > 1 )THEN
-                  dl_dfdy(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'J' )
+                  dl_dfdy(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
+                     &                          dd_fill, 'J' )
                ENDIF
  
@@ -786,5 +491,6 @@
                dl_dfdz(:,:,:)=dd_fill
                IF( il_shape(3) > 1 )THEN
-                  dl_dfdz(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'K' )
+                  dl_dfdz(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
+                     &                          dd_fill, 'K' )
                ENDIF
  
@@ -804,4 +510,5 @@
 
                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)
@@ -813,21 +520,40 @@
                            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
-                           ENDIF
+                              ! 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
 
@@ -845,8 +571,85 @@
                            &            il_jmin:il_jmax, &
                            &            il_kmin:il_kmax ), &
-                           &  dl_coef(:,:,:) )
+                           &  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
+
+                        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
 
@@ -862,5 +665,5 @@
                DEALLOCATE( dl_coef )
 
-               il_iter=il_iter+1
+               IF( ll_iter ) il_iter=il_iter+1
             ENDDO
          ENDDO
@@ -875,5 +678,6 @@
             DO WHILE( ANY(il_detect(:,:,:)==1) )
                ! change extend value to minimize number of iteration
-               il_radius=id_radius+(il_iter/id_maxiter)
+               il_radius=id_radius+(il_iter-1)
+               ll_iter=.TRUE.
 
                il_dim(1)=2*il_radius+1
@@ -886,10 +690,11 @@
                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)
@@ -901,21 +706,39 @@
                            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
 
@@ -925,8 +748,76 @@
                            &            il_kmin:il_kmax, &
                            &            jl), dd_fill, il_radius, &
-                           &  dl_coef(:,:,:) )
+                           &  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
+
+                        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
 
@@ -936,7 +827,10 @@
                   ENDDO
                ENDDO
-
+               CALL logger_info(" EXTRAP 3D: "//&
+               &              TRIM(fct_str(SUM(il_detect(:,:,:))))//&
+               &              " point(s) to extrapolate " )
+            
                DEALLOCATE( dl_coef )
-               il_iter=il_iter+1
+               IF( ll_iter ) il_iter=il_iter+1
             ENDDO
          ENDDO            
@@ -946,546 +840,4 @@
 
    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
@@ -1493,9 +845,11 @@
    !> 
    !> @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
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - decrease weight of third dimension
    !
    !> @param[in] dd_value  3D array of variable to be extrapolated
@@ -1544,7 +898,8 @@
 
                ! compute distance
+               ! "vertical weight" is lower than horizontal 
                dl_dist(ji,jj,jk) = (ji-il_imid)**2 + &
                &                   (jj-il_jmid)**2 + &
-               &                   (jk-il_kmid)**2
+               &                 3*(jk-il_kmid)**2
 
                IF( dl_dist(ji,jj,jk) /= 0 )THEN
@@ -1569,5 +924,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] dd_value  3D array of variable to be extrapolated
@@ -1658,5 +1013,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - decrease weight of third dimension
    !
    !> @param[in] dd_value  3D array of variable to be extrapolated
@@ -1705,7 +1062,8 @@
 
                ! compute distance
+               ! "vertical weight" is lower than horizontal 
                dl_dist(ji,jj,jk) = (ji-il_imid)**2 + &
                &                   (jj-il_jmid)**2 + &
-               &                   (jk-il_kmid)**2
+               &                 3*(jk-il_kmid)**2
 
                IF( dl_dist(ji,jj,jk) /= 0 )THEN
@@ -1732,5 +1090,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_value  3D array of variable to be extrapolated
@@ -1763,5 +1121,4 @@
       INTEGER(i4) :: jj
       INTEGER(i4) :: jk
-
       !----------------------------------------------------------------
 
@@ -1793,4 +1150,5 @@
             ENDDO
          ENDDO
+
 
          ! return value
@@ -1815,5 +1173,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013-Initial version
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_var variable 
@@ -1917,5 +1275,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013-Initial version
+   !> @date November, 2013 - Initial version
    !>
    !> @param[inout] td_var variable 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/file.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/file.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/file.f90	(revision 6808)
@@ -137,6 +137,7 @@
 !> 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)
@@ -288,7 +289,7 @@
    !>   
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @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)
    !
@@ -409,7 +410,7 @@
    !>   
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @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)
    !
@@ -448,5 +449,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_file   file name
@@ -553,5 +554,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_file   file name
@@ -589,5 +590,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -604,6 +605,7 @@
       CHARACTER(LEN=lc) :: cl_dim
       LOGICAL           :: ll_error
-
-      INTEGER(i4) :: il_ind
+      LOGICAL           :: ll_warn 
+
+      INTEGER(i4)       :: il_ind
 
       ! loop indices
@@ -614,4 +616,5 @@
       ! check used dimension 
       ll_error=.FALSE.
+      ll_warn=.FALSE.
       DO ji=1,ip_maxdim
          il_ind=dim_get_index( td_file%t_dim(:), &
@@ -619,21 +622,18 @@
          &                     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
-            ll_error=.TRUE.
-         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
+               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
          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,4 +659,17 @@
          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
 
@@ -679,5 +692,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - add dimension to file if need be
@@ -707,7 +720,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
@@ -723,5 +736,6 @@
                &                                       td_var%c_stdname )
             ENDIF
-
+            CALL logger_debug( &
+            &  " FILE ADD VAR: ind "//TRIM(fct_str(il_ind)) )
             IF( il_ind /= 0 )THEN
 
@@ -739,5 +753,5 @@
             ELSE
 
-               CALL logger_trace( &
+               CALL logger_debug( &
                &  " FILE ADD VAR: add variable "//TRIM(td_var%c_name)//&
                &  ", standard name "//TRIM(td_var%c_stdname)//&
@@ -770,6 +784,4 @@
                         !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
@@ -806,5 +818,5 @@
                         ENDIF
 
-                        IF( il_ind < td_file%i_nvar )THEN
+                        IF( il_ind < td_file%i_nvar+1 )THEN
                            ! variable with more dimension than new variable
                            td_file%t_var( il_ind+1 : td_file%i_nvar+1 ) = &
@@ -893,5 +905,7 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - define local variable structure to avoid mistake with pointer
    !
    !> @param[inout] td_file   file structure
@@ -907,4 +921,5 @@
       ! local variable
       INTEGER(i4)       :: il_ind
+      TYPE(TVAR)        :: tl_var
       !----------------------------------------------------------------
 
@@ -928,9 +943,10 @@
             IF( il_ind /= 0 )THEN
    
-               CALL file_del_var(td_file, td_file%t_var(il_ind))
+               tl_var=var_copy(td_file%t_var(il_ind))
+               CALL file_del_var(td_file, tl_var)
 
             ELSE
 
-               CALL logger_warn( &
+               CALL logger_debug( &
                &  " FILE DEL VAR NAME: there is no variable with name or "//&
                &  "standard name "//TRIM(cd_name)//" in file "//&
@@ -953,5 +969,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_file   file structure
@@ -1096,5 +1112,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1131,5 +1147,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1247,5 +1263,8 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - define local attribute structure to avoid mistake
+   !> with pointer
    !
    !> @param[inout] td_file   file structure
@@ -1261,4 +1280,5 @@
       ! local variable
       INTEGER(i4)       :: il_ind
+      TYPE(TATT)        :: tl_att
       !----------------------------------------------------------------
 
@@ -1282,9 +1302,10 @@
             IF( il_ind /= 0 )THEN
    
-               CALL file_del_att(td_file, td_file%t_att(il_ind))
+               tl_att=att_copy(td_file%t_att(il_ind))
+               CALL file_del_att(td_file, tl_att)
 
             ELSE
 
-               CALL logger_warn( &
+               CALL logger_debug( &
                &  " FILE DEL ATT NAME: there is no attribute with name "//&
                &  TRIM(cd_name)//" in file "//TRIM(td_file%c_name))
@@ -1305,5 +1326,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1403,5 +1424,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1444,5 +1465,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - do not reorder dimension, before put in file
@@ -1529,5 +1550,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1609,5 +1630,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1652,5 +1673,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1717,5 +1738,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
@@ -1730,5 +1751,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_file   file structure
@@ -1769,5 +1790,10 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @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)
    !
    !> @param[in] cd_file   file name (without suffix)
@@ -1803,4 +1829,10 @@
          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
@@ -1816,5 +1848,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1879,5 +1911,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1906,5 +1938,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -2019,5 +2051,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   array of file structure
@@ -2057,5 +2089,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[in] td_file   array of file 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/filter.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/filter.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/filter.f90	(revision 6808)
@@ -18,5 +18,6 @@
 !>          - 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'
@@ -29,7 +30,10 @@
 !>
 !>    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_,
@@ -40,5 +44,6 @@
 !>    The number of turn is specify using '*' separator.<br/>
 !>    Example:
-!>       - cn_varinfo='varname1:2*hamming(@f$cutoff@f$,@f$radius@f$)', 'varname2:gauss(@f$cutoff@f$,@f$radius@f$,@f$\alpha@f$)'
+!>       - cn_varinfo='varname1:flt=2*hamming(@f$cutoff@f$,@f$radius@f$)', 
+!>                    'varname2:flt=gauss(@f$cutoff@f$,@f$radius@f$,@f$\alpha@f$)'
 !>
 !>    to filter variable value:<br/>
@@ -106,5 +111,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure 
@@ -250,5 +255,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable 
@@ -296,5 +301,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
@@ -341,5 +346,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -393,5 +398,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -439,5 +444,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -482,5 +487,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -537,5 +542,5 @@
    !>
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -590,5 +595,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_name   filter name
@@ -649,5 +654,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_name   filter name
@@ -695,5 +700,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -749,5 +754,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -808,5 +813,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -863,5 +868,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -922,5 +927,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -978,5 +983,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
@@ -1038,5 +1043,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
@@ -1090,5 +1095,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
@@ -1146,5 +1151,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
@@ -1198,5 +1203,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/function.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/function.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/function.f90	(revision 6808)
@@ -51,4 +51,9 @@
 !> @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
@@ -89,5 +94,6 @@
 ! 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)
@@ -106,4 +112,5 @@
    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)
@@ -153,5 +160,5 @@
    ! 
    !> @author J.Paul 
-   !> - September, 2014- Initial Version 
+   !> @date September, 2014 - Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -177,5 +184,5 @@
    ! 
    !> @author J.Paul 
-   !> - September, 2014- Initial Version 
+   !> @date September, 2014 - Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -201,5 +208,5 @@
    ! 
    !> @author J.Paul 
-   !> - Nov, 2013- Initial Version 
+   !> @date November, 2013 - Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -225,5 +232,5 @@
    ! 
    !> @author J.Paul 
-   !> - November, 2013- Initial Version 
+   !> @date November, 2013 - Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -249,5 +256,5 @@
    ! 
    !> @author J.Paul 
-   !> - November, 2013- Initial Version 
+   !> @date November, 2013 - Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -273,5 +280,5 @@
    !>
    !> @author J.Paul 
-   !> - November, 2013- Initial Version 
+   !> @date November, 2013 - Initial Version 
    !>
    !> @param[in] cd_char   string character
@@ -297,5 +304,5 @@
    !>
    !> @author J.Paul 
-   !> - November, 2013- Initial Version 
+   !> @date November, 2013 - Initial Version 
    !>
    !> @param[in] cd_char   string character
@@ -321,5 +328,5 @@
    !>
    !> @author J.Paul 
-   !> - November, 2013- Initial Version 
+   !> @date November, 2013 - Initial Version 
    !>
    !> @return file id 
@@ -344,5 +351,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] id_status
@@ -365,5 +372,5 @@
    !
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !>
    !> @param[in] cd_msg optional message to be added
@@ -387,5 +394,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] ld_var logical variable
@@ -409,5 +416,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] bd_var integer(1) variable
@@ -431,5 +438,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] sd_var integer(2) variable
@@ -453,5 +460,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] id_var integer(4) variable
@@ -475,5 +482,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] kd_var integer(8) variable
@@ -497,5 +504,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] rd_var real(4) variable
@@ -519,5 +526,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_var real(8) variable
@@ -544,5 +551,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_arr array of character
@@ -590,5 +597,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_var character
@@ -647,5 +654,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_var character
@@ -697,5 +704,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_var character
@@ -723,4 +730,67 @@
    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 '|',
@@ -728,5 +798,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_string string of character
@@ -808,5 +878,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_string string of character
@@ -873,5 +943,5 @@
    !> Optionally you could specify another separator.
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_string filename
@@ -914,5 +984,5 @@
    !> Optionally you could specify another separator.
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_string filename
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/grid.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/grid.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/grid.f90	(revision 6808)
@@ -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 (default 1)
+!>       - id_rho    is array of refinement factor 
 !>
 !>    to add ghost cell at boundaries:<br/>
@@ -213,4 +213,6 @@
 !> @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)
@@ -255,4 +257,5 @@
    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
@@ -352,5 +355,5 @@
    !> @note need all processor files to be there
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @param[inout] td_file file structure 
@@ -466,7 +469,7 @@
    !> - compute East West overlap
    !>
-   !> @note need all processor files to be there
+   !> @note need all processor files
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @param[in] td_mpp mpp structure 
@@ -496,4 +499,5 @@
       il_ew   =-1
 
+      CALL logger_info("GRID GET INFO: look for "//TRIM(td_mpp%c_name))
       ! copy structure
       tl_mpp=mpp_copy(td_mpp)
@@ -523,9 +527,11 @@
       ENDIF
 
+      CALL logger_info("GRID GET INFO: perio "//TRIM(fct_str(il_perio)))
+
       SELECT CASE(il_perio)
       CASE(3,4)
+         il_pivot=1
+      CASE(5,6)
          il_pivot=0
-      CASE(5,6)
-         il_pivot=1
       CASE(0,1,2)
          il_pivot=1
@@ -534,4 +540,5 @@
       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
@@ -539,4 +546,5 @@
       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
@@ -544,4 +552,5 @@
       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
@@ -595,5 +604,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !> @date September, 2014
    !> - add dummy loop in case variable not over right point.
@@ -708,5 +717,5 @@
    !> 
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -783,5 +792,5 @@
 
          IF( ll_check )THEN
-            CALL logger_info("GRID GET PIVOT: T-pivot")
+            CALL logger_info("GRID GET PIVOT: F-pivot")
             grid__get_pivot_varT=0
          ENDIF
@@ -801,5 +810,5 @@
    !> 
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -876,5 +885,5 @@
 
          IF( ll_check )THEN
-            CALL logger_info("GRID GET PIVOT: T-pivot")
+            CALL logger_info("GRID GET PIVOT: F-pivot")
             grid__get_pivot_varU=0
          ENDIF
@@ -894,5 +903,5 @@
    !> 
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -969,5 +978,5 @@
 
          IF( ll_check )THEN
-            CALL logger_info("GRID GET PIVOT: T-pivot")
+            CALL logger_info("GRID GET PIVOT: F-pivot")
             grid__get_pivot_varV=0
          ENDIF
@@ -987,5 +996,5 @@
    !> 
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -1062,5 +1071,5 @@
 
          IF( ll_check )THEN
-            CALL logger_info("GRID GET PIVOT: T-pivot")
+            CALL logger_info("GRID GET PIVOT: F-pivot")
             grid__get_pivot_varF=0
          ENDIF
@@ -1083,5 +1092,5 @@
    !>
    !> @author J.Paul
-   !> - Ocotber, 2014- Initial version
+   !> @date Ocotber, 2014 - Initial version
    !
    !> @param[in] td_file file structure
@@ -1172,5 +1181,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] td_mpp   mpp file structure
@@ -1277,13 +1286,13 @@
    !> 1: cyclic east-west boundary
    !> 2: symmetric boundary condition across the equator
-   !> 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
+   !> 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
    !>
    !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !> @date October, 2014
    !> - work on variable structure instead of file structure
@@ -1452,5 +1461,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !>
    !> @param[in] td_file   file structure
@@ -1537,13 +1546,13 @@
    !> 1: cyclic east-west boundary
    !> 2: symmetric boundary condition across the equator
-   !> 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
+   !> 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
    !>
    !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
    !>
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] td_mpp   mpp file structure
@@ -1634,5 +1643,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -1746,5 +1755,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @param[in] td_file file structure 
@@ -1797,5 +1806,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -1853,5 +1862,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_lat latitude variable structure 
@@ -1890,5 +1899,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -1978,9 +1987,12 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date 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
@@ -2004,24 +2016,25 @@
 
       ! local variable
-      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
+      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
 
       ! loop indices
@@ -2057,6 +2070,21 @@
          ! 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))
          
@@ -2077,6 +2105,21 @@
          ! 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))
  
@@ -2127,9 +2170,12 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date 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
@@ -2154,15 +2200,17 @@
 
       ! local variable
-      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
+      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
 
       ! loop indices
@@ -2209,6 +2257,21 @@
          ! 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))
          
@@ -2244,9 +2307,12 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date 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
@@ -2271,20 +2337,21 @@
 
       ! local variable
-      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      
+      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
 
       ! loop indices
@@ -2330,6 +2397,21 @@
          ! 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))
 
@@ -2377,5 +2459,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - check grid point
@@ -2520,5 +2602,5 @@
             CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
             CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
-            
+ 
             ! "global" coarse grid indice
             il_imin0=1
@@ -2568,4 +2650,10 @@
             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 "//&
@@ -2632,5 +2720,4 @@
             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
@@ -2647,5 +2734,4 @@
                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
@@ -2798,5 +2884,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_lon longitude structure 
@@ -2866,5 +2952,6 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 - change dichotomy method to manage ORCA grid
    !
    !> @param[in] dd_lon0   coarse grid array of longitude
@@ -2872,8 +2959,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  )
+   !-------------------------------------------------------------------
+   FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, dd_fill )
       IMPLICIT NONE
       ! Argument
@@ -2882,4 +2969,5 @@
       REAL(dp),                 INTENT(IN) :: dd_lon1
       REAL(dp),                 INTENT(IN) :: dd_lat1
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
 
       ! function
@@ -2929,46 +3017,71 @@
 
       ll_north=.FALSE.
-      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
+      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
 
          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) 
+      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_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
-         IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE.
+         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)
+
+         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_isup,il_jinf:il_jsup) >  dl_lon1 ) .AND. &
+            &   il_imid /= il_isup )THEN
+               ! 0 < lon1 < lon0(isup)
+               ! 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
+               ! 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
 
@@ -2976,4 +3089,5 @@
       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
@@ -2982,28 +3096,30 @@
             il_jinf = il_jmid ;  il_jsup = il_jmid
 
-            ll_continue=.FALSE.
-
          ELSE
-            IF( dl_lon1 > dl_lon0(il_imid,il_jmid) )THEN
+            IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) <  dl_lon1) )THEN    
 
                ! point east
                il_iinf = il_imid
+               ll_continue=.TRUE.
         
-            ELSE IF(dl_lon1 < dl_lon0(il_imid,il_jmid) )THEN
+            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( dd_lat1 > dd_lat0(il_imid,il_jmid) )THEN
+            IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) <  dd_lat1) )THEN    
                
                ! point north
                il_jinf = il_jmid
-
-            ELSE IF(dd_lat1 < dd_lat0(il_imid,il_jmid) )THEN
+               ll_continue=.TRUE.
+
+            ELSE IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) > dd_lat1) )THEN    
 
                ! point south
                il_jsup = il_jmid
+               ll_continue=.TRUE.
             
             ENDIF
@@ -3014,7 +3130,4 @@
             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
@@ -3049,5 +3162,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_lon    grid longitude array
@@ -3055,7 +3168,8 @@
    !> @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      
@@ -3110,9 +3224,10 @@
          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
@@ -3136,5 +3251,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -3170,16 +3285,17 @@
 
       ! local variable
-      INTEGER(i4) :: il_imin0
-      INTEGER(i4) :: il_jmin0
-      INTEGER(i4) :: il_imax0
-      INTEGER(i4) :: il_jmax0
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
       
-      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
@@ -3188,11 +3304,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
@@ -3227,6 +3343,21 @@
          ! 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))
          
@@ -3267,6 +3398,21 @@
          ! 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))
  
@@ -3318,5 +3464,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -3354,18 +3500,18 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
+      INTEGER(i4)                              :: il_ind
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
       
-      INTEGER(i4), DIMENSION(2,2)         :: il_xghost1
-
-      CHARACTER(LEN= 1) :: cl_point
-      CHARACTER(LEN=lc) :: cl_name
+      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
       !----------------------------------------------------------------
@@ -3397,6 +3543,21 @@
          ! 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))
  
@@ -3446,5 +3607,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -3483,23 +3644,24 @@
 
       ! local variable
-      INTEGER(i4) :: il_imin0
-      INTEGER(i4) :: il_jmin0
-      INTEGER(i4) :: il_imax0
-      INTEGER(i4) :: il_jmax0
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
       
-      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
       !----------------------------------------------------------------
@@ -3530,6 +3692,21 @@
          ! 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))
          
@@ -3585,7 +3762,10 @@
    !
    !> @author J.Paul
-   !> - November, 2013 - Initial Version
-   !> @date September, 2014 - rename from grid_get_fine_offset
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - rename from grid_get_fine_offset
+   !> @date May, 2015 
+   !> - improve way to find offset
+   !>
    !> @param[in] dd_lon0   coarse grid longitude array 
    !> @param[in] dd_lat0   coarse grid latitude  array
@@ -3620,8 +3800,12 @@
 
       ! 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
@@ -3657,11 +3841,14 @@
       grid__get_fine_offset_cc(:,:)=-1
 
-      IF( il_shape1(1) > 1 )THEN
-
-         ! look for i-direction left offset 
+      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( 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(1,1)=(id_rho(jp_I)+1)-ji
+                  grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ji
                   EXIT
                ENDIF
@@ -3671,11 +3858,10 @@
             &                 " not match fine grid lower left corner.")
          ENDIF
-
          ! look for i-direction right offset
-         IF( dl_lon1(il_shape1(1),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN
+         IF( dl_lon1(il_shape1(jp_I),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN
             DO ji=1,id_rho(jp_I)+2
-               ii=il_shape1(1)-ji+1
+               ii=il_shape1(jp_I)-ji+1
                IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) + dp_delta )THEN
-                  grid__get_fine_offset_cc(1,2)=(id_rho(jp_I)+1)-ji
+                  grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ji
                   EXIT
                ENDIF
@@ -3686,9 +3872,9 @@
          ENDIF
 
-      ELSE
-         grid__get_fine_offset_cc(1,:)=((id_rho(jp_I)-1)/2)
-      ENDIF
-
-      IF( il_shape1(2) > 1 )THEN
+      ELSEIF( il_shape1(jp_I) == 1 )THEN
+         
+         grid__get_fine_offset_cc(jp_I,:)=((id_rho(jp_I)-1)/2)
+         
+         ! work on j-direction
 
          ! look for j-direction lower offset 
@@ -3696,5 +3882,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(2,1)=(id_rho(jp_J)+1)-jj
+                  grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-jj
                   EXIT
                ENDIF
@@ -3706,9 +3892,9 @@
 
          ! look for j-direction upper offset 
-         IF( dd_lat1(1,il_shape1(2)) > dd_lat0(id_imin0,id_jmax0-1) )THEN
+         IF( dd_lat1(1,il_shape1(jp_J)) > dd_lat0(id_imin0,id_jmax0-1) )THEN
             DO jj=1,id_rho(jp_J)+2
-               ij=il_shape1(2)-jj+1
+               ij=il_shape1(jp_J)-jj+1
                IF( dd_lat1(1,ij) < dd_lat0(id_imin0,id_jmax0-1) + dp_delta )THEN
-                  grid__get_fine_offset_cc(2,2)=(id_rho(jp_J)+1)-jj
+                  grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-jj
                   EXIT
                ENDIF
@@ -3717,7 +3903,81 @@
             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         
+
+      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
+
       ENDIF
 
@@ -3732,5 +3992,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013- Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -3742,5 +4002,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 (default 1) 
+   !> @param[in] id_rho    array of refinement factor 
    !-------------------------------------------------------------------
    SUBROUTINE grid_check_coincidence( td_coord0, td_coord1, &
@@ -4042,5 +4302,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_lon0   array of coarse grid longitude
@@ -4103,5 +4363,4 @@
       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. & 
@@ -4202,5 +4461,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_lat0   array of coarse grid latitude 
@@ -4272,5 +4531,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013-Initial version
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_var array of variable structure 
@@ -4348,5 +4607,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013-Initial version
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_var array of variable structure 
@@ -4374,6 +4633,8 @@
       IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
 
-         CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//&
-         &              TRIM(td_var%c_name) )
+         IF( ANY(id_ghost(:,:)/=0) )THEN
+            CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//&
+            &              TRIM(td_var%c_name) )
+         ENDIF
 
          ! copy variable
@@ -4425,5 +4686,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[in] td_var variable sturcture 
@@ -4555,5 +4816,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014 - Initial Version
+   !> @date September, 2014 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -4592,4 +4853,5 @@
           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
@@ -4627,5 +4889,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var    variable strucutre 
@@ -4694,4 +4956,5 @@
                         il_tmp(jim:jip,jjm:jjp)=1
                      END WHERE
+
                   ENDIF
                ENDDO
@@ -4720,10 +4983,10 @@
    !>
    !> @details
-   !> the minimum size (nbumber of point) of closed sea to be kept could be
+   !> the minimum size (number 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
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var    variable structure
@@ -4782,4 +5045,101 @@
 
    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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp.f90	(revision 6808)
@@ -27,5 +27,5 @@
 !>    defining string character _cn\_varinfo_.<br/>
 !>    Example:
-!>       - cn_varinfo='varname1:cubic/rhoi', 'varname2:linear' 
+!>       - cn_varinfo='varname1:int=cubic/rhoi', 'varname2:int=linear' 
 !>
 !>    to create mixed grid (with coarse grid point needed to compute
@@ -137,5 +137,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_method interpolation method
@@ -179,5 +179,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_mix mixed grid variable (to interpolate)
@@ -244,5 +244,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_mix mixed grid variable (to interpolate)
@@ -363,5 +363,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_var    coarse grid variable (should be extrapolated)
@@ -449,5 +449,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_mix mixed grid variable
@@ -610,5 +610,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - use offset to save useful domain
@@ -716,5 +716,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -828,5 +828,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - use interpolation method modules
@@ -947,4 +947,5 @@
 
       DEALLOCATE(il_detect)
+
       !4- save useful domain (remove offset)
       CALL interp_clean_mixed_grid( tl_mix, td_var, &
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90	(revision 6808)
@@ -26,4 +26,6 @@
 ! REVISION HISTORY:
 !> @date September, 2014 -Initial version
+!> @date June, 2015
+!> - use math module
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -36,5 +38,5 @@
    USE logger                          ! log file manager
    USE fct                             ! basic useful function
-   USE extrap                          ! extrapolation manager
+   USE math                            ! mathematical function
 
    IMPLICIT NONE
@@ -61,5 +63,7 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
+   !> @date July, 2015 
+   !> - reinitialise detect array for each level
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -82,11 +86,13 @@
 
       ! local variable
-      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
+      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
       
       ! loop indices
@@ -113,5 +119,8 @@
       &                               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)
@@ -119,17 +128,17 @@
             ! I-J plan
             CALL interp_cubic__2D(dd_value(:,:,jk,jl), dd_fill, &
-            &                     id_detect(:,:,jk),            &
+            &                     il_detect(:,:,jk),            &
             &                     dl_weight_IJ(:,:),            &
             &                     id_rho(jp_I), id_rho(jp_J),   &
             &                     ll_discont)            
-            IF( ANY(id_detect(:,:,jk)==1) )THEN
+            IF( ANY(il_detect(:,:,jk)==1) )THEN
                ! I direction
                DO jj=1,il_shape(2)
                   CALL interp_cubic__1D( dd_value(:,jj,jk,jl), dd_fill, &
-                  &                      id_detect(:,jj,jk),            &
+                  &                      il_detect(:,jj,jk),            &
                   &                      dl_weight_I(:,:),              &
                   &                      id_rho(jp_I), ll_discont )
                ENDDO
-               IF( ALL(id_detect(:,:,jk)==0) )THEN
+               IF( ALL(il_detect(:,:,jk)==0) )THEN
                   CYCLE
                ELSE
@@ -137,5 +146,5 @@
                   DO ji=1,il_shape(1)
                      CALL interp_cubic__1D( dd_value(ji,:,jk,jl), dd_fill, &
-                     &                      id_detect(ji,:,jk),            &
+                     &                      il_detect(ji,:,jk),            &
                      &                      dl_weight_J(:,:),              &
                      &                      id_rho(jp_J), ll_discont )
@@ -147,4 +156,7 @@
       ENDDO
 
+      id_detect(:,:,:)=il_detect(:,:,:)
+      DEALLOCATE(il_detect)
+
       DEALLOCATE(dl_weight_IJ)
       DEALLOCATE(dl_weight_I)
@@ -159,5 +171,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -181,5 +193,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
@@ -230,9 +242,9 @@
 
          ! compute derivative on coarse grid
-         dl_dfdx(:,:)=extrap_deriv_2D(dl_coarse(:,:), dd_fill, 'I', ld_discont)
-         dl_dfdy(:,:)=extrap_deriv_2D(dl_coarse(:,:), dd_fill, 'J', ld_discont)
+         dl_dfdx(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'I', ld_discont)
+         dl_dfdy(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'J', ld_discont)
 
          ! compute cross derivative on coarse grid
-         dl_d2fdxy(:,:)=extrap_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont)
+         dl_d2fdxy(:,:)=math_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont)
 
          ALLOCATE( dl_tmp(2,2) )
@@ -319,5 +331,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  1D array of variable value 
@@ -339,5 +351,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
@@ -376,5 +388,5 @@
 
          ! compute derivative on coarse grid
-         dl_dfdx(:)=extrap_deriv_1D(dl_coarse(:), dd_fill, ld_discont)
+         dl_dfdx(:)=math_deriv_1D(dl_coarse(:), dd_fill, ld_discont)
 
          ALLOCATE( dl_tmp(2) )
@@ -440,5 +452,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_value  2D array of value
@@ -503,5 +515,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  2D array of mixed grid value
@@ -565,5 +577,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_value  1D array of value
@@ -608,5 +620,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  1D array of mixed grid value
@@ -659,5 +671,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_weight interpolation weight of 2D array
@@ -740,5 +752,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_weight interpolation weight of 1D array
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90	(revision 6808)
@@ -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,5 +63,6 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
+   !> @date July, 2015 - reinitialise detect array for each level
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -84,11 +85,13 @@
 
       ! local variable
-      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
+      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
       
       ! loop indices
@@ -104,10 +107,10 @@
 
       ! compute vect2D
-      ALLOCATE(dl_weight_IJ(16,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) )
+      ALLOCATE(dl_weight_IJ(4,((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( 4,((id_rho(jp_I)+1)                 )) )
-      ALLOCATE( dl_weight_J( 4,(                 (id_rho(jp_J)+1))) )
+      ALLOCATE( dl_weight_I( 2,((id_rho(jp_I)+1)                 )) )
+      ALLOCATE( dl_weight_J( 2,(                 (id_rho(jp_J)+1))) )
       CALL interp_linear__get_weight1D(dl_weight_I(:,:), &
       &                               id_rho(jp_I), ld_even(jp_I))
@@ -115,5 +118,8 @@
       &                               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)
@@ -121,17 +127,17 @@
             ! I-J plan
             CALL interp_linear__2D(dd_value(:,:,jk,jl), dd_fill,&
-            &                     id_detect(:,:,jk),            &
+            &                     il_detect(:,:,jk),            &
             &                     dl_weight_IJ(:,:),            &
             &                     id_rho(jp_I), id_rho(jp_J),   &
             &                     ll_discont)            
-            IF( ANY(id_detect(:,:,jk)==1) )THEN
+            IF( ANY(il_detect(:,:,jk)==1) )THEN
                ! I direction
                DO jj=1,il_shape(2)
                   CALL interp_linear__1D( dd_value(:,jj,jk,jl), dd_fill,&
-                  &                       id_detect(:,jj,jk),           &
+                  &                       il_detect(:,jj,jk),           &
                   &                       dl_weight_I(:,:),             &
                   &                       id_rho(jp_I), ll_discont )
                ENDDO
-               IF( ALL(id_detect(:,:,jk)==0) )THEN
+               IF( ALL(il_detect(:,:,jk)==0) )THEN
                   CYCLE
                ELSE
@@ -139,5 +145,5 @@
                   DO ji=1,il_shape(1)
                      CALL interp_linear__1D( dd_value(ji,:,jk,jl), dd_fill,&
-                     &                       id_detect(ji,:,jk),           &
+                     &                       il_detect(ji,:,jk),           &
                      &                       dl_weight_J(:,:),             &
                      &                       id_rho(jp_J), ll_discont )
@@ -149,8 +155,11 @@
       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
    !-------------------------------------------------------------------
@@ -161,5 +170,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -235,5 +244,5 @@
                IF( ALL(id_detect(ji:ji+id_rhoi,   &
                &                 jj:jj+id_rhoj)==0) ) CYCLE
-               ! check data to needed to interpolate
+               ! check data needed to interpolate
                IF( ANY(dl_coarse(ii:ii+1,ij:ij+1)==dd_fill) ) CYCLE
                ! check longitude discontinuity
@@ -296,5 +305,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  1D array of variable value 
@@ -408,5 +417,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_value  2D array of value
@@ -445,6 +454,6 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
-   !> 
+   !> @date 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
@@ -477,25 +486,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
-
-               ENDDO
+      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
-
-         ENDIF
+         ENDDO
+
+      ENDIF
 
    END SUBROUTINE interp_linear__2D_fill
@@ -505,5 +514,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_value  1D array of value
@@ -540,5 +549,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !> 
    !> @param[inout] dd_value  1D array of mixed grid value
@@ -591,5 +600,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_weight interpolation weight of 2D array
@@ -660,5 +669,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_weight interpolation weight of 1D array
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90	(revision 6808)
@@ -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
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -69,5 +69,7 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(4)                :: il_shape
+      INTEGER(i4), DIMENSION(4)                  :: il_shape
+
+      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
 
       ! loop indices
@@ -80,5 +82,7 @@
       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)
@@ -86,14 +90,14 @@
             ! I-J plan
             CALL interp_nearest__2D(dd_value(:,:,jk,jl),&
-            &                       id_detect(:,:,jk),  &
+            &                       il_detect(:,:,jk),  &
             &                       id_rho(jp_I), id_rho(jp_J) )            
-            IF( ANY(id_detect(:,:,jk)==1) )THEN
+            IF( ANY(il_detect(:,:,jk)==1) )THEN
                ! I direction
                DO jj=1,il_shape(2)
                   CALL interp_nearest__1D( dd_value(:,jj,jk,jl),&
-                  &                        id_detect(:,jj,jk),  &
+                  &                        il_detect(:,jj,jk),  &
                   &                        id_rho(jp_I) )
                ENDDO
-               IF( ALL(id_detect(:,:,jk)==0) )THEN
+               IF( ALL(il_detect(:,:,jk)==0) )THEN
                   CYCLE
                ELSE
@@ -101,5 +105,5 @@
                   DO ji=1,il_shape(1)
                      CALL interp_nearest__1D( dd_value(ji,:,jk,jl),&
-                     &                        id_detect(ji,:,jk),  &
+                     &                        il_detect(ji,:,jk),  &
                      &                        id_rho(jp_J) )
                   ENDDO
@@ -110,4 +114,7 @@
       ENDDO
 
+      id_detect(:,:,:)=il_detect(:,:,:)
+      DEALLOCATE(il_detect)
+
    END SUBROUTINE interp_nearest_fill
    !-------------------------------------------------------------------
@@ -116,5 +123,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -171,5 +178,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  1D array of variable value 
@@ -216,5 +223,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  2D array of mixed grid value
@@ -300,5 +307,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  1D array of mixed grid value
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom.f90	(revision 6808)
@@ -156,5 +156,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file file structure
@@ -186,5 +186,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file file structure
@@ -223,5 +223,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file file structure
@@ -252,5 +252,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file      file structure
@@ -300,5 +300,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -338,5 +338,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file      file structure
@@ -386,5 +386,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file      file structure
@@ -422,5 +422,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -452,5 +452,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -485,5 +485,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -529,5 +529,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -564,21 +564,27 @@
    !-------------------------------------------------------------------
    !> @brief This subroutine write file structure in an opened file.
-   !
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !>
+   !> @details
+   !> optionally, you could specify dimension order (default 'xyzt')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 - add dimension order option
    !
    !> @param[in] td_file   file structure
    !-------------------------------------------------------------------
-   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')
+   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
             CALL iom_rstdimg_write_file(td_file)
          CASE DEFAULT
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90	(revision 6808)
@@ -144,16 +144,24 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date May, 2015 - add optional message to netcdf error message
+   !>
    !> @param[in] id_status error status
-   !-------------------------------------------------------------------
-   SUBROUTINE iom_cdf__check(id_status)
-      IMPLICIT NONE
-      ! Argument      
-      INTEGER(i4), INTENT(IN) :: id_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
 
       IF( id_status /= NF90_NOERR )THEN
-         CALL logger_error(TRIM(NF90_STRERROR(id_status)))
+         CALL logger_error(TRIM(cl_msg)//TRIM(NF90_STRERROR(id_status)))
       ENDIF
 
@@ -173,5 +181,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -203,8 +211,9 @@
             CALL logger_info( " IOM CDF CREATE: file "//TRIM(td_file%c_name) )
 
-            il_status = NF90_CREATE( TRIM(td_file%c_name),&
-            &                        NF90_WRITE,               &
-            &                        td_file%i_id)
-            CALL iom_cdf__check(il_status)
+            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: ")
 
             td_file%l_def=.TRUE.
@@ -228,7 +237,8 @@
                &                      NF90_NOWRITE,         &
                &                      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)))
+               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)))
             ELSE
 
@@ -239,5 +249,5 @@
                &                      NF90_WRITE,           &
                &                      td_file%i_id)
-               CALL iom_cdf__check(il_status)
+               CALL iom_cdf__check(il_status,"IOM CDF OPEN: ")
 
             ENDIF
@@ -267,5 +277,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -291,5 +301,5 @@
 
          il_status = NF90_CLOSE(td_file%i_id)
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF CLOSE: ")
 
          td_file%i_id = 0
@@ -307,5 +317,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -326,5 +336,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)
+      CALL iom_cdf__check(il_status,"IOM CDF GET INFO: ")
 
       SELECT CASE(il_fmt)
@@ -345,5 +355,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -396,5 +406,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - use attribute periodicity read from the file if present.
@@ -439,5 +449,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -480,12 +490,12 @@
 
             ! look for depth id
-            IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'depth') /= 0 )THEN
+            IF( INDEX(TRIM(fct_lower(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
@@ -493,5 +503,5 @@
 
             ! look for time id
-            IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'time') /= 0 )THEN
+            IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'time')/=0 )THEN
                IF( td_file%i_timeid == 0 )THEN
                   td_file%i_timeid=ji
@@ -504,7 +514,6 @@
                      td_file%i_timeid=ji
                   !ELSE
-                  !   print *,'error'
-                  !   CALL logger_error("IOM OPEN: find more than one "//&
-                  !   &                 "time variable in file "//&
+                  !   CALL logger_error("IOM CDF GET FILE VAR: find more "//&
+                  !   &                 "than one time variable in file "//&
                   !   &                 TRIM(td_file%c_name) )
                   ENDIF
@@ -526,5 +535,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -567,5 +576,7 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 - create unused dimension, when reading dimension
+   !> of length less or equal to zero
    !
    !> @param[in] td_file   file structure
@@ -583,4 +594,5 @@
       INTEGER(i4)       :: il_len
       CHARACTER(LEN=lc) :: cl_name
+      LOGICAL           :: ll_use
       !----------------------------------------------------------------
 
@@ -601,7 +613,15 @@
          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_id=dim_init(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)
 
       ENDIF
@@ -613,5 +633,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -634,5 +654,6 @@
 
          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      
@@ -640,5 +661,5 @@
          il_status=NF90_INQ_DIMID( td_file%i_id, TRIM(ADJUSTL(cd_name)), &
          &                         il_dimid)
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ")
 
          iom_cdf__read_dim_name=iom_cdf_read_dim(td_file, il_dimid)
@@ -652,5 +673,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -714,9 +735,9 @@
          &                                il_len, &
          &                                il_attid )
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
 
          !! 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 )
@@ -728,6 +749,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
@@ -737,5 +758,5 @@
                   &                      cl_name, &
                   &                      cl_value )
-                  CALL iom_cdf__check(il_status)
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
 
                   iom_cdf__read_att_name=att_init(cl_name, cl_value)
@@ -758,5 +779,5 @@
                   &                      cl_name, &
                   &                      bl_value(:))
-                  CALL iom_cdf__check(il_status)   
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
 
                   iom_cdf__read_att_name=att_init(cl_name, bl_value(:))
@@ -773,6 +794,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
@@ -782,5 +803,5 @@
                   &                      cl_name, &
                   &                      sl_value(:))
-                  CALL iom_cdf__check(il_status)   
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
 
                   iom_cdf__read_att_name=att_init(cl_name, sl_value(:))
@@ -797,6 +818,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
@@ -806,5 +827,5 @@
                   &                      cl_name, &
                   &                      il_value(:))
-                  CALL iom_cdf__check(il_status)   
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
 
                   iom_cdf__read_att_name=att_init(cl_name, il_value(:))
@@ -820,6 +841,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
@@ -829,5 +850,5 @@
                   &                      cl_name, &
                   &                      fl_value(:))
-                  CALL iom_cdf__check(il_status)   
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
 
                   iom_cdf__read_att_name=att_init(cl_name, fl_value(:))
@@ -844,6 +865,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
@@ -853,5 +874,5 @@
                   &                      cl_name, &
                   &                      dl_value(:))
-                  CALL iom_cdf__check(il_status)   
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
 
                   iom_cdf__read_att_name=att_init(cl_name, dl_value(:))
@@ -873,5 +894,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -902,5 +923,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)
+         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
 
          ! read attribute
@@ -918,5 +939,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -976,5 +997,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1043,5 +1064,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1085,5 +1106,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1148,5 +1169,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1199,5 +1220,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - force to use FillValue=1.e20 if no FillValue for coordinate variable.
@@ -1240,5 +1261,5 @@
 
          ! inquire variable
-         CALL logger_trace( &
+         CALL logger_debug( &
          &  " IOM CDF READ VAR META: inquire variable "//&
          &  TRIM(fct_str(id_varid))//&
@@ -1253,7 +1274,8 @@
          &                                il_dimid(:),&
          &                                il_natt )
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF READ VAR META: ")
          !!! 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) )
@@ -1276,10 +1298,10 @@
                ELSE
                   ! create attribute _FillValue
-                  SELECT CASE(TRIM(cl_name))
+                  SELECT CASE(TRIM(fct_lower(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', &
+                     CASE('nav_lon','nav_lat', 'nav_lev', &
                         &  'glamt','glamu','glamv','glamf', &
                         &  'gphit','gphiu','gphiv','gphif')
@@ -1311,5 +1333,5 @@
             ALLOCATE(tl_att(il_natt+1) )
             ! create attribute _FillValue
-            SELECT CASE(TRIM(cl_name))
+            SELECT CASE(TRIM(fct_lower(cl_name)))
                CASE DEFAULT
                   CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
@@ -1353,6 +1375,8 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - Bug fix: use order to disorder table (see dim_init)
+   !>
    !> @param[in] td_file   file structure
    !> @param[in] id_ndim   number of dimension
@@ -1371,5 +1395,5 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(ip_maxdim) :: il_2xyzt
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_xyzt2
 
       TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
@@ -1395,17 +1419,17 @@
 
          DO ji = 1, id_ndim
-            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
+            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
 
             ! read dimension information
-            tl_dim(ji) = dim_init( td_file%t_dim(il_2xyzt(ji))%c_name, &
-            &                      td_file%t_dim(il_2xyzt(ji))%i_len )
+            tl_dim(ji) = dim_init( td_file%t_dim(il_xyzt2(ji))%c_name, &
+            &                      td_file%t_dim(il_xyzt2(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(:))
 
@@ -1426,5 +1450,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1475,5 +1499,7 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - use scale factor and offset, as soon as read variable value
    !
    !> @param[in] td_file   file structure
@@ -1482,7 +1508,4 @@
    !> @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, &
@@ -1496,12 +1519,13 @@
 
       ! 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
@@ -1518,6 +1542,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
@@ -1525,7 +1549,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
 
@@ -1564,7 +1588,4 @@
             &    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
@@ -1575,8 +1596,10 @@
                &  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 (unorder)
+            ! Allocate space to hold variable value (disorder)
             ALLOCATE(dl_value( il_count(1), &
                &               il_count(2), &
@@ -1601,5 +1624,5 @@
             &                                       start = il_start(:),&
             &                                       count = il_count(:) )
-            CALL iom_cdf__check(il_status)
+            CALL iom_cdf__check(il_status,"IOM CDF READ VAR VALUE: ")
 
             ! Allocate space to hold variable value in structure
@@ -1663,4 +1686,11 @@
                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
@@ -1673,17 +1703,25 @@
    !-------------------------------------------------------------------
    !> @brief This subroutine write file structure in an opened netcdf file.
-   !
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !>
+   !> @details
+   !> optionally, you could specify dimension order (default 'xyzt')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - add dimension order option 
    !
    !> @param[inout] td_file   file structure
    !-------------------------------------------------------------------
-   SUBROUTINE iom_cdf_write_file(td_file)
-      IMPLICIT NONE
-      ! Argument      
-      TYPE(TFILE), INTENT(INOUT) :: td_file
+   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
 
       ! local variable
       INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_value
+
+      CHARACTER(LEN=lc)                      :: cl_dimorder
 
       TYPE(TVAR)                             :: tl_var
@@ -1694,5 +1732,9 @@
       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
@@ -1726,4 +1768,13 @@
             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
@@ -1776,5 +1827,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1798,5 +1849,5 @@
          ! Enter define mode
          il_status=NF90_REDEF(td_file%i_id)
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
 
          td_file%l_def=.TRUE.
@@ -1813,9 +1864,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)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
 
          ELSE
             ! write not unlimited dimension
-            CALL logger_trace( &
+            CALL logger_debug( &
             &  "IOM CDF WRITE FILE DIM: write dimension "//TRIM(td_dim%c_name)//&
             &  " in file "//TRIM(td_file%c_name))
@@ -1823,5 +1874,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)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
 
          ENDIF
@@ -1834,5 +1885,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1859,5 +1910,5 @@
          ! Enter define mode
          il_status=NF90_REDEF(td_file%i_id)
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
 
          td_file%l_def=.TRUE.
@@ -1876,5 +1927,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)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
 
          CASE(NF90_BYTE, NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE)
@@ -1882,5 +1933,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)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
 
       END SELECT
@@ -1891,5 +1942,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1917,10 +1968,10 @@
          ! Enter define mode
          il_status=NF90_REDEF(td_file%i_id)
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ")
 
          td_file%l_def=.TRUE.
 
       ENDIF
-      
+ 
       ! check if file and variable dimension conform
       IF( file_check_var_dim(td_file, td_var) )THEN
@@ -1938,10 +1989,15 @@
             ENDIF
          ENDDO
+         ! ugly patch until NEMO do not force to use 0. as FillValue 
          IF( ll_chg )THEN
             ! not a dimension variable
             ! change FillValue
-
-            ! ugly patch until NEMO do not force to use 0. as FillValue 
-            CALL var_chg_FillValue(td_var,0._dp)
+            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
          ENDIF
 
@@ -1957,5 +2013,5 @@
             ! Leave define mode
             il_status=NF90_ENDDEF(td_file%i_id)
-            CALL iom_cdf__check(il_status)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ")
 
             td_file%l_def=.FALSE.
@@ -1975,5 +2031,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -2002,9 +2058,17 @@
       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)
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
       ELSE
 
@@ -2020,16 +2084,17 @@
          ENDDO
 
-         CALL logger_trace( &
+         CALL logger_debug( &
          &  "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_trace("IOM CDF WRITE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) )
+            CALL logger_debug("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)
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
       ENDIF
 
@@ -2043,8 +2108,13 @@
 
       DO ji = 1, tl_var%i_natt
-         CALL logger_trace( &
+         CALL logger_debug( &
          &  " 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
@@ -2053,5 +2123,5 @@
                &                        TRIM(tl_var%t_att(ji)%c_name),        &
                &                        TRIM(tl_var%t_att(ji)%c_value)        )
-               CALL iom_cdf__check(il_status)
+               CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
             ENDIF
          ELSE
@@ -2082,6 +2152,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)
+            END SELECT
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
          ENDIF
       ENDDO
@@ -2097,5 +2167,7 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - reuse scale factor and offset, before writing variable
    !
    !> @param[in] td_file   file structure
@@ -2122,5 +2194,11 @@
       &  "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
@@ -2153,5 +2231,5 @@
 
       il_status = NF90_PUT_VAR( td_file%i_id, td_var%i_id, dl_value(:,:,:,:))
-      CALL iom_cdf__check(il_status)
+      CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE: ")
 
       DEALLOCATE( dl_value )
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90	(revision 6808)
@@ -71,5 +71,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[inout] td_mpp mpp structure
@@ -106,5 +106,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[in] td_mpp mpp structure
@@ -130,5 +130,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @param[in] td_mpp    mpp structure
@@ -194,5 +194,5 @@
    !
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -246,5 +246,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @todo
@@ -411,5 +411,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -465,5 +465,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @param[in] td_mpp    mpp structure
@@ -524,5 +524,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @param[in] td_mpp    mpp structure
@@ -636,5 +636,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -663,5 +663,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -691,5 +691,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90	(revision 6808)
@@ -87,5 +87,5 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date Nov, 2013 - Initial Version
+!> @date November, 2013 - Initial Version
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -137,5 +137,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_mpp mpp structure
@@ -161,4 +161,7 @@
 
       ELSE
+         ! 
+         td_mpp%i_id=1
+
          ! if no processor file selected
          ! force to open all files 
@@ -221,5 +224,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_mpp mpp structure
@@ -248,5 +251,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_mpp mpp structure
@@ -267,4 +270,7 @@
 
       ELSE
+         ! 
+         td_mpp%i_id=0         
+
          DO ji=1,td_mpp%i_nproc
             IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN
@@ -285,5 +291,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - use start and count array instead of domain structure.
@@ -314,5 +320,11 @@
          &               " 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
@@ -355,5 +367,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - use start and count array instead of domain structure.
@@ -384,4 +396,9 @@
          &               " 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
 
@@ -400,5 +417,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
@@ -416,5 +433,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - use start and count array instead of domain structure.
@@ -467,4 +484,15 @@
       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
@@ -476,6 +504,15 @@
       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.")
@@ -583,14 +620,18 @@
    !
    !> @details
+   !> optionally, you could specify the dimension order (default 'xyzt')
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 - add dimension order option 
    !
    !> @param[inout] td_mpp mpp structure
-   !-------------------------------------------------------------------
-   SUBROUTINE iom_mpp_write_file(td_mpp)
+   !> @param[In] cd_dimorder dimension order
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_mpp_write_file(td_mpp, cd_dimorder)
       IMPLICIT NONE
       ! Argument      
-      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp
+      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
 
       ! local variable
@@ -610,5 +651,5 @@
                !CALL file_del_att(td_mpp%t_proc(ji), 'ew_overlap')
 
-               CALL iom_write_file(td_mpp%t_proc(ji))
+               CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder)
             ELSE
                CALL logger_debug( " MPP WRITE: no id associated to file "//&
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90	(revision 6808)
@@ -131,5 +131,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -284,5 +284,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -328,5 +328,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -394,5 +394,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -544,5 +544,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -636,5 +636,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -688,5 +688,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -733,5 +733,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -778,5 +778,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -820,5 +820,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -863,5 +863,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -907,5 +907,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -972,5 +972,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1037,5 +1037,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1058,4 +1058,5 @@
       INTEGER(i4), DIMENSION(ip_maxdim)            :: il_start
       INTEGER(i4), DIMENSION(ip_maxdim)            :: il_count
+
       REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
 
@@ -1204,4 +1205,16 @@
       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
    !-------------------------------------------------------------------
@@ -1212,5 +1225,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - use iom_rstdimg__get_rec
@@ -1308,5 +1321,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1413,5 +1426,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1630,7 +1643,9 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015
+   !> - bug fix: do not use scale factor an offset for case no0d, no1d...
    !>
-   !> @param[in] id_fileid file id
+   !> @param[in] td_file file structure
    !-------------------------------------------------------------------
    SUBROUTINE iom_rstdimg__write_var(td_file)
@@ -1667,4 +1682,14 @@
             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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/logger.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/logger.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/logger.f90	(revision 6808)
@@ -16,6 +16,7 @@
 !> but not necessarily "wrong". 
 !>    - error : Other runtime errors or unexpected conditions.
-!>    - fatal : Severe errors that cause premature termination.<br />
+!>    - fatal : Severe errors that cause premature termination.
 !>  default verbosity is warning
+!>    - none  : to not create and write any information in logger file.<br />
 !
 !> If total number of error exceeded maximum number 
@@ -24,5 +25,5 @@
 !> to open/create logger file:<br/>
 !> @code
-!>    CALL logger_open(cd_file, [cd_verbosity,] [id_loggerid,] [id_maxerror])
+!>    CALL logger_open(cd_file, [cd_verbosity,] [id_maxerror,] [id_loggerid])
 !> @endcode
 !> - cd_file is logger file name
@@ -120,5 +121,8 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date November, 2013- Initial Version
+!> @date November, 2013 - Initial Version
+!> @date February, 2015
+!> - check verbosity validity
+!> - add 'none' verbosity level to not used logger file
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -151,7 +155,9 @@
 
    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
@@ -163,5 +169,5 @@
 
    !  module variable
-   INTEGER(i4), PARAMETER :: im_nverbosity=6     !< number of log level
+   INTEGER(i4), PARAMETER :: im_nverbosity=7     !< number of log level
    CHARACTER(len=*), DIMENSION(im_nverbosity), PARAMETER :: cm_verbosity= & !< verbosity array 
    &               (/ 'trace   ',&
@@ -170,5 +176,6 @@
    &                  'warning ',&
    &                  'error   ',&
-   &                  'fatal   '/)
+   &                  'fatal   ',&
+   &                  'none    '/)
 
    TYPE(TLOGGER), SAVE :: tm_logger      !< logger structure
@@ -184,62 +191,74 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_file      log file name
    !> @param[in] cd_verbosity log file verbosity
+   !> @param[in] id_maxerror  maximum number of error
    !> @param[in] id_logid     log file id (use to flush)
-   !> @param[in] id_maxerror  maximum number of error
-   !-------------------------------------------------------------------
-   SUBROUTINE logger_open(cd_file, cd_verbosity, id_logid, id_maxerror)
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_open(cd_file, cd_verbosity, id_maxerror, id_logid)
       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_maxerror  ! log max error
       INTEGER(i4),      INTENT(IN), OPTIONAL :: id_logid     ! log file id
-      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_maxerror  ! log max error
 
       ! 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
-         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
+         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
+
       ENDIF
 
@@ -249,5 +268,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !-------------------------------------------------------------------
    SUBROUTINE logger_close()
@@ -256,13 +275,15 @@
       INTEGER(i4) :: il_status
       !----------------------------------------------------------------
-      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')
+      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
       ENDIF
 
@@ -272,17 +293,19 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !-------------------------------------------------------------------
    SUBROUTINE logger_flush()
       IMPLICIT NONE
       !----------------------------------------------------------------
-      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')
+      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
       ENDIF
 
@@ -292,5 +315,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !-------------------------------------------------------------------
    RECURSIVE SUBROUTINE logger_header()
@@ -299,17 +322,19 @@
       INTEGER(i4)       :: il_status
       !----------------------------------------------------------------
-      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')
+      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
       ENDIF
 
@@ -319,5 +344,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !-------------------------------------------------------------------
    SUBROUTINE logger_footer()
@@ -326,20 +351,22 @@
       INTEGER(i4)       :: il_status
       !----------------------------------------------------------------
-      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')
+      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
       ENDIF
    END SUBROUTINE logger_footer
@@ -350,5 +377,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -361,19 +388,21 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
       !----------------------------------------------------------------
-      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%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')
+         ENDIF
       ENDIF
    END SUBROUTINE logger_trace
@@ -384,5 +413,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -395,19 +424,21 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
       !----------------------------------------------------------------
-      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%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')
+         ENDIF
       ENDIF
    END SUBROUTINE logger_debug
@@ -418,5 +449,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -429,19 +460,21 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
       !----------------------------------------------------------------
-      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%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')
+         ENDIF
       ENDIF
    END SUBROUTINE logger_info
@@ -452,5 +485,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -463,19 +496,21 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
       !----------------------------------------------------------------
-      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%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')
+         ENDIF
       ENDIF
    END SUBROUTINE logger_warn
@@ -486,5 +521,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -500,30 +535,33 @@
       CHARACTER(LEN=lc) :: cl_nerror
       !----------------------------------------------------------------
-      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
-
-         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
-
+      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')
+         ENDIF
+      ENDIF
    END SUBROUTINE logger_error
    !-------------------------------------------------------------------
@@ -532,5 +570,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg message to write
@@ -541,21 +579,23 @@
       CHARACTER(LEN=*),           INTENT(IN) :: cd_msg
       !----------------------------------------------------------------
-      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%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')
+         ENDIF
       ENDIF
    END SUBROUTINE logger_fatal
@@ -565,5 +605,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_verb   verbosity of the message to write
@@ -615,4 +655,43 @@
 
    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: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/math.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/math.f90	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/math.f90	(revision 6808)
@@ -0,0 +1,1285 @@
+!----------------------------------------------------------------------
+! 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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90	(revision 6808)
@@ -28,4 +28,7 @@
 !> @endcode
 !>    
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
 !>    merge_bathy.nam comprise 8 namelists:
 !>       - logger namelist (namlog)
@@ -45,5 +48,5 @@
 !>       - cn_logfile   : logger filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!>  'warning','error','fatal')
+!>  'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -62,10 +65,10 @@
 !>    * _variable namelist (namvar)_:
 !>       - cn_varinfo : list of variable and extra information about request(s) 
-!>       to be used.<br/>
+!>       to be used (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:
-!>             - interpolation method
+!>             - int = interpolation method
 !> 
 !>                requests must be separated by ';'.<br/>
@@ -74,5 +77,5 @@
 !>          informations about available method could be find in 
 !>          @ref interp modules.<br/>
-!>          Example: 'bathymetry: cubic'
+!>          Example: 'bathymetry: int=cubic'
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -95,9 +98,9 @@
 !>          segments are separated by '|'.<br/>
 !>          each segments of the boundary is composed of:
-!>             - 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/>
+!>             - 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/>
 !>             - optionally, boundary size could be added between '(' and ')' 
 !>             in the first segment defined.
@@ -106,6 +109,7 @@
 !>
 !>          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/>
@@ -121,4 +125,7 @@
 !> @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)
@@ -153,4 +160,5 @@
    CHARACTER(LEN=lc)                                  :: cl_namelist
    CHARACTER(LEN=lc)                                  :: cl_date
+   CHARACTER(LEN=lc)                                  :: cl_tmp
 
    INTEGER(i4)                                        :: il_narg
@@ -162,4 +170,5 @@
    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
@@ -231,5 +240,6 @@
    NAMELIST /namlog/ &  !< logger namelist
    &  cn_logfile,    &  !< log file
-   &  cn_verbosity      !< log verbosity
+   &  cn_verbosity,  &  !< log verbosity
+   &  in_maxerror       !< logger maximum error
 
    NAMELIST /namcfg/ &  !< config namelist
@@ -298,5 +308,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()
 
@@ -510,4 +520,78 @@
    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)
@@ -525,4 +609,5 @@
    CALL mpp_clean(tl_bathy0)
    DEALLOCATE(dl_weight)
+   CALL boundary_clean(tl_bdy(:))
 
    ! close log file
@@ -908,7 +993,5 @@
 
       ! extrapolate variable
-      CALL extrap_fill_value( td_var, id_offset=id_offset(:,:), &
-      &                               id_rho=id_rho(:),         &
-      &                               id_iext=il_iext, id_jext=il_jext )
+      CALL extrap_fill_value( td_var )
 
       ! interpolate Bathymetry
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/mpp.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/mpp.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/mpp.f90	(revision 6808)
@@ -165,13 +165,11 @@
 !>    to get processors to be used:<br/>
 !> @code
-!>    CALL mpp_get_use( td_mpp, id_imin, id_imax, id_idim, & 
-!>    &                         id_jmin, id_jmax, id_jdim )
+!>    CALL mpp_get_use( td_mpp, id_imin, id_imax, & 
+!>    &                         id_jmin, id_jmax )
 !> @endcode
 !>       - id_imin 
 !>       - id_imax 
-!>       - id_idim 
 !>       - id_jmin 
 !>       - id_jmax 
-!>       - id_jdim 
 !>
 !>    to get sub domains which form global domain contour:<br/>
@@ -352,5 +350,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date November, 2014
    !>    - use function instead of overload assignment operator 
@@ -379,4 +377,5 @@
       ! 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
@@ -425,5 +424,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date November, 2014
    !>    - use function instead of overload assignment operator 
@@ -454,5 +453,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_mpp mpp structure
@@ -495,5 +494,5 @@
       ! print dimension
       IF(  td_mpp%i_ndim /= 0 )THEN
-         WRITE(*,'(/a)') " File dimension"
+         WRITE(*,'(/a)') " MPP dimension"
          DO ji=1,ip_maxdim
             IF( td_mpp%t_dim(ji)%l_use )THEN
@@ -698,5 +697,5 @@
       CALL dim_clean(tl_dim)
 
-      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_niproc))) .OR. &
+      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_njproc))) .OR. &
           ((.NOT. PRESENT(id_niproc)) .AND.        PRESENT(id_njproc) ) )THEN
           CALL logger_warn( "MPP INIT: number of processors following I and J "//&
@@ -912,5 +911,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file strcuture
@@ -1028,29 +1027,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_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_I_position_first", mpp__init_file%t_proc(:)%i_impp )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_J_position_first", mpp__init_file%t_proc(:)%i_jmpp )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_I_position_last", mpp__init_file%t_proc(:)%i_lci )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_J_position_last", mpp__init_file%t_proc(:)%i_lcj )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_I_halo_size_start", mpp__init_file%t_proc(:)%i_ldi )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_J_halo_size_start", mpp__init_file%t_proc(:)%i_ldj )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_I_halo_size_end", mpp__init_file%t_proc(:)%i_lei )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_J_halo_size_end", mpp__init_file%t_proc(:)%i_lej )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
             
             ! clean
@@ -1122,5 +1121,4 @@
       CALL file_clean(tl_file)
 
-      CALL logger_debug("MPP INIT READ: fin init_read ")
    END FUNCTION mpp__init_file
    !-------------------------------------------------------------------
@@ -1131,5 +1129,6 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 - add only use dimension in MPP structure
    !>
    !> @param[in] td_file   file strcuture
@@ -1163,6 +1162,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
 
@@ -1191,9 +1190,14 @@
                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)
+
+            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
 
             ! initialise file/processor
@@ -1312,5 +1316,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file strcuture
@@ -1532,5 +1536,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -1624,8 +1628,4 @@
             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,4 +1634,7 @@
                   &  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
@@ -1675,5 +1678,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -1840,4 +1843,6 @@
    !> @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
@@ -1852,4 +1857,5 @@
       ! local variable
       INTEGER(i4)       :: il_varid
+      TYPE(TVAR)        :: tl_var
       !----------------------------------------------------------------
       ! check if mpp exist
@@ -1882,5 +1888,6 @@
             ELSE
 
-               CALL mpp_del_var(td_mpp, td_mpp%t_proc(1)%t_var(il_varid)) 
+               tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid))
+               CALL mpp_del_var(td_mpp, tl_var)
 
             ENDIF
@@ -2193,5 +2200,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - rewrite the same as way var_add_dim
    !>
    !> @param[inout] td_mpp mpp structure
@@ -2208,51 +2217,33 @@
 
       ! loop indices
-      INTEGER(i4) :: ji
       !----------------------------------------------------------------
       IF( td_mpp%i_ndim <= ip_maxdim )THEN
 
-         ! 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
-
+         ! 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) )
          ELSE
 
-            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
+            ! 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)
 
          ENDIF
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(td_mpp%t_dim(:))
 
       ELSE
@@ -2268,5 +2259,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - rewrite the same as way var_del_dim
    !>
    !> @param[inout] td_mpp mpp structure
@@ -2280,55 +2273,34 @@
 
       ! local variable
-      INTEGER(i4) :: il_status
       INTEGER(i4) :: il_ind
-      TYPE(TDIM), DIMENSION(:), ALLOCATABLE  :: tl_dim
+      TYPE(TDIM)  :: tl_dim
 
       ! loop indices
-      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)//&
+      !----------------------------------------------------------------
+
+
+      IF( td_mpp%i_ndim <= ip_maxdim )THEN
+
+         CALL logger_trace( &
+         &  " MPP DEL DIM: delete 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
-
-         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
-
+         CALL logger_error( &
+         &  " MPP DEL DIM: too much dimension in mpp "//&
+         &  TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")")
       ENDIF
 
@@ -2340,5 +2312,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_mpp mpp structure
@@ -2488,8 +2460,8 @@
             &  ", in mpp structure "//TRIM(td_mpp%c_name) )
 
-            IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )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_var(ji)%c_name) )
+                  &  attribute : "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) )
                ENDDO
             ENDIF
@@ -2516,4 +2488,6 @@
    !> @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
@@ -2527,5 +2501,6 @@
 
       ! local variable
-      INTEGER(i4)       :: il_attid
+      INTEGER(i4) :: il_attid
+      TYPE(TATT)  :: tl_att
       !----------------------------------------------------------------
       ! check if mpp exist
@@ -2551,5 +2526,5 @@
             IF( il_attid == 0 )THEN
 
-               CALL logger_warn( &
+               CALL logger_debug( &
                &  "MPP DEL ATT : there is no attribute with "//&
                &  "name "//TRIM(cd_name)//" in mpp structure "//&
@@ -2558,5 +2533,6 @@
             ELSE
 
-               CALL mpp_del_att(td_mpp, td_mpp%t_proc(1)%t_att(il_attid)) 
+               tl_att=att_copy(td_mpp%t_proc(1)%t_att(il_attid))
+               CALL mpp_del_att(td_mpp, tl_att) 
 
             ENDIF
@@ -2863,8 +2839,13 @@
 
             CALL logger_info("MPP OPTIMIZ: number of processor "//&
-            &  TRIM(fct_str(tl_mpp%i_nproc)) )
+            &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//&
+            &   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
@@ -3146,5 +3127,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !>
    !> @param[inout] td_mpp mpp strcuture
@@ -3184,5 +3165,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !>
    !> @param[in] td_mpp    mpp strcuture
@@ -3249,5 +3230,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !
    !> @param[in] td_mpp    mpp strcuture
@@ -3311,5 +3292,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !>
    !> @param[inout] td_mpp mpp strcuture
@@ -3404,5 +3385,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_mpp mpp structure
@@ -3417,5 +3398,4 @@
 
       ! local variable
-      INTEGER(i4) :: il_ndim
 
       ! loop indices
@@ -3429,14 +3409,8 @@
          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)) )
-         il_ndim=MIN(td_var%i_ndim, td_mpp%i_ndim )
-         DO ji = 1, il_ndim
+         DO ji = 1, ip_maxdim
             CALL logger_debug( &
             &  "MPP CHECK DIM: for dimension "//&
@@ -3448,4 +3422,10 @@
             &  ", 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
 
@@ -3456,5 +3436,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   array of file structure
@@ -3496,5 +3476,5 @@
    !
    !> @author J.Paul
-   !> - Ocotber, 2014- Initial Version
+   !> @date Ocotber, 2014 - Initial Version
    !
    !> @param[in] td_mpp   mpp file structure
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/multi.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/multi.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/multi.f90	(revision 6808)
@@ -61,5 +61,6 @@
 !> @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)
@@ -118,5 +119,5 @@
    !>   
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date November, 2014
    !>    - use function instead of overload assignment operator (to avoid memory leak)
@@ -169,5 +170,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - check if variable to be read is in file
    !>
    !> @param[in] cd_varfile   variable location information (from namelist) 
@@ -190,4 +193,5 @@
 
       INTEGER(i4)       :: il_nvar
+      INTEGER(i4)       :: il_varid
 
       LOGICAL           :: ll_dim
@@ -242,4 +246,12 @@
                   ! 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
@@ -317,5 +329,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_multi  multi file structure
@@ -348,5 +360,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_multi multi file structure
@@ -391,5 +403,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - use mpp file structure instead of file
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/phycst.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/phycst.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/phycst.f90	(revision 6808)
@@ -25,4 +25,5 @@
    PUBLIC :: dp_rearth  !< earth radius (km)
    PUBLIC :: dp_deg2rad !< degree to radian ratio 
+   PUBLIC :: dp_rad2deg !< radian to degree ratio 
    PUBLIC :: dp_delta   !<  
 
@@ -31,6 +32,7 @@
    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-2
+   REAL(dp), PARAMETER :: dp_delta=1.e-6
 END MODULE phycst
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/variable.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/variable.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/variable.f90	(revision 6808)
@@ -281,4 +281,8 @@
 !> @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)
@@ -293,4 +297,5 @@
    USE att                             ! attribute manager
    USE dim                             ! dimension manager
+   USE math                            ! mathematical function
    IMPLICIT NONE
    ! NOTE_avoid_public_variables_if_possible
@@ -318,4 +323,5 @@
    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
@@ -382,4 +388,6 @@
    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
@@ -401,5 +409,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
 
@@ -414,5 +422,8 @@
       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
@@ -518,5 +529,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date November, 2014
    !> - use function instead of overload assignment operator (to avoid memory leak)
@@ -548,4 +559,7 @@
       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
@@ -577,4 +591,5 @@
       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
@@ -627,5 +642,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date November, 2014
    !> - use function instead of overload assignment operator 
@@ -656,5 +671,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable strucutre
@@ -695,5 +710,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[inout] td_var array of variable strucutre
@@ -718,5 +733,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[inout] td_var array of variable strucutre
@@ -744,5 +759,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[inout] td_var array of variable strucutre
@@ -788,4 +803,5 @@
    !>   - 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.
@@ -801,4 +817,6 @@
    !>   - 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,
@@ -806,5 +824,9 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @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)
    !>
    !> @param[in] cd_name         variable name
@@ -833,4 +855,6 @@
    !> @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
    !-------------------------------------------------------------------
@@ -843,5 +867,6 @@
    &                              ld_contiguous, ld_shuffle,&
    &                              ld_fletcher32, id_deflvl, id_chunksz, &
-   &                              cd_interp, cd_extrap, cd_filter )
+   &                              cd_interp, cd_extrap, cd_filter, &
+   &                              cd_unt, dd_unf )
       IMPLICIT NONE
       ! Argument
@@ -871,4 +896,6 @@
       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
 
 
@@ -933,7 +960,7 @@
                tl_att=att_init('_FillValue', INT(dd_fill,i4) )
             CASE(NF90_FLOAT)
-               tl_att=att_init('_FillValue', INT(dd_fill,sp) )
+               tl_att=att_init('_FillValue', REAL(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)
@@ -1038,4 +1065,16 @@
       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)
@@ -1047,4 +1086,6 @@
       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')
@@ -1072,6 +1113,10 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !>
    !> @param[in] cd_name         variable name
    !> @param[in] dd_value        1D array of real(8) value
@@ -1100,4 +1145,9 @@
    !> @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
    !-------------------------------------------------------------------
@@ -1110,5 +1160,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
       IMPLICIT NONE
       ! Argument
@@ -1138,4 +1190,9 @@
       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
@@ -1193,5 +1250,9 @@
       &                          ld_fletcher32=ld_fletcher32,        &
       &                          id_deflvl=id_deflvl,                &
-      &                          id_chunksz=id_chunksz(:))
+      &                          id_chunksz=id_chunksz(:),           &
+      &                          cd_interp=cd_interp(:),             &
+      &                          cd_extrap=cd_extrap(:),             &
+      &                          cd_filter=cd_filter(:),             &
+      &                          cd_unt=cd_unt, dd_unf=dd_unf )
    
       ! add value
@@ -1239,5 +1300,13 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @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)
    !
    !> @param[in] cd_name         variable name
@@ -1269,4 +1338,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -1279,5 +1353,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
       IMPLICIT NONE
       ! Argument
@@ -1307,4 +1383,9 @@
       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
@@ -1350,5 +1431,5 @@
       ENDIF
 
-      il_count(:)=tl_dim(1)%i_len
+      il_count(:)=tl_dim(:)%i_len
       IF( PRESENT(id_count) )THEN
          IF( SIZE(id_count(:)) /= 2 )THEN
@@ -1381,5 +1462,9 @@
       &                          ld_fletcher32=ld_fletcher32,        &
       &                          id_deflvl=id_deflvl,                &
-      &                          id_chunksz=id_chunksz(:))
+      &                          id_chunksz=id_chunksz(:),           &
+      &                          cd_interp=cd_interp(:),             &
+      &                          cd_extrap=cd_extrap(:),             &
+      &                          cd_filter=cd_filter(:),             &
+      &                          cd_unt=cd_unt, dd_unf=dd_unf )
    
       ! add value
@@ -1431,6 +1516,10 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !>
    !> @param[in] cd_name         variable name
    !> @param[in] dd_value        1D array of real(8) value
@@ -1461,4 +1550,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -1471,5 +1565,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
       IMPLICIT NONE
       ! Argument
@@ -1499,4 +1595,9 @@
       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
@@ -1577,5 +1678,9 @@
       &                          ld_fletcher32=ld_fletcher32,        &
       &                          id_deflvl=id_deflvl,                &
-      &                          id_chunksz=id_chunksz(:))
+      &                          id_chunksz=id_chunksz(:),           &
+      &                          cd_interp=cd_interp(:),             &
+      &                          cd_extrap=cd_extrap(:),             &
+      &                          cd_filter=cd_filter(:),             &
+      &                          cd_unt=cd_unt, dd_unf=dd_unf )
    
       ! add value
@@ -1623,6 +1728,10 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !>
    !> @param[in] cd_name         variable name
    !> @param[in] dd_value        4D array of real(8) value
@@ -1653,4 +1762,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -1663,5 +1777,7 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf )
       IMPLICIT NONE
       ! Argument
@@ -1691,4 +1807,9 @@
       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
@@ -1723,5 +1844,9 @@
       &                       ld_fletcher32=ld_fletcher32,        &
       &                       id_deflvl=id_deflvl,                &
-      &                       id_chunksz=id_chunksz(:))
+      &                       id_chunksz=id_chunksz(:),           &
+      &                       cd_interp=cd_interp(:),             &
+      &                       cd_extrap=cd_extrap(:),             &
+      &                       cd_filter=cd_filter(:),             &
+      &                       cd_unt=cd_unt, dd_unf=dd_unf )
  
       ! add value
@@ -1758,5 +1883,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -1788,4 +1917,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -1798,5 +1932,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -1827,4 +1963,10 @@
       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
@@ -1870,5 +2012,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf )
  
       DEALLOCATE( dl_value )
@@ -1892,5 +2038,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         : variable name
@@ -1922,4 +2072,9 @@
    !> 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,5 +2087,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -1961,4 +2118,9 @@
       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
@@ -2006,5 +2168,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf )
       
       DEALLOCATE( dl_value )
@@ -2028,5 +2194,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         : variable name
@@ -2058,4 +2228,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -2068,5 +2243,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2097,4 +2274,9 @@
       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
@@ -2143,5 +2325,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -2165,5 +2351,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -2195,4 +2385,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -2205,5 +2400,7 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2234,4 +2431,9 @@
       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
@@ -2281,5 +2483,9 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:))
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -2303,5 +2509,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         : variable name
@@ -2333,4 +2543,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -2343,5 +2558,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2372,4 +2589,9 @@
       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
@@ -2415,5 +2637,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
  
       DEALLOCATE( dl_value )
@@ -2437,5 +2663,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -2465,4 +2695,9 @@
    !> @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
    !-------------------------------------------------------------------
@@ -2475,5 +2710,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2504,4 +2741,9 @@
       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
@@ -2549,5 +2791,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -2571,5 +2817,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -2601,4 +2851,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -2611,5 +2866,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2640,4 +2897,9 @@
       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
@@ -2686,5 +2948,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -2708,5 +2974,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -2738,4 +3008,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -2748,5 +3023,7 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2777,4 +3054,10 @@
       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
@@ -2824,5 +3107,9 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:))
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -2846,5 +3133,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -2876,4 +3167,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -2886,5 +3182,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2915,4 +3213,9 @@
       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
@@ -2958,5 +3261,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
  
       DEALLOCATE( dl_value )
@@ -2980,5 +3287,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3010,4 +3321,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -3020,5 +3336,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3049,4 +3367,9 @@
       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
@@ -3094,5 +3417,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -3116,5 +3443,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3146,4 +3477,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -3156,5 +3492,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3185,4 +3523,9 @@
       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
@@ -3231,5 +3574,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -3253,5 +3600,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3283,4 +3634,10 @@
    !> 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
    !-------------------------------------------------------------------
@@ -3293,5 +3650,7 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3322,4 +3681,9 @@
       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
@@ -3369,5 +3733,9 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:))
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -3391,5 +3759,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3421,4 +3793,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -3431,5 +3808,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3460,4 +3839,10 @@
       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
@@ -3503,5 +3888,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
  
       DEALLOCATE( dl_value )
@@ -3525,5 +3914,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3555,4 +3948,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -3565,5 +3963,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3594,4 +3994,10 @@
       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
@@ -3639,5 +4045,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -3661,5 +4071,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3691,4 +4105,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -3701,5 +4120,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3730,4 +4151,9 @@
       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
@@ -3776,5 +4202,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -3798,5 +4228,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3828,4 +4262,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -3838,5 +4277,7 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3867,4 +4308,9 @@
       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
@@ -3914,5 +4360,9 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:))
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -3936,5 +4386,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3966,4 +4420,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -3976,5 +4435,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -4005,4 +4466,9 @@
       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
@@ -4048,5 +4514,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
  
       DEALLOCATE( dl_value )
@@ -4070,5 +4540,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -4100,4 +4574,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -4110,5 +4589,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -4139,4 +4620,9 @@
       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
@@ -4184,5 +4670,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -4206,5 +4696,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -4236,4 +4730,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -4246,5 +4745,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -4275,4 +4776,9 @@
       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
@@ -4321,5 +4827,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -4343,5 +4853,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -4373,4 +4887,9 @@
    !> 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
    !-------------------------------------------------------------------
@@ -4383,5 +4902,7 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -4412,4 +4933,9 @@
       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
@@ -4459,5 +4985,9 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:))
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -4473,5 +5003,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4523,5 +5053,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4595,5 +5125,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4670,5 +5200,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4745,5 +5275,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4820,5 +5350,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - add all element of the array in the same time
    !>
    !> @param[inout] td_var variable structure
@@ -4833,4 +5365,7 @@
       ! local variable
       INTEGER(i4) :: il_natt
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
 
       ! loop indices
@@ -4840,7 +5375,103 @@
       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
-         CALL var_add_att(td_var, td_att(ji))
+         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
       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
@@ -4850,5 +5481,7 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - use var__add_att_arr subroutine
    !
    !> @param[inout] td_var variable structure
@@ -4862,117 +5495,14 @@
 
       ! local variable
-      INTEGER(i4) :: il_status
-      INTEGER(i4) :: il_ind
-      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
+      TYPE(TATT), DIMENSION(1) :: tl_att
 
       ! loop indices
-      INTEGER(i4) :: ji
       !----------------------------------------------------------------
 
-      ! 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
+      ! copy structure in an array
+      tl_att(1)=att_copy(td_att)
+
+      ! 
+      CALL var_add_att( td_var, tl_att(:) )
 
    END SUBROUTINE var__add_att_unit
@@ -4982,5 +5512,8 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - define local attribute structure to avoid mistake 
+   !> with pointer
    !
    !> @param[inout] td_var variable structure
@@ -4996,4 +5529,5 @@
       INTEGER(i4) :: il_ind
 
+      TYPE(TATT)  :: tl_att
       ! loop indices
       !----------------------------------------------------------------
@@ -5007,5 +5541,5 @@
       IF( il_ind == 0 )THEN
 
-         CALL logger_warn( &
+         CALL logger_debug( &
          &  " VAR DEL ATT: no attribute "//TRIM(cd_name)//&
          &  ", in variable "//TRIM(td_var%c_name) )
@@ -5013,5 +5547,6 @@
       ELSE
          
-         CALL var_del_att(td_var, td_var%t_att(il_ind))
+         tl_att=att_copy(td_var%t_att(il_ind))
+         CALL var_del_att(td_var, tl_att)
 
       ENDIF
@@ -5023,5 +5558,8 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013- Initial Version
+   !> @date February, 2015 
+   !> - delete highlight attribute too, when attribute 
+   !> is deleted
    !
    !> @param[inout] td_var variable structure
@@ -5040,5 +5578,4 @@
 
       ! loop indices
-      !INTEGER(i4) :: ji
       !----------------------------------------------------------------
 
@@ -5051,5 +5588,5 @@
       IF( il_ind == 0 )THEN
 
-         CALL logger_warn( &
+         CALL logger_debug( &
          &  " VAR DEL ATT: no attribute "//TRIM(td_att%c_name)//&
          &  ", in variable "//TRIM(td_var%c_name) )
@@ -5103,9 +5640,4 @@
                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(:))
@@ -5113,4 +5645,27 @@
             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
 
@@ -5121,5 +5676,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5156,5 +5711,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5195,5 +5750,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5211,5 +5766,5 @@
       !----------------------------------------------------------------
 
-      IF( td_var%i_ndim <= 4 )THEN
+      IF( td_var%i_ndim <= ip_maxdim )THEN
 
          ! check if dimension already used in variable structure
@@ -5227,6 +5782,7 @@
          ELSE
 
-         ! back to unorder dimension array 
-         CALL dim_unorder(td_var%t_dim(:))
+            ! back to disorder dimension array 
+            CALL dim_disorder(td_var%t_dim(:))
+
             ! add new dimension
             td_var%t_dim(td_var%i_ndim+1)=dim_copy(td_dim)
@@ -5253,5 +5809,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5272,5 +5828,5 @@
       !----------------------------------------------------------------
 
-      IF( td_var%i_ndim <= 4 )THEN
+      IF( td_var%i_ndim <= ip_maxdim )THEN
 
          CALL logger_trace( &
@@ -5317,5 +5873,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5360,5 +5916,5 @@
    !>
    !> @author J.Paul
-   !> - June, 2014- Initial Version
+   !> @date June, 2014 - Initial Version
    !
    !> @param[in] td_var array of variables structure
@@ -5386,5 +5942,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var    variable structure
@@ -5493,5 +6049,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -5631,5 +6187,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -5685,5 +6241,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5761,5 +6317,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variabele structure
@@ -5837,5 +6393,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variabele structure
@@ -5913,5 +6469,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variabele structure
@@ -5987,5 +6543,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -6057,5 +6613,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -6080,5 +6636,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] td_var       array of variable structure
@@ -6145,5 +6701,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var       array of variable structure
@@ -6200,5 +6756,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var array of variable structure
@@ -6239,5 +6795,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var array of variable structure
@@ -6322,5 +6878,7 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - new namelist format to get extra information (interpolation,...)
    !
    !> @param[in] cd_file   configuration file of variable
@@ -6357,5 +6915,4 @@
 
          il_fileid=fct_getunit()
-         CALL logger_trace("VAR DEF EXTRA: open "//TRIM(cd_file))
          OPEN( il_fileid, FILE=TRIM(cd_file), &
          &                FORM='FORMATTED',   &
@@ -6366,5 +6923,6 @@
          CALL fct_err(il_status)
          IF( il_status /= 0 )THEN
-            CALL logger_error("VAR DEF EXTRA: opening file "//TRIM(cd_file))
+            CALL logger_fatal("VAR DEF EXTRA: can not open file "//&
+            &                 TRIM(cd_file))
          ENDIF
 
@@ -6375,5 +6933,5 @@
          DO WHILE( il_status == 0 )
 
-         ! search line do not beginning with comment character
+         ! search line not beginning with comment character
             IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN
                il_nvar=il_nvar+1
@@ -6419,13 +6977,14 @@
                   tg_varextra(ji)%c_axis    =TRIM(fct_split(cl_line,3))
                   tg_varextra(ji)%c_point   =TRIM(fct_split(cl_line,4))
-                  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))
+
+                  cl_interp='int='//TRIM(fct_split(cl_line,5))
                   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(cl_interp))
+                  &  " "//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))
                ELSE
                   ji=ji-1
@@ -6458,5 +7017,5 @@
    !> @details 
    !> string character format must be : <br/>
-   !> "varname:interp; filter; extrap; > min; < max"<br/>
+   !> "varname:int=interp; flt=filter; ext=extrap; min=min; max=max"<br/>
    !> you could specify only interpolation, filter or extrapolation method, 
    !> whatever the order. you could find more
@@ -6464,6 +7023,10 @@
    !> \ref extrap module.<br/>
    !> Examples: 
-   !> cn_varinfo='Bathymetry:2*hamming(2,3); > 10.'
-   !> cn_varinfo='votemper:cubic; dist_weight; <40.'
+   !> 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
    !>
    !> @note If you do not specify a method which is required, default one is
@@ -6471,5 +7034,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - get unit and unit factor (to change unit) 
    !
    !> @param[in] cd_varinfo   variable information from namelist
@@ -6486,4 +7051,5 @@
       CHARACTER(LEN=lc), DIMENSION(1)              :: cl_extrap
       CHARACTER(LEN=lc), DIMENSION(5)              :: cl_filter
+      CHARACTER(LEN=lc)                            :: cl_unt
 
       INTEGER(i4)                                  :: il_ind
@@ -6492,4 +7058,5 @@
       REAL(dp)                                     :: dl_min
       REAL(dp)                                     :: dl_max
+      REAL(dp)                                     :: dl_unf
 
       TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE :: tl_varextra
@@ -6508,7 +7075,10 @@
             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))
@@ -6516,4 +7086,6 @@
                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(:)
@@ -6551,24 +7123,34 @@
                &                               cd_filter=cl_filter(:), &
                &                               dd_min = dl_min, &
-               &                               dd_max = dl_max )
+               &                               dd_max = dl_max, &
+               &                               cd_unt = cl_unt, &
+               &                               dd_unf = dl_unf )
 
             ENDIF
 
             ji=ji+1
-            CALL logger_trace( "VAR CHG EXTRA: name       "//&
+            CALL logger_debug( "VAR CHG EXTRA: name       "//&
             &                  TRIM(tg_varextra(il_ind)%c_name) )
-            CALL logger_trace( "VAR CHG EXTRA: interp     "//&
+            CALL logger_debug( "VAR CHG EXTRA: interp     "//&
             &                  TRIM(tg_varextra(il_ind)%c_interp(1)) )         
-            CALL logger_trace( "VAR CHG EXTRA: filter     "//&
+            CALL logger_debug( "VAR CHG EXTRA: filter     "//&
             &                  TRIM(tg_varextra(il_ind)%c_filter(1)) )         
-            CALL logger_trace( "VAR CHG EXTRA: extrap     "//&
+            CALL logger_debug( "VAR CHG EXTRA: extrap     "//&
             &                  TRIM(tg_varextra(il_ind)%c_extrap(1)) )
             IF( tg_varextra(il_ind)%d_min /= dp_fill )THEN
-               CALL logger_trace( "VAR CHG EXTRA: min value  "//&
+               CALL logger_debug( "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_trace( "VAR CHG EXTRA: max value  "//&
+               CALL logger_debug( "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
@@ -6593,5 +7175,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -6687,5 +7269,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -6808,13 +7390,16 @@
             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)))
+            ! 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
+
          ENDIF
 
@@ -6833,8 +7418,11 @@
    !> 
    !> @details
-   !> minimum value is assume to follow sign '>'
+   !> minimum value is assume to follow string "min ="
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "min ="
    !
    !> @param[in] cd_name      variable name
@@ -6867,7 +7455,7 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
-         il_ind=SCAN(TRIM(cl_tmp),'>')
+         il_ind=INDEX(TRIM(cl_tmp),'min')
          IF( il_ind /= 0 )THEN
-            cl_min=TRIM(ADJUSTL(cl_tmp(il_ind+1:)))
+            cl_min=fct_split(cl_tmp,2,'=')
             EXIT
          ENDIF
@@ -6877,5 +7465,5 @@
 
       IF( TRIM(cl_min) /= '' )THEN
-         IF( fct_is_num(cl_min) )THEN
+         IF( fct_is_real(cl_min) )THEN
             READ(cl_min,*) var__get_min
             CALL logger_debug("VAR GET MIN: will use minimum value of "//&
@@ -6894,8 +7482,11 @@
    !> 
    !> @details
-   !> maximum value is assume to follow sign '<'
+   !> maximum value is assume to follow string "max ="
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "max ="
    !
    !> @param[in] cd_name      variable name
@@ -6928,7 +7519,7 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
-         il_ind=SCAN(TRIM(cl_tmp),'<')
+         il_ind=INDEX(TRIM(cl_tmp),'max')
          IF( il_ind /= 0 )THEN
-            cl_max=TRIM(ADJUSTL(cl_tmp(il_ind+1:)))
+            cl_max=fct_split(cl_tmp,2,'=')
             EXIT
          ENDIF
@@ -6938,5 +7529,5 @@
 
       IF( TRIM(cl_max) /= '' )THEN
-         IF( fct_is_num(cl_max) )THEN
+         IF( fct_is_real(cl_max) )THEN
             READ(cl_max,*) var__get_max
             CALL logger_debug("VAR GET MAX: will use maximum value of "//&
@@ -6952,18 +7543,87 @@
    !> @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 
-   !> split namelist information, using ';' as separator.
+   !> interpolation method is assume to follow string "int ="
+   !>
    !> compare method name with the list of interpolation method available (see
    !> module global).
    !> check if factor (*rhoi, /rhoj..) are present.<br/>
    !> Example:<br/> 
-   !> - cubic/rhoi ; dist_weight
-   !> - bilin
+   !> - int=cubic/rhoi ; ext=dist_weight
+   !> - int=bilin
    !> see @ref interp module for more information.
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "int ="
    !
    !> @param[in] cd_name      variable name
@@ -6982,4 +7642,5 @@
       ! local variable
       CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_int
       CHARACTER(LEN=lc) :: cl_factor
       
@@ -7000,6 +7661,16 @@
       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_tmp),TRIM(cp_interp_list(jj)))
+            il_ind= INDEX(fct_lower(cl_int),TRIM(cp_interp_list(jj)))
             IF( il_ind /= 0 )THEN
 
@@ -7009,7 +7680,7 @@
                ! look for factor
                IF( il_ind==1 )THEN
-                  cl_factor=cl_tmp(il_len+1:)
+                  cl_factor=cl_int(il_len+1:)
                ELSE
-                  cl_factor=cl_tmp(1:il_ind-1)
+                  cl_factor=cl_int(1:il_ind-1)
                ENDIF
                il_mul=SCAN(TRIM(cl_factor),'*')
@@ -7052,8 +7723,5 @@
             ENDIF
          ENDDO
-         IF( jj /= ip_ninterp + 1 ) EXIT
-         ji=ji+1
-         cl_tmp=fct_split(cd_varinfo,ji,';')         
-      ENDDO
+      ENDIF
 
    END FUNCTION var__get_interp
@@ -7064,14 +7732,18 @@
    !> 
    !> @details 
-   !> split namelist information, using ';' as separator.
+   !> extrapolation method is assume to follow string "ext ="
+   !> 
    !> compare method name with the list of extrapolation method available (see
    !> module global).<br/>
    !> Example:<br/>
-   !> - cubic ; dist_weight
-   !> - min_error
+   !> - int=cubic ; ext=dist_weight
+   !> - ext=min_error
    !> see @ref extrap module for more information.
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "ext ="
    !
    !> @param[in] cd_name      variable name
@@ -7090,4 +7762,7 @@
       ! local variable
       CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_ext
+
+      INTEGER(i4)       :: il_ind
 
       ! loop indices
@@ -7101,6 +7776,16 @@
       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
+         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_tmp)) == TRIM(cp_extrap_list(jj)) )THEN
+            IF( TRIM(fct_lower(cl_ext)) == TRIM(cp_extrap_list(jj)) )THEN
                var__get_extrap(1)=TRIM(cp_extrap_list(jj))
 
@@ -7111,8 +7796,5 @@
             ENDIF
          ENDDO
-         IF( jj /= ip_nextrap + 1 ) EXIT
-         ji=ji+1
-         cl_tmp=fct_split(cd_varinfo,ji,';')         
-      ENDDO
+      ENDIF
 
 
@@ -7124,17 +7806,21 @@
    !> 
    !> @details 
-   !> split namelist information, using ';' as separator.
+   !> filter method is assume to follow string "flt ="
+   !>
    !> compare method name with the list of filter method available (see
    !> module global).
-   !> look for the number of turn, using '*' separator, and method parameters inside
+   !> look for the number of run, using '*' separator, and method parameters inside
    !> bracket.<br/>
    !> Example:<br/>
-   !> - cubic ; 2*hamming(2,3)
-   !> - hann
+   !> - int=cubic ; flt=2*hamming(2,3)
+   !> - flt=hann
    !> see @ref filter module for more information.
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "flt ="
+   !>
    !> @param[in] cd_name      variable name
    !> @param[in] cd_varinfo   variable information read in namelist 
@@ -7151,4 +7837,5 @@
       ! local variable
       CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_flt
       INTEGER(i4)       :: il_ind
 
@@ -7163,16 +7850,26 @@
       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_tmp),TRIM(cp_filter_list(jj)))
+            il_ind=INDEX(fct_lower(cl_flt),TRIM(cp_filter_list(jj)))
             IF( il_ind /= 0 )THEN
                var__get_filter(1)=TRIM(cp_filter_list(jj))
 
-               ! look for number of turn
-               il_ind=SCAN(fct_lower(cl_tmp),'*')
+               ! look for number of run
+               il_ind=SCAN(fct_lower(cl_flt),'*')
                IF( il_ind /=0 )THEN
-                  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:))
+                  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:))
                   ELSE
                      var__get_filter(2)='1'
@@ -7183,16 +7880,16 @@
 
                ! look for filter parameter
-               il_ind=SCAN(fct_lower(cl_tmp),'(')
+               il_ind=SCAN(fct_lower(cl_flt),'(')
                IF( il_ind /=0 )THEN
-                  cl_tmp=TRIM(cl_tmp(il_ind+1:))
-                  il_ind=SCAN(fct_lower(cl_tmp),')')
+                  cl_flt=TRIM(cl_flt(il_ind+1:))
+                  il_ind=SCAN(fct_lower(cl_flt),')')
                   IF( il_ind /=0 )THEN
-                     cl_tmp=TRIM(cl_tmp(1:il_ind-1))
+                     cl_flt=TRIM(cl_flt(1:il_ind-1))
                      ! look for cut-off frequency
-                     var__get_filter(3)=fct_split(cl_tmp,1,',')
+                     var__get_filter(3)=fct_split(cl_flt,1,',')
                      ! look for halo size
-                     var__get_filter(4)=fct_split(cl_tmp,2,',')
+                     var__get_filter(4)=fct_split(cl_flt,2,',')
                      ! look for alpha parameter
-                     var__get_filter(5)=fct_split(cl_tmp,3,',')
+                     var__get_filter(5)=fct_split(cl_flt,3,',')
                   ELSE
                      CALL logger_error("VAR GET FILTER: variable "//&
@@ -7215,10 +7912,61 @@
             ENDIF
          ENDDO
-         IF( jj /= ip_nfilter + 1 ) EXIT
+      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
          ji=ji+1
          cl_tmp=fct_split(cd_varinfo,ji,';')         
       ENDDO
 
-   END FUNCTION var__get_filter
+      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
    !-------------------------------------------------------------------
    !> @brief 
@@ -7227,5 +7975,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var array of variable structure
@@ -7285,5 +8033,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -7321,4 +8069,55 @@
    !-------------------------------------------------------------------
    !> @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'.
@@ -7329,5 +8128,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var    variable structure
@@ -7414,5 +8213,7 @@
    !> 
    !> @author J.Paul
-   !> - August, 2014- Initial Version
+   !> @date August, 2014 - Initial Version
+   !> @date July 2015 
+   !> - do not use dim_disorder anymore
    !
    !> @param[inout] td_var       variable structure
@@ -7438,7 +8239,9 @@
       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))
 
@@ -7467,5 +8270,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[in] td_var array of variable structure 
@@ -7492,5 +8295,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !
    !> @param[in] td_var time variable structure 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/vgrid.f90
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/vgrid.f90	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/vgrid.f90	(revision 6808)
@@ -70,4 +70,5 @@
 !> @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)
@@ -118,5 +119,5 @@
    !>
    !> @author G. Madec
-   !> - 03,08-  G. Madec: F90: Free form and module
+   !> @date Marsh,2008 - F90: Free form and module
    !
    !> @note Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
@@ -139,4 +140,5 @@
    !-------------------------------------------------------------------
    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, &
@@ -148,4 +150,6 @@
       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
@@ -226,5 +230,5 @@
          DO jk = 1, il_jpk
             dl_zw = REAL(jk,dp)
-            dl_zt = REAL(jk,dp) + 0.5
+            dl_zt = REAL(jk,dp) + 0.5_dp
             dd_gdepw(jk) = ( dl_zw - 1.0 ) * dl_za1
             dd_gdept(jk) = ( dl_zt - 1.0 ) * dl_za1
@@ -237,5 +241,5 @@
          DO jk = 1, il_jpk
             dl_zw = REAL( jk,dp)
-            dl_zt = REAL( jk,dp) + 0.5
+            dl_zt = REAL( jk,dp) + 0.5_dp
             dd_gdepw(jk) = ( dl_zsur + dl_za0 * dl_zw + &
             &                dl_za1 * dl_zacr * LOG( COSH( (dl_zw-dl_zkth)/dl_zacr ) ) + &
@@ -255,4 +259,17 @@
       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
       ! ==================
@@ -260,6 +277,10 @@
       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
@@ -269,4 +290,43 @@
 
    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
@@ -313,6 +373,7 @@
    !
    !> @author A. Bozec, G. Madec
-   !> - 02-09 (A. Bozec, G. Madec) F90: Free form and module
-   !> - 02-09 (A. de Miranda)  rigid-lid + islands
+   !> @date February, 2009 - F90: Free form and module
+   !> @date February, 2009 
+   !> - A. de Miranda : rigid-lid + islands
    !>
    !> @note Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
@@ -327,6 +388,7 @@
    !-------------------------------------------------------------------
    SUBROUTINE vgrid_zgr_zps( id_mbathy, dd_bathy, id_jpkmax, &
-   &                         dd_gdepw, dd_e3t,               &
-   &                         dd_e3zps_min, dd_e3zps_rat )
+   &                          dd_gdepw, dd_e3t,               &
+   &                          dd_e3zps_min, dd_e3zps_rat,     &
+   &                          dd_fill )
       IMPLICIT NONE
       ! Argument      
@@ -336,11 +398,13 @@
       REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw
       REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_e3t
-      REAL(dp)                                   :: dd_e3zps_min
-      REAL(dp)                                   :: dd_e3zps_rat
+      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_min
+      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_rat
+      REAL(dp)                   , INTENT(IN   ), OPTIONAL :: dd_fill
 
       ! 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
@@ -359,7 +423,14 @@
       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)
-      dl_zmin = dd_gdepw(4)
+      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
 
       ! bathymetry in level (from bathy_meter)
@@ -372,19 +443,8 @@
       DO jj = 1, il_jpjglo
          DO ji= 1, il_jpiglo
-            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 )
+            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
             ENDIF
          END DO
@@ -401,5 +461,8 @@
          DO jj = 1, il_jpjglo
             DO ji = 1, il_jpiglo
-               IF( 0. < dd_bathy(ji,jj) .AND. dd_bathy(ji,jj) <= dl_zdepth ) id_mbathy(ji,jj) = jk-1
+               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
             END DO
          END DO
@@ -434,5 +497,5 @@
 
    !> @author G.Madec
-   !> - 03-08 Original code
+   !> @date Marsh, 2008 - Original code
    !
    !> @param[in] id_mbathy 
@@ -543,5 +606,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_bathy     Bathymetry file structure 
@@ -567,4 +630,6 @@
       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
@@ -710,5 +775,7 @@
       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/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam	(revision 6808)
@@ -19,6 +19,6 @@
 
 &namvar
+   cn_varfile=
    cn_varinfo=
-   cn_varfile=
 /
 
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam	(revision 6808)
@@ -60,8 +60,9 @@
    cn_west  = 
    ln_oneseg= 
-   in_extrap= 
 /
 
 &namout
    cn_fileout="boundary_out.nc"      
+   dn_dayofs=
+   ln_extrap=
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam	(revision 6808)
@@ -12,4 +12,10 @@
    cn_coord0=
    in_perio0=
+/
+
+&namfin
+   cn_coord1=
+   cn_bathy1=
+   in_perio1=
 /
 
@@ -34,11 +40,4 @@
 /
 
-&namfin
-   cn_coord1=
-   cn_bathy1=
-   in_perio1=
-   in_extrap=
-/
-
 &namvar
    cn_varinfo=
@@ -53,3 +52,8 @@
 &namout
    cn_fileout="restart_out.nc"      
+   ln_extrap=
+   in_nipro=
+   in_njproc=
+   in_nproc=
+   cn_type=
 /
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/batch/X64_ADA.sh
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/batch/X64_ADA.sh	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/batch/X64_ADA.sh	(revision 6808)
@@ -0,0 +1,21 @@
+#!/bin/bash
+
+# Nom de la requete
+# @ job_name = NEMO_CI
+# Type de travail
+# @ job_type = parallel
+# Fichier de sortie standard
+# @ output = $(job_name)_$(jobid)
+# Fichier de sortie erreur
+# @ error  = $(job_name)_$(jobid)
+# Nombre de processus demande
+# @ total_tasks = 32
+# Temps CPU max. par processus MPI hh:mm:ss
+# @ wall_clock_limit = 0:30:00
+# Fin de l entete
+# @ queue
+
+cd $LOADL_STEP_INITDIR
+
+# running the job in parallel mode
+poe ./opa
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/batch/X64_CURIE.sh
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/batch/X64_CURIE.sh	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/batch/X64_CURIE.sh	(revision 6808)
@@ -0,0 +1,14 @@
+#!/bin/bash
+
+#Config ccc_msub
+#MSUB -A  gen7451
+#MSUB -r  NEMO_CI
+#MSUB -o  NEMO_CI_%I
+#MSUB -e  NEMO_CI_%I
+#MSUB -oe
+#MSUB -q  xlarge
+#MSUB -n  128
+#MSUB -N  1
+#MSUB -T  1800
+##MSUB -@  ntmlod@locean-ipsl.upmc.fr:begin,end
+ccc_mprun ./opa
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/X64_ADA.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/X64_ADA.cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/X64_ADA.cfg	(revision 6808)
@@ -0,0 +1,34 @@
+## Ada configuration
+##---------------------------------------------------
+
+
+## Default settings
+##---------------------------------------------------
+TRUS_ENVI=${TRUS_XIOS}/arch/arch-${TRUS_HPCC}
+
+TRUS_CDOD='cdo diffn'
+
+[ -z "${TRUS_NPRO}" ] && TRUS_NPRO='16'
+[ -z "${TRUS_TOUT}" ] && TRUS_TOUT='10800'
+
+
+## (Super)computer environment
+##---------------------------------------------------
+TRUS_JSPT=${TRUS_HPCC}.sh
+TRUS_JSUB="llsubmit ${TRUS_JSPT} | grep -oe '\<[0-9]*\>'"
+TRUS_JINF="llq -x \${TRUS_JIDN}"
+TRUS_JSTA="llq      | grep \${TRUS_JIDN}"
+TRUS_JKIL="llcancel        \${TRUS_JIDN}"
+
+TRUS_JTIM="grep IdrisMemMPI NEMO_CI_\${TRUS_JIDN} | cut -d, -f1 | awk '{print \$(NF-1),\$NF}'"
+TRUS_JPME="grep IdrisMemMPI NEMO_CI_\${TRUS_JIDN} | cut -d, -f3 | awk '{print \$3     ,\$4 }'"
+TRUS_JVME="grep IdrisMemMPI NEMO_CI_\${TRUS_JIDN} | cut -d, -f2 | awk '{print \$3     ,\$4 }'"
+
+TRUS_CMPV='ifort'
+TRUS_CDOR='cdo/'
+TRUS_MPIR='intel/impi/'
+TRUS_CDFR='netcdf/'
+
+PATH='/smplocal/pub/cdo/1.5.9/bin':$PATH
+## Not working with module delimiter ':'
+#WRAPPER_LDFLAGS='-L/smplocal/pub/IdrMemMPI/1.4/lib -lidrmem '${WRAPPER_LDFLAGS}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/X64_CURIE.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/X64_CURIE.cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/X64_CURIE.cfg	(revision 6808)
@@ -0,0 +1,32 @@
+## Curie configuration
+##---------------------------------------------------
+
+
+## Default settings
+##---------------------------------------------------
+TRUS_ENVI=${TRUS_XIOS}/arch/arch-${TRUS_HPCC}
+
+TRUS_CDOD='cdo diffn'
+
+[ -z "${TRUS_NPRO}" ] && TRUS_NPRO='16'
+[ -z "${TRUS_TOUT}" ] && TRUS_TOUT='10800'
+
+
+## (Super)computer environment
+##---------------------------------------------------
+TRUS_JSPT=${TRUS_HPCC}.sh
+TRUS_JSUB="ccc_msub ${TRUS_JSPT} | grep -oe '\<[0-9]*\>'"
+TRUS_JINF="ccc_macct \${TRUS_JIDN}"
+TRUS_JSTA="ccc_mpp  | grep \${TRUS_JIDN}"
+TRUS_JKIL="ccc_mdel        \${TRUS_JIDN}"
+
+TRUS_JTIM="ccc_macct \${TRUS_JIDN} | grep     \"\${TRUS_JIDN}.0 *opa\" | awk '{print               \$9      }'"
+TRUS_JPME="ccc_macct \${TRUS_JIDN} | grep -m1 \"\${TRUS_JIDN}.0\"      | awk '{printf \"%d Mo\n\", \$2; exit}'"
+TRUS_JVME="ccc_macct \${TRUS_JIDN} | grep -m1 \"\${TRUS_JIDN}.0\"      | awk '{printf \"%d Go\n\", \$7; exit}'"
+
+TRUS_CMPV='ifort'
+TRUS_CDOR='netcdf-utils-'
+TRUS_MPIR='bullxmpi/'
+TRUS_CDFR='netcdf-'
+
+PATH='/usr/local/netcdf-utils-4.3.3.1_hdf5/bin':$PATH
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/arch_template.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/arch_template.cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/arch_template.cfg	(revision 6808)
@@ -0,0 +1,50 @@
+## (Super)Computer configuration template
+##---------------------------------------------------
+
+## Copy to root, rename it and then fill in according to your (super)computer environment
+## Rules for completion: undefined variables (=) are mandatory & void variables (='') are optional
+## Look into other configuration file for examples
+
+
+## Default settings
+##---------------------------------------------------
+# (Super)Computer environment (${TRUS_XIOS} is already defined in the user configuration file)
+TRUS_ENVI=${TRUS_XIOS}/arch/arch-${TRUS_HPCC}
+## If `module` is available, ${TRUS_ENVI}.env will be sourced
+## If not (scheduled jobs), it will be ${TRUS_ENVI}.path or finally ${TRUS_ENVI}
+
+## Comparison command with restart files as argument (think to append $PATH by any way)
+TRUS_CDOD='cdo diffn'
+
+[ -z "${TRUS_NPRO}" ] && TRUS_NPRO=     ## Number of compiling processes
+[ -z "${TRUS_TOUT}" ] && TRUS_TOUT=     ## Timeout for computation (s)
+
+
+## (Super)computer environment
+##---------------------------------------------------
+## Job commands will almost always be used with `eval ${TRUS_JXXX}` because
+## they will certainly need job ID number as argument for working
+TRUS_JSPT=       ## Submission script contained ./batch folder, will be copied to testing folder
+TRUS_JSUB=	 ## Submit a job and get his ID on the fly (assigned to ${TRUS_JIDN})
+        	   ## ex: `llsubmit ${TRUS_JSPT} | grep -oe '\<[0-9]*\>'`
+TRUS_JSTA=   	 ## Test state of the submitted job (true -> pending/running or false -> completed/crashed)
+                   ## ex: "llq | grep \${TRUS_JIDN}"
+TRUS_JKIL=   	 ## Kill the submitted job
+                   ## ex: "llcancel   \${TRUS_JIDN}"
+
+## Computational performances of job (respectively elapsed time, max physical & virtual memory)
+TRUS_JTIM=''       ## ex: "grep IdrisMemMPI NEMO_CI_\${TRUS_JIDN} | cut -d, -f1 | awk '{print \$(NF-1),\$NF}"
+TRUS_JPME=''       ## ex: "grep IdrisMemMPI NEMO_CI_\${TRUS_JIDN} | cut -d, -f3 | awk '{print \$3     ,\$4 }"
+TRUS_JVME=''       ## ex: "grep IdrisMemMPI NEMO_CI_\${TRUS_JIDN} | cut -d, -f2 | awk '{print \$3     ,\$4 }"
+
+TRUS_JINF=''   	 ## Get job informations to fill in a logfile during computation
+                   ## ex: "llq -x \${TRUS_JIDN}"
+
+## Compiler (use with `${TRUS_CMPV} --version`)
+TRUS_CMPV=''       ## ex: 'ifort'|'gfortran'|'pgfortran'|...
+
+## Software/libraries (string pattern to match just before the release number in $PATH)
+## Respectively CDO (Climate Data Operators) / MPI libraries / NetCDF libraries
+TRUS_CDOR=''       ## ex: 'cdo/'|'netcdf-utils-'
+TRUS_MPIR=''       ## ex: 'intel/impi/'|'bullxmpi/'
+TRUS_CDFR=''       ## ex: 'netcdf/'|'netcdf-'
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/martin.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/martin.cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/martin.cfg	(revision 6808)
@@ -0,0 +1,35 @@
+## Installation for trusting tests on Curie Supercomputer
+##---------------------------------------------------
+
+
+## Default settings
+##---------------------------------------------------
+[ -z "${TRUS_BRAN}" ] && TRUS_BRAN='trunk'
+TRUS_CKOT=( 'ARCH           CONFIG          NEMO               \
+             EXTERNAL/AGRIF EXTERNAL/fcm    EXTERNAL/IOIPSL    \
+             TOOLS/COMPILE  TOOLS/maketools TOOLS/REBUILD_NEMO  ' )
+
+[ -z "${TRUS_REFE}" ] && TRUS_REFE='ORCA2_LIM_PISCES'
+TRUS_CONF=${TRUS_REFE}'_trust'
+
+[ -z "${TRUS_TARF}" ] && TRUS_TARF='ORCA2_LIM_nemo_v3.6.tar'
+[ ${TRUS_REFE} == 'ORCA1_LIM3_PISCES' ] && TRUS_TARF='INPUTS_ORCA1_LIM3_PISCES_V6.tar'
+[ ${TRUS_REFE} == 'AMM12'             ] && TRUS_TARF='AMM12_v3.6.tar'
+
+TRUS_KEYA=''; TRUS_KEYD=''
+[ ${TRUS_REFE} == 'ORCA2_LIM' ] && TRUS_KEYA='key_add key_agrif' && TRUS_KEYD='key_del key_zdftmx'
+
+
+## User environment
+##---------------------------------------------------
+TRUS_WORK=$CCCWORKDIR/NEMO
+TRUS_SCRA=$SCRATCHDIR/NEMO/trusting/${TRUS_REFE}/${TRUS_BRAN}/${DATE}
+TRUS_STOR=$CCCSTOREDIR/NEMO/trusting_sav/${TRUS_REFE}/${TRUS_BRAN}
+TRUS_FORC=$CCCWORKDIR/NEMO/FORC
+TRUS_XIOS=$CCCWORKDIR/XIOS/xios-1.0
+
+[ ${TRUS_REFE} == 'ORCA2_LIM_PISCES'  ] && TRUS_CONF='O2LP_trust'
+[ ${TRUS_REFE} == 'ORCA1_LIM3_PISCES' ] && TRUS_CONF='O1L3P_trust'
+[ ${TRUS_REFE} == 'ORCA2_LIM'         ] && TRUS_CONF='O2LA_trust'
+
+[ -z "${TRUS_MAIL}" ] && TRUS_MAIL='ntmlod@locean-ipsl.upmc.fr'
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/romr005.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/romr005.cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/romr005.cfg	(revision 6808)
@@ -0,0 +1,35 @@
+## Installation for trusting tests on Ada Supercomputer
+##---------------------------------------------------
+
+
+## Default settings
+##---------------------------------------------------
+[ -z "${TRUS_BRAN}" ] && TRUS_BRAN='trunk'
+TRUS_CKOT=( 'ARCH           CONFIG          NEMO               \
+             EXTERNAL/AGRIF EXTERNAL/fcm    EXTERNAL/IOIPSL    \
+             TOOLS/COMPILE  TOOLS/maketools TOOLS/REBUILD_NEMO  ' )
+
+[ -z "${TRUS_REFE}" ] && TRUS_REFE='ORCA2_LIM_PISCES'
+TRUS_CONF=${TRUS_REFE}'_trust'
+
+[ -z "${TRUS_TARF}" ] && TRUS_TARF='ORCA2_LIM_nemo_v3.6.tar'
+[ ${TRUS_REFE} == 'ORCA1_LIM3_PISCES' ] && TRUS_TARF='INPUTS_ORCA1_LIM3_PISCES_V6.tar'
+[ ${TRUS_REFE} == 'AMM12'             ] && TRUS_TARF='AMM12_v3.6.tar'
+
+TRUS_KEYA=''; TRUS_KEYD=''
+[ ${TRUS_REFE} == 'ORCA2_LIM' ] && TRUS_KEYA='key_add key_agrif' && TRUS_KEYD='key_del key_zdftmx'
+
+
+## User environment
+##---------------------------------------------------
+TRUS_WORK=$WORKDIR/NEMO
+TRUS_SCRA=$WORKDIR/NEMO/trusting/${TRUS_REFE}/${TRUS_BRAN}/${DATE}
+TRUS_STOR=$WORKDIR/NEMO/trusting_sav/${TRUS_REFE}/${TRUS_BRAN}
+TRUS_FORC=$WORKDIR/NEMO/FORC
+TRUS_XIOS=$WORKDIR/XIOS/xios-1.0
+
+[ ${TRUS_REFE} == 'ORCA2_LIM_PISCES'  ] && TRUS_CONF='O2LP_trust'
+[ ${TRUS_REFE} == 'ORCA1_LIM3_PISCES' ] && TRUS_CONF='O1L3P_trust'
+[ ${TRUS_REFE} == 'ORCA2_LIM'         ] && TRUS_CONF='O2LA_trust'
+
+[ -z "${TRUS_MAIL}" ] && TRUS_MAIL='ntmlod@locean-ipsl.upmc.fr'
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/user_template.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/user_template.cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/config/user_template.cfg	(revision 6808)
@@ -0,0 +1,49 @@
+## User configuration template
+##---------------------------------------------------
+
+## Copy to root, rename it and then fill in according to your user environment
+## Rules for completion: undefined variables (=) are mandatory & void variables (='') are optional
+## Look into other configuration file for examples
+
+
+## Default settings
+##---------------------------------------------------
+## These settings can be changed directly from command line to reduce number of user configuration file
+## See `./trusting.sh [-h|--help]`
+
+## SVN branch name ('trunk', 'nemo_v3_6_STABLE', development branches)
+[ -z "${TRUS_BRAN}" ] && TRUS_BRAN='trunk'
+
+## Minimal content for code checkout/update
+TRUS_CKOT=( 'ARCH           CONFIG          NEMO               \
+             EXTERNAL/AGRIF EXTERNAL/fcm    EXTERNAL/IOIPSL    \
+             TOOLS/COMPILE  TOOLS/maketools TOOLS/REBUILD_NEMO  ' )
+
+[ -z "${TRUS_REFE}" ] && TRUS_REFE='ORCA2_LIM_PISCES'     ## Reference configuration to test
+TRUS_CONF=${TRUS_REFE}'_trust'                            ## Testing configuration name
+
+## Forcing archive, let void if just need to copy the files inside ${TRUS_FORC}
+[ -z "${TRUS_TARF}" ] && TRUS_TARF='ORCA2_LIM_nemo_v3.6.tar'
+[ ${TRUS_REFE} == 'ORCA1_LIM3_PISCES' ] && TRUS_TARF='INPUTS_ORCA1_LIM3_PISCES_V6.tar'
+[ ${TRUS_REFE} == 'AMM12'             ] && TRUS_TARF='AMM12_v3.6.tar'
+
+## CPP keys to add or remove from reference configuration
+TRUS_KEYA=''; TRUS_KEYD=''
+[ ${TRUS_REFE} == 'ORCA2_LIM' ] && TRUS_KEYA='key_add key_agrif' && TRUS_KEYD='key_del key_zdftmx'
+
+
+## User environment
+##---------------------------------------------------
+TRUS_WORK=     ## Testing folder for compilation (branches checkouts & configuration compilation)
+TRUS_SCRA=     ##   " "     ""   " " computation
+                 ## ...../${TRUS_REFE}/${TRUS_BRAN}/${DATE} recommended
+TRUS_STOR=     ## Benchmark folder where target files for comparison have been stored, ie:
+               ## Inputs  (all) : CPP_*, namelist_*, *.xml et inputs_list.txt (created by initial test)
+               ## Outputs (any) : *.stat, ocean.output, restarts
+                 ## ...../${TRUS_REFE}/${TRUS_BRAN} recommended (same layout as ${TRUS_SCRA})
+TRUS_FORC=     ## Path to the forcing archive to extract (usage combined with ${TRUS_TARF}) or
+               ##    ""   all inputs files who will be copied into ${TRUS_SCRA}
+TRUS_XIOS=     ## XIOS installation
+
+## Mailing list to notify on failure (-p|--prod option required)
+[ -z "${TRUS_MAIL}" ] && TRUS_MAIL=''
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/cron/ada.env
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/cron/ada.env	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/cron/ada.env	(revision 6808)
@@ -0,0 +1,53 @@
+## Set Ada environment for trusting scheduled job
+
+## Equivalent of source arch-X64_ADA.env with module commands
+PATH='/smplocal/intel/composer_xe_2013.1.117/bin/intel64:/smplocal/intel/composer_xe_2013.1.117/bin/intel64_mic:/smplocal/intel/composer_xe_2013.1.117/debugger/gui/intel64:/smplocal/intel/composer_xe_2013.1.117/bin/intel64:/smplocal/intel/composer_xe_2013.1.117/mpirt/bin/intel64:/smplocal/intel/impi/4.1.0.024/intel64/bin:/smplocal/pub/Modules/IDRIS/wrappers:/smplocal/pub/NetCDF/4.1.3/mpi/bin':$PATH
+LD_LIBRARY_PATH='/smplocal/intel/composer_xe_2013.1.117/compiler/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/mkl/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/compiler/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/mpirt/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/ipp/../compiler/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/ipp/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/tbb/lib/intel64:/smplocal/intel/impi/4.1.0.024/intel64/lib':${LD_LIBRARY_PATH}
+INCLUDE='/smplocal/intel/composer_xe_2013.1.117/mkl/include':$INCLUDE
+
+## Wrapper flags
+WRAPPER_CXXFLAGS='-I/smplocal/pub/NetCDF/4.1.3/mpi/include'
+WRAPPER_FFLAGS='-I/smplocal/pub/NetCDF/4.1.3/mpi/include'
+WRAPPER_LDFLAGS='-L/smplocal/pub/NetCDF/4.1.3/mpi/lib -Bstatic -lnetcdff -lnetcdf -lnetcdf_c++ -Bdynamic -L/smplocal/pub/HDF5/1.8.9/par/lib -Bstatic -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -Bdynamic -lz'
+
+## IDRIS files systems (no need with `at`)
+#WORKDIR=/workgpfs/rech/omr/$USER
+#COMMONDIR=/workgpfs/rech/omr/commun
+#TMPDIR=
+
+## Intel license
+INTEL_LICENSE_FILE='/smplocal/intel/composer_xe_2013.1.117/licenses:/smplocal/intel/licenses:/linkhome/rech/omr/romr005/intel/licenses'
+
+## Trusting
+TRUS_HPCC='X64_ADA'
+
+## Export to environment
+export PATH LD_LIBRARY_PATH INCLUDE
+export WRAPPER_CXXFLAGS WRAPPER_FFLAGS WRAPPER_LDFLAGS
+#export WORKDIR COMMONDIR TMPDIR
+export INTEL_LICENSE_FILE
+export TRUS_HPCC
+
+
+#-------------------------------------------------------------------
+#/smplocal/pub/Modules/IDRIS/modulefiles/environnement/intel/2013.0:
+#prepend-path	 PATH               /smplocal/intel/composer_xe_2013.1.117/bin/intel64:/smplocal/intel/composer_xe_2013.1.117/bin/intel64_mic:/smplocal/intel/composer_xe_2013.1.117/debugger/gui/intel64 
+#prepend-path	 PATH               /smplocal/intel/composer_xe_2013.1.117/bin/intel64:/smplocal/intel/composer_xe_2013.1.117/mpirt/bin/intel64 
+#prepend-path	 PATH               /smplocal/intel/impi/4.1.0.024/intel64/bin 
+#prepend-path	 PATH               /smplocal/pub/Modules/IDRIS/wrappers 
+#prepend-path	 LD_LIBRARY_PATH    /smplocal/intel/composer_xe_2013.1.117/tbb/lib/intel64 
+#prepend-path	 LD_LIBRARY_PATH    /smplocal/intel/composer_xe_2013.1.117/compiler/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/mkl/lib/intel64 
+#prepend-path	 LD_LIBRARY_PATH    /smplocal/intel/composer_xe_2013.1.117/ipp/../compiler/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/ipp/lib/intel64 
+#prepend-path	 LD_LIBRARY_PATH    /smplocal/intel/composer_xe_2013.1.117/compiler/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/mpirt/lib/intel64 
+#prepend-path	 LD_LIBRARY_PATH    /smplocal/intel/impi/4.1.0.024/intel64/lib 
+#prepend-path	 INCLUDE            /smplocal/intel/composer_xe_2013.1.117/mkl/include 
+#append-path	 INTEL_LICENSE_FILE /smplocal/intel/composer_xe_2013.1.117/licenses:/smplocal/intel/licenses:/linkhome/rech/omr/romr005/intel/licenses 
+#-------------------------------------------------------------------
+#-------------------------------------------------------------------
+#/smplocal/pub/Modules/IDRIS/modulefiles/bibliotheques/netcdf/mpi/4.1.3:
+#prepend-path	 PATH               /smplocal/pub/NetCDF/4.1.3/mpi/bin 
+#prepend-path	 PATH               /smplocal/pub/Modules/IDRIS/wrappers 
+#prepend-path	 WRAPPER_FFLAGS     -I/smplocal/pub/NetCDF/4.1.3/mpi/include 
+#prepend-path	 WRAPPER_CXXFLAGS   -I/smplocal/pub/NetCDF/4.1.3/mpi/include 
+#prepend-path	 WRAPPER_LDFLAGS    -L/smplocal/pub/NetCDF/4.1.3/mpi/lib -Bstatic -lnetcdff -lnetcdf -lnetcdf_c++ -Bdynamic -L/smplocal/pub/HDF5/1.8.9/par/lib -Bstatic -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -Bdynamic -lz
+#-------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/cron/curie.env
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/cron/curie.env	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/cron/curie.env	(revision 6808)
@@ -0,0 +1,74 @@
+## Set Curie environment for trusting scheduled job
+
+## Equivalent of source arch-X64_CURIE.env with module commands
+PATH='/usr/local/ccc_users_env/bin:/opt/intel/14.0.3.174/bin/intel64:/opt/mpi/bullxmpi/1.2.8.2/bin:/usr/local/netcdf-4.3.3.1_hdf5_parallel/bin:/ccc/cont003/home/dsm/p86ipsl/bin':$PATH
+LD_LIBRARY_PATH='/lib64:/lib:/usr/lib64:/usr/lib:/opt/intel/14.0.3.174/compiler/lib/intel64:/usr/local/intel-14.0.3.174/14.0.3.174/mkl/lib/intel64:/opt/intel/14.0.3.174/debugger/lib/intel64:/opt/mpi/bullxmpi/1.2.8.2/lib:/usr/local/netcdf-4.3.3.1_hdf5_parallel/lib':${LD_LIBRARY_PATH}
+
+## NetCDF installation
+NETCDF_INCDIR='/usr/local/netcdf-4.3.3.1_hdf5_parallel/include'
+NETCDF_LDFLAGS='-L/usr/local/netcdf-4.3.3.1_hdf5_parallel/lib -lnetcdf'
+NETCDF_LIBDIR='/usr/local/netcdf-4.3.3.1_hdf5_parallel/lib'
+
+## TGCC files systems
+CCCWORKDIR=/ccc/work/cont003/gen7451/$USER
+SCRATCHDIR=/ccc/scratch/cont003/gen7451/$USER
+CCCSTOREDIR=/ccc/store/cont003/gen7451/$USER
+
+## Intel license
+LM_LICENSE_FILE='27000@licintel.ccc.cea.fr'
+
+## Trusting
+TRUS_HPCC='X64_CURIE'
+
+## Export to environment
+export PATH LD_LIBRARY_PATH
+export NETCDF_INCDIR NETCDF_LDFLAGS NETCDF_LIBDIR
+export CCCWORKDIR SCRATCHDIR CCCSTOREDIR
+export LM_LICENSE_FILE
+export TRUS_HPCC
+
+#-------------------------------------------------------------------
+#/opt/Modules/default/modulefiles/environment/ccc:
+#append-path	PATH    	/usr/local/ccc_users_env/bin
+#prepend-path	LD_LIBRARY_PATH	/lib64:/lib:/usr/lib64:/usr/lib
+#-------------------------------------------------------------------
+#-------------------------------------------------------------------
+#/opt/Modules/default/modulefiles/environment/dfldatadir/own:
+#setenv		CCCSTOREDIR	/ccc/store/cont003/gen7451/martin
+#setenv		CCCWORKDIR	/ccc/work/cont003/gen7451/martin
+#setenv		SCRATCHDIR	/ccc/scratch/cont003/gen7451/martin
+#-------------------------------------------------------------------
+#-------------------------------------------------------------------
+#/opt/Modules/default/modulefiles/environment/licsrv/intel:
+#append-path	LM_LICENSE_FILE	27000@licintel.ccc.cea.fr
+#-------------------------------------------------------------------
+#-------------------------------------------------------------------
+#/opt/Modules/default/modulefiles/compilers/intel/14.0.3.174:
+#module load	c/intel/14.0.3.174
+#prepend-path	PATH    	/opt/intel/14.0.3.174/bin/intel64
+#prepend-path	LD_LIBRARY_PATH	/opt/intel/14.0.3.174/compiler/lib/intel64
+#module load	c++/intel/14.0.3.174
+#prepend-path	PATH    	/opt/intel/14.0.3.174/bin/intel64
+#prepend-path	LD_LIBRARY_PATH	/opt/intel/14.0.3.174/compiler/lib/intel64
+#module load	fortran/intel/14.0.3.174
+#append-path	PATH    	/opt/intel/14.0.3.174/bin/intel64
+#prepend-path	LD_LIBRARY_PATH	/opt/intel/14.0.3.174/compiler/lib/intel64
+#module load	mkl/14.0.3.174
+#append-path	LD_LIBRARY_PATH	/usr/local/intel-14.0.3.174/14.0.3.174/mkl/lib/intel64
+#module load	idb/14.0.3.174
+#prepend-path	PATH    	/opt/intel/14.0.3.174/bin/intel64
+#append-path	LD_LIBRARY_PATH	/opt/intel/14.0.3.174/debugger/lib/intel64
+#-------------------------------------------------------------------
+#-------------------------------------------------------------------
+#/opt/Modules/default/modulefiles/parallel/bullxmpi/1.2.8.2:
+#prepend-path	PATH    	/opt/mpi/bullxmpi/1.2.8.2/bin
+#prepend-path	LD_LIBRARY_PATH	/opt/mpi/bullxmpi/1.2.8.2/lib
+#-------------------------------------------------------------------
+#-------------------------------------------------------------------
+#/opt/Modules/default/modulefiles/libraries/netcdf/4.3.3.1_hdf5_parallel:
+#prepend-path	PATH    	/usr/local/netcdf-4.3.3.1_hdf5_parallel/bin
+#prepend-path	LD_LIBRARY_PATH	/usr/local/netcdf-4.3.3.1_hdf5_parallel/lib
+#setenv		NETCDF_INCDIR	/usr/local/netcdf-4.3.3.1_hdf5_parallel/include
+#setenv		NETCDF_LIBDIR	/usr/local/netcdf-4.3.3.1_hdf5_parallel/lib
+#setenv		NETCDF_LDFLAGS	-L/usr/local/netcdf-4.3.3.1_hdf5_parallel/lib -lnetcdf
+#-------------------------------------------------------------------
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/banner.html
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/banner.html	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/banner.html	(revision 6808)
@@ -0,0 +1,33 @@
+<pre style="font: 2px/1px monospace;">
+@@@@@@O$$$$$$@@@@@@#$$$$$$&@#$$$$$$$$$$$$$$$&@O$$$$$$&@@@@@@@@@$$$$$$O@@@@@@@@@@@O$$%$O@@@@@@@@@@@@@
+@@@@@@?!!!!!!#@@@@@O!!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!?&@@@@@@@$!!!!!!?@@@@@@@@&O#&&&&%??$#@@@@@@@@@@
+@@@@@@?!!!!!!?@@@@@O!!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!!%@@@@@@O!!!!!!!?@@@@@@@O#@@&%??!!!!!$@@@@@@@@@
+@@@@@@?!!!!!!!O@@@@O!!!!!!#@$!!!!!!?????????&@%!!!!!!!!$@@@@#!!!!!!!!?@@@@@&O&@&&O$$?!!!!!!%&@@@@@@@
+@@@@@@?!!!!!!!!#@@@O!!!!!!#@$!!!!!!#&&&&&&&&@@%!!!!!!!!!$@@&?!!!!!!!!?@@@@@O&@&??&@@&O!!!!!!%@@@@@@@
+@@@@@@?!!!!!!!!?&@@O!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!!!!!O@%!!!!!!!!!?@@@@O&@@O!O@@@@&O!!!!!!$@@@@@@
+@@@@@@?!!!!!!!!!?#@O!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!!!!!!%!!!!!!!!!!?@@@&O@@$!!O&@@@@&O!!!!!!#@@@@@
+@@@@@@?!!!!!!!!!!!OO!!!!!!#@$!!!!!!$OOOOO@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@@O@&%!!!!!%#&&@&?!!!!!%@@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!!!!!!?@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@@O&!!!!!!%%eO&@$!!!!!!%&@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!!!!!!?@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@&&$!!!?$O$Oe$@@!!!!!!eO#@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!?%%%%$@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@O&!!!!$&$#%!#@@?!!!!!!$O@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@O&!!!!%?O@%&&&@$!!!!!!?O@@@@
+@@@@@@?!!!!!?#!!!!!!!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!#!!!!!!!!O?!!!!!?@@O#!!!!!!?@@@@@OO!!!!$e?O@@@@
+@@@@@@?!!!!!?@#?!!!!!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!&#!!!!!!%&?!!!!!?@@OOO?!!!%%@@@@@#?!%$#O%%$@@@@
+@@@@@@?!!!!!?@@&%!!!!!!!!!#@$!!!!!!?????????&@%!!!!!!&@O!!!!?&@?!!!!!?@@#&##%$&&&@@@@@@$%#&O!??O@@@@
+@@@@@@?!!!!!?@@@@#?!!!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!&@@$!!!&@@?!!!!!?@@&#$&@@@@@@@@@@@?O%%?!!!#@@@@
+@@@@@@?!!!!!?@@@@@@#%!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!&@@@$!O@@@?!!!!!?@@@O#&&@@@@@@@@@@O?!!!!!?&@@@@
+@@@@@@?!!!!!?@@@@@@@@&O$%%#@#O##&&&&&&&&##OO&@$!!!!!!&@@@@O@@@@?!!!!!?@@@O&&#&@@@@@@@@@$!!!!!!$@@@@@
+@@@@@@?!!!!!?@@@@@@@@@@@@@@&&#O$$$%%%%$$$OO#&@@&#O%?!&@@@@@@@@@?!!!!!?@@@@OOO@@@@@@@@@&!!!!!!!&@@@@@
+@@@@@@?!!!!!?@@@@@@@@@&#$%?!!!!!!!!!!!!!!!!!!!?%O#@@#@@@@@@@@@@?!!!!!?@@@@#!!%&@@@@@@@%!!!!!!O@@@@@@
+@@@@@@?!!!!!?@@@@@@#$?!!!!!!!!!!!!!!!!!!!!!!!!!!!!!%$&@@@@@@@@@?!!!!!?@@@@@#!!%@@@@@@@O!!$&$$@@@@@@@
+@@@@@@?!!!!!?@@@O%!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!?$#@@@@@@?!!!!!?@@@@@@O!!?@@@@@@@&&@#O@@@@@@&&
+@@@@@@?!!!?O&#$?!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!?$#@@@$?!!!!?@@@@@@@&%!?$#@@@@@&O#@@@@@#O&@
+@@@@@@?!?O&#%!!!!!!!!!??%%$$$OOOOOOOOOO$$%%??!!!!!!!!!!!!!!!?%O&&&O$%%@@@@@@@@@#%?%####O#@@@&#$$#@@@
+@@@@@@%O&#%!!!!!?%$O#&&@@@@@@@@@@@@@@@@@@@@@&&#O$%?!!!!!!!!!!!!!?$O&&&@@@@@@@@@@@&&&&&&&&#$%?%#@@@@@
+@@@@@@&#%!!!?$#&&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&&#O%?!!!!!!!!!!!!??%$OOO#######OO$%??!!?%#@@@@@@@
+@@@@@&$!?%O&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&#O$%?!!!!!!!!!!!!!!!!!!!!!!!!!?$#&@@@@@@@@@
+@@@@O?%O&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&#OO$%????!!!!!!!!??%%O#&@@@@@@@@@@@@@
+@@&$$&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&&&&&&&&&@@@@@@@@@@@@@@@@@@@@
+@#O&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+&&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+</pre>
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/banner.txt
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/banner.txt	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/banner.txt	(revision 6808)
@@ -0,0 +1,31 @@
+@@@@@@O$$$$$$@@@@@@#$$$$$$&@#$$$$$$$$$$$$$$$&@O$$$$$$&@@@@@@@@@$$$$$$O@@@@@@@@@@@O$$%$O@@@@@@@@@@@@@
+@@@@@@?!!!!!!#@@@@@O!!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!?&@@@@@@@$!!!!!!?@@@@@@@@&O#&&&&%??$#@@@@@@@@@@
+@@@@@@?!!!!!!?@@@@@O!!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!!%@@@@@@O!!!!!!!?@@@@@@@O#@@&%??!!!!!$@@@@@@@@@
+@@@@@@?!!!!!!!O@@@@O!!!!!!#@$!!!!!!?????????&@%!!!!!!!!$@@@@#!!!!!!!!?@@@@@&O&@&&O$$?!!!!!!%&@@@@@@@
+@@@@@@?!!!!!!!!#@@@O!!!!!!#@$!!!!!!#&&&&&&&&@@%!!!!!!!!!$@@&?!!!!!!!!?@@@@@O&@&??&@@&O!!!!!!%@@@@@@@
+@@@@@@?!!!!!!!!?&@@O!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!!!!!O@%!!!!!!!!!?@@@@O&@@O!O@@@@&O!!!!!!$@@@@@@
+@@@@@@?!!!!!!!!!?#@O!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!!!!!!%!!!!!!!!!!?@@@&O@@$!!O&@@@@&O!!!!!!#@@@@@
+@@@@@@?!!!!!!!!!!!OO!!!!!!#@$!!!!!!$OOOOO@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@@O@&%!!!!!%#&&@&?!!!!!%@@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!!!!!!?@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@@O&!!!!!!%%eO&@$!!!!!!%&@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!!!!!!?@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@&&$!!!?$O$Oe$@@!!!!!!eO#@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!?%%%%$@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@O&!!!!$&$#%!#@@?!!!!!!$O@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@O&!!!!%?O@%&&&@$!!!!!!?O@@@@
+@@@@@@?!!!!!?#!!!!!!!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!#!!!!!!!!O?!!!!!?@@O#!!!!!!?@@@@@OO!!!!$e?O@@@@
+@@@@@@?!!!!!?@#?!!!!!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!&#!!!!!!%&?!!!!!?@@OOO?!!!%%@@@@@#?!%$#O%%$@@@@
+@@@@@@?!!!!!?@@&%!!!!!!!!!#@$!!!!!!?????????&@%!!!!!!&@O!!!!?&@?!!!!!?@@#&##%$&&&@@@@@@$%#&O!??O@@@@
+@@@@@@?!!!!!?@@@@#?!!!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!&@@$!!!&@@?!!!!!?@@&#$&@@@@@@@@@@@?O%%?!!!#@@@@
+@@@@@@?!!!!!?@@@@@@#%!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!&@@@$!O@@@?!!!!!?@@@O#&&@@@@@@@@@@O?!!!!!?&@@@@
+@@@@@@?!!!!!?@@@@@@@@&O$%%#@#O##&&&&&&&&##OO&@$!!!!!!&@@@@O@@@@?!!!!!?@@@O&&#&@@@@@@@@@$!!!!!!$@@@@@
+@@@@@@?!!!!!?@@@@@@@@@@@@@@&&#O$$$%%%%$$$OO#&@@&#O%?!&@@@@@@@@@?!!!!!?@@@@OOO@@@@@@@@@&!!!!!!!&@@@@@
+@@@@@@?!!!!!?@@@@@@@@@&#$%?!!!!!!!!!!!!!!!!!!!?%O#@@#@@@@@@@@@@?!!!!!?@@@@#!!%&@@@@@@@%!!!!!!O@@@@@@
+@@@@@@?!!!!!?@@@@@@#$?!!!!!!!!!!!!!!!!!!!!!!!!!!!!!%$&@@@@@@@@@?!!!!!?@@@@@#!!%@@@@@@@O!!$&$$@@@@@@@
+@@@@@@?!!!!!?@@@O%!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!?$#@@@@@@?!!!!!?@@@@@@O!!?@@@@@@@&&@#O@@@@@@&&
+@@@@@@?!!!?O&#$?!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!?$#@@@$?!!!!?@@@@@@@&%!?$#@@@@@&O#@@@@@#O&@
+@@@@@@?!?O&#%!!!!!!!!!??%%$$$OOOOOOOOOO$$%%??!!!!!!!!!!!!!!!?%O&&&O$%%@@@@@@@@@#%?%####O#@@@&#$$#@@@
+@@@@@@%O&#%!!!!!?%$O#&&@@@@@@@@@@@@@@@@@@@@@&&#O$%?!!!!!!!!!!!!!?$O&&&@@@@@@@@@@@&&&&&&&&#$%?%#@@@@@
+@@@@@@&#%!!!?$#&&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&&#O%?!!!!!!!!!!!!??%$OOO#######OO$%??!!?%#@@@@@@@
+@@@@@&$!?%O&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&#O$%?!!!!!!!!!!!!!!!!!!!!!!!!!?$#&@@@@@@@@@
+@@@@O?%O&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&#OO$%????!!!!!!!!??%%O#&@@@@@@@@@@@@@
+@@&$$&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&&&&&&&&&@@@@@@@@@@@@@@@@@@@@
+@#O&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+&&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/svn_abstract.awk
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/svn_abstract.awk	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/svn_abstract.awk	(revision 6808)
@@ -0,0 +1,34 @@
+#!/bin/awk
+
+BEGIN{}
+
+func relative_path() { sub(/.*NEMOGCM\/[[:upper:]]*\//,//); return substr($0,2) }
+
+func array_loop(action,nb,array) {
+    if ( nb != 0 ) {
+	printf("\n%-10s: %3d\n\t",action,nb)
+	j = 0
+	for (i in array) {
+	    j += 1
+	    printf("%-45s\t",array[i])
+	    if ( j % 3 == 0 && j != nb ) { printf"\n\t" }
+	}
+    }
+}
+
+/^A[[:upper:] ]/ { acount += 1; aroutines[acount] = relative_path() }
+/^C[[:upper:] ]/ { ccount += 1; croutines[ccount] = relative_path() }
+/^D[[:upper:] ]/ { dcount += 1; droutines[dcount] = relative_path() }
+/^E[[:upper:] ]/ { ecount += 1; eroutines[ecount] = relative_path() }
+/^G[[:upper:] ]/ { gcount += 1; groutines[gcount] = relative_path() }
+/^U[[:upper:] ]/ { ucount += 1; uroutines[ucount] = relative_path() }
+
+END{
+    array_loop("added",     acount,aroutines)
+    array_loop("conflicted",ccount,croutines)
+    array_loop("deleted",   dcount,droutines)
+    array_loop("edited",    ecount,eroutines)
+    array_loop("merged",    gcount,groutines)
+    array_loop("updated",   ucount,uroutines)
+    printf "\n"
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/trusting.env
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/trusting.env	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/trusting.env	(revision 6808)
@@ -0,0 +1,30 @@
+#!/bin/bash
+
+
+## Global environment variables
+##--------------------------------------
+dat=$( date )
+export DATE=$( date -ud "$dat" +"%Y%m%d%Z%H%M" )
+export PATTERNAME=${TRUS_USER}'_'${TRUS_HPCC}
+export TRUS_SVNH='https://forge.ipsl.jussieu.fr/nemo/svn'
+
+
+## Source user configuration
+##---------------------------------------------------
+. ./config/${TRUS_USER}.cfg
+export TRUS_WORK TRUS_SCRA TRUS_STOR TRUS_XIOS TRUS_FORC
+export TRUS_BRAN TRUS_REFE
+export TRUS_CONF TRUS_TARF TRUS_KEYA TRUS_KEYD
+export TRUS_MAIL
+
+
+## Source (super)computer configuration
+##---------------------------------------------------
+. ./config/${TRUS_HPCC}.cfg
+export TRUS_ENVI TRUS_CDOD TRUS_NPRO TRUS_TOUT
+export TRUS_JSPT TRUS_JSUB TRUS_JSTA TRUS_JKIL
+export TRUS_JPME TRUS_JTIM TRUS_JVME TRUS_JINF
+export TRUS_CMPV TRUS_CDOR TRUS_MPIR TRUS_CDFR
+
+
+export TRUS_NGCM=${TRUS_WORK}/${TRUS_BRAN}/NEMOGCM
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/trusting_func.sh
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/trusting_func.sh	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/trusting_func.sh	(revision 6808)
@@ -0,0 +1,427 @@
+#!/bin/bash
+
+
+## Messenger filenames
+FILE_DATE=mesg_01_date_$PATTERNAME.txt  ; FILE_RSLT=mesg_02_result_$PATTERNAME.txt
+FILE_STAT=mesg_03_state_$PATTERNAME.txt ; FILE_NEMO=mesg_04_nemo_$PATTERNAME.txt
+FILE_XIOS=mesg_05_xios_$PATTERNAME.txt  ; FILE_CMPF=mesg_06_compiler_$PATTERNAME.txt
+FILE_LMPI=mesg_07_mpi_$PATTERNAME.txt   ; FILE_NCDF=mesg_08_netcdf_$PATTERNAME.txt
+FILE_INPT=mesg_09_inputs_$PATTERNAME.txt; FILE_TIME=mesg_10_time_$PATTERNAME.txt
+FILE_MEMY=mesg_11_memory_$PATTERNAME.txt; FILE_NOTE=mesg_12_comments_$PATTERNAME.txt
+
+## Trusting timestamped logfile & archive
+TRUS_FILE=trusting_${DATE}_$PATTERNAME.txt; TRUS_ARCH=trusting_${DATE}_$PATTERNAME.tgz
+
+
+## Functions in order of use
+print_step() {
+    local char_nb=$( echo "$1" | wc -c )
+    local outline=$( printf "%${char_nb}s" )
+
+    printf "\nStep.....\n%s\n%s\n" "$1" ${outline// /-}
+}
+
+init_files() {
+    echo 'Date'        	      > ${FILE_DATE}; echo 'Result'           > ${FILE_RSLT}
+    echo 'State'      	      > ${FILE_STAT}; echo 'NEMOGCM rev.'     > ${FILE_NEMO}
+    echo 'XIOS rev.'   	      > ${FILE_XIOS}; echo 'Fortran compiler' > ${FILE_CMPF}
+    echo 'MPI libs'    	      > ${FILE_LMPI}; echo 'NetCDF libs'      > ${FILE_NCDF}
+    echo 'Input files' 	      > ${FILE_INPT}; echo 'Elapsed time'     > ${FILE_TIME}
+    echo 'Memory usage (P/V)' > ${FILE_MEMY}; echo 'Comments'         > ${FILE_NOTE}
+
+    ## 'Failed' status with 'Unknown error' by default
+    echo ${TRUS_RSLT}      \
+	>> ${FILE_RSLT}
+    echo 'Unknown error' \
+	>> ${FILE_STAT}
+}
+
+get_date() {
+    ## UTC time zone for timestamping
+    local dat=$( date -ud "${DATE}" +"%F %R %Z" )
+
+    echo $dat           \
+	>> ${FILE_DATE}
+}
+
+get_nemo_rev() {
+    local dir rev_loc
+    local rev=0
+
+    ## Loop on essential NEMO directories
+    for dir in ${TRUS_CKOT} ${TRUS_XIOS}; do
+
+	## For time being, just get revision from XIOS with no action on directory
+	if [ $dir == ${TRUS_XIOS} ]; then
+	    rev_loc=$( svn info $dir | awk '/Last Changed Rev/ {print $NF}' )
+	    echo 'XIOS '${rev_loc} \
+		>> model.log
+	    echo "<a href=\"https://forge.ipsl.jussieu.fr/ioserver/changeset/${rev_loc}\" target=\"_blank\">${rev_loc}</a>" \
+		>> ${FILE_XIOS}
+	    continue
+	fi
+
+	echo $dir && ${TRUS_SVNA} ${TRUS_NGCM}/$dir
+	rev_loc=$( svn info ${TRUS_NGCM}/$dir | awk '/Last Changed Rev/ {print $NF}' )
+
+	## Keep last rev. nb
+	[ ${rev_loc} -gt $rev ] && rev=${rev_loc}
+    done
+
+    echo 'NEMOGCM '$rev \
+	>> model.log
+    echo "<a href=\"https://forge.ipsl.jussieu.fr/nemo/changeset/$rev\" target=\"_blank\">$rev</a>" \
+	>> ${FILE_NEMO}
+}
+
+get_soft_rel() {
+    local soft_rel str
+
+    ## Sourcing environment
+    if [ -n "${TRUS_ENVI}" ]; then
+	if [[  -e ${TRUS_ENVI}.env && $( declare -F | grep ' module' ) ]]; then
+            ## .env file if module function is available
+	    . ${TRUS_ENVI}.env
+	else
+            ## .path file if existing, if not the given file
+	    [ -e ${TRUS_ENVI}.path ] && . ${TRUS_ENVI}.path || . ${TRUS_ENVI}
+	fi
+    fi
+
+    ## Problem with `prepend-path` of modulefile that use ':' instead of ' ' as delimiter
+    [ $TRUS_HPCC == 'X64_ADA' ] && WRAPPER_LDFLAGS='-L/smplocal/pub/IdrMemMPI/1.4/lib -lidrmem '${WRAPPER_LDFLAGS}
+
+    for str in ${TRUS_CMPV} ${TRUS_MPIR} ${TRUS_CDFR} ${TRUS_CDOR}; do
+	[ -z "$str" ] && continue
+	soft_rel=''
+
+	## Software release: next word after "$soft" in $PATH (case-insensitive)
+	soft_rel=$( echo $PATH | sed "s#.*$str\([0-9.a-z_]*\).*#\1#i" )
+
+	## option --version would work for main compilers (gfortran, intel, pgfortran, ...)
+	[ $str == ${TRUS_CMPV} ] && soft_rel=$( $str --version | grep -m1 -oe '\<[0-9. ]*\>' )
+
+	## Cleaning characters string to display proper soft name
+	str=$( echo $str | sed 's#\\##g; s#[/-]$##' )
+
+	echo $str ${soft_rel} \
+	    >> model.log
+    done
+
+    sed -n 3p model.log \
+	>> ${FILE_CMPF}
+    sed -n 4p model.log \
+	>> ${FILE_LMPI}
+    sed -n 5p model.log \
+	>> ${FILE_NCDF}
+}
+
+get_inputs() {
+    ## Extract archive or copy files in case of personal inputs
+    [ -z "${TRUS_TARF}" ] && get_io="cp ${TRUS_FORC}/* ." || get_io="tar -vxf ${TRUS_FORC}/${TRUS_TARF}"
+
+    ${get_io} > /dev/null
+    [ $? -ne 0 ] && get_out 3 || echo 'Success'
+    [ $( find -name '*.gz' -print -quit ) ] && gunzip *.gz
+
+    ls -lh > inputs_list.txt
+}
+
+diff_inputs() {
+    local dif file
+    local files_list='' mesg='Same' 
+
+    ## Simple diff
+    for file in 'inputs_list.txt' *namelist_* *.xml cpp_*; do
+	dif=''
+
+	## Continue even if input file is not in here (see after)
+	if [ -e ${TRUS_STOR}/$file ]; then dif=$( diff -q $file ${TRUS_STOR}/$file ); else dif=0; fi
+
+	## Pass over useless file omission in benckmark directory
+	[[ -n "$dif" && "$dif" != '0' ]] && { mesg='Different'; echo $dif; files_list+=$file' '; }
+    done
+
+    [ $mesg == 'Same' ] && echo $mesg
+    echo $mesg          \
+	>> ${FILE_INPT}
+
+    ## List different files for web comment
+    [ -n "${files_list}" ] && echo 'Inputs  : '${files_list}'differ<br>' \
+	>> temp_${FILE_NOTE}
+}
+
+job_pending() {
+    local outline=$( printf "%100s" ) time_elapsed=0 time_increment=30
+
+    sleep ${time_increment}
+
+    ## Append a log file while pending
+    while [[ $( eval ${TRUS_JSTA} ) && ${time_elapsed} -lt ${TRUS_TOUT} ]]; do
+	printf "\n%s\n" ${outline// /#}          \
+	    >> computation.log
+	[ -n "${TRUS_JINF}" ] && eval ${JOB_INFO} \
+	    >> computation.log
+	sleep ${time_increment}
+	time_elapsed=$(( ${time_elapsed} + ${time_increment} ))
+    done
+
+    sleep ${time_increment}
+
+    ## Kill remaining job & stop the test if it's too long
+    [ ${time_elapsed} -eq ${TRUS_TOUT} ] && { eval ${JOB_DELE} &> /dev/null; get_out 6; }
+}
+
+diff_results() {
+    local file
+    local files_list='' mesg='Same'
+
+    ## Simple diff
+    for file in 'ocean.output' *.stat; do
+	## Stop if no benchmark files (ocean.output, eventual stat files)
+	[ ! -e ${TRUS_STOR}/$file ] && { TRUS_RSLT='FAILED'; get_out 7; }
+
+	diff -q $file ${TRUS_STOR}/$file
+
+	## Continue even if it differs
+	[ $? -ne 0 ] && { TRUS_RSLT='FAILED'; mesg='Different'; files_list+=$file' '; }
+    done
+
+    [ $mesg == 'Same' ] && echo $mesg
+
+    ## List different files for web comment
+    [ -n "${files_list}" ] && echo 'Results : '${files_list}'differ<br>' \
+	>> temp_${FILE_NOTE}
+}
+
+diff_restart() {
+    local base_name comp dif file list_comp list_tmsp nb_dom time_step tmsp
+    local files_list='' dif_sum=0
+
+    ## Stop if no benchmark files (ie time.step)
+    [ ! -e ${TRUS_STOR}/time.step ] && { TRUS_RSLT='FAILED'; get_out 7; }
+    time_step=$( cat ${TRUS_STOR}/time.step | tr -d [:space:] )
+
+    ## Find all restart files to rebuild
+    if [ $( find -regex ".*_restart.*[0-9]\.nc" -print -quit ) ]; then
+	base_name=$( find -regex ".*_restart.*[0-9]\.nc"                       \
+	             | sed "s#^\./\(.*\)_[0-9]*_restart.*#\1#"       | sort -u   )
+	list_comp=$( find -regex ".*_restart.*[0-9]\.nc"                       \
+	             | sed "s#^.*\(restart[a-z_]*\)_[0-9].*\.nc#\1#" | sort -u   )
+	list_tmsp=$( find -regex ".*_restart.*[0-9]\.nc"                       \
+	             | sed "s#^.*\([0-9]\{8\}\)_restart.*#\1#"       | sort -u   )
+
+	## Loop on each time step
+	for tmsp in ${list_tmsp}; do
+
+	    for comp in ${list_comp}; do
+		file=${base_name}_${tmsp}_${comp}
+		nb_dom=$( find -name "${file}_[0-9]*.nc" | wc -l | awk '{ print $1 }' )
+
+		if   [ ${nb_dom} -gt 1 ]; then
+		    ${TRUS_NGCM}/TOOLS/REBUILD_NEMO/rebuild_nemo -t ${TRUS_NPRO} $file ${nb_dom} \
+			> /dev/null
+
+		     ## Possibility of remaining decomposed restarts (even after rebuild)
+		    [ $? -eq 0 ] && rm -f ${file}_[0-9]*.nc \
+                        > /dev/null
+
+		elif [ ${nb_dom} -eq 0 ]; then
+		    TRUS_RSLT='FAILED' && get_out 8
+		fi
+
+		## Compare restart files at same time step
+		if [ $tmsp -eq ${time_step} ]; then
+
+                    ## Stop if no benchmark files (restart file)
+		    if [ -e ${TRUS_STOR}/$file.nc ]; then
+
+	                ## UNIX `cmp` not suitable (timestamp in .nc file)
+			dif=$( $TRUS_CDOD $file.nc ${TRUS_STOR}/$file.nc 2> /dev/null          \
+			       | awk '/records/ {print $0}' | sed '2 s/^/,/' | tr -d '\n' )
+
+			## CDO can return void stdout with no difference
+			if [[ -n "$dif" && $( echo $dif | awk '{print $1}' ) -ne 0 ]]; then
+			    TRUS_RSLT='FAILED'
+			    files_list+=$comp' ' && let dif_sum+=$( echo $dif | awk '{print $1}' )
+			    echo $file.nc': '$dif
+			fi
+
+		    else
+			TRUS_RSLT='FAILED' && get_out 7
+		    fi
+
+		else
+		    continue
+		fi
+
+	    done
+
+	done
+
+        ## List different files for web comment with sum of different records
+	if [ ${dif_sum} -ne 0 ]; then
+	    echo 'Restarts: '${files_list}${dif_sum}' record(s) differ<br>' \
+		>> temp_${FILE_NOTE}
+	else
+	    echo 'Same'
+	fi
+
+    else
+	TRUS_RSLT='FAILED'
+    fi
+
+}
+
+get_time() {
+    [ -z "${TRUS_JTIM}" ] && return
+
+    ## Interest for checking unusual time computation
+    local time_cpu=$( eval ${TRUS_JTIM} )
+
+    printf "Elapsed time: "
+    echo ${time_cpu} | tee -a ${FILE_TIME}
+}
+
+get_memy() {
+    [[ -z "${TRUS_JPME}" && -z "${TRUS_JVME}" ]] && return
+
+    ## Interest for checking unusual memory usage
+    local memory_pmax=$( eval ${TRUS_JPME} ) memory_vmax=$( eval ${TRUS_JVME} )
+
+    printf "Memory max usage (physical/virtual): "
+    echo ${memory_pmax}' / '${memory_vmax} | tee -a ${FILE_MEMY}
+}
+
+comments() {
+    local opat
+    local line='' state=$1
+
+    if [ -e ocean.output ]; then
+        ## 'W A R N I N G' pattern by default
+	opat="-A2 \"^ $state\""
+	[ "$state" == 'E R R O R' ] && opat="-A4 \"$state\""
+
+        ## Select first occurence for web comment
+	line=$( eval grep -m1 $opat ocean.output | tr -d '\n' )
+    fi
+
+    [ -n "$line" ] && ( echo $line; printf "$line<br>" \
+	>> temp_${FILE_NOTE} )
+}
+
+log_make() {
+    ## Format comments for web
+    [ -e temp_${FILE_NOTE} ] && cat temp_${FILE_NOTE} | tr -d '\n' | sed 's/<br>$//' \
+	>> ${FILE_NOTE}
+
+    ## Construct txt file with all messenger files
+    paste -d ';' mesg_*.txt | tee ${TRUS_FILE}
+}
+
+prod_publish() {
+    local cmd
+    local rev=$( awk '/NEMOGCM/ {print $NF}' model.log )
+
+    ## Production mode (-p|--prod)
+    if [ ${TRUS_PROD} -eq 1 ]; then
+
+	## Create or append trusting logfile
+	if [ -f ${TRUS_STOR}/trusting_$PATTERNAME.txt ]; then cmd='tail -1'; else cmd='cat'; fi
+
+	$cmd ${TRUS_FILE}                            \
+	    >> ${TRUS_STOR}/trusting_$PATTERNAME.txt
+
+        ## Send mail only when FAILED
+	if [[ ! -z "${TRUS_MAIL}" && ${TRUS_RSLT} == 'FAILED' ]]; then
+
+	    ## Content
+	    cat <<END_MAIL      \
+		> trusting.mail
+Dear all,
+
+
+The trusting sequence has not completed successfully on new configuration ${TRUS_CONF} based on ${TRUS_REFE}.
+
+Here is the model summary:
+`cat model.log`
+
+First checking would be on the trusting environment files:
+${TRUS_USER}.cfg & ${TRUS_HPCC}.cfg
+
+For more details, look into the testing folder at:
+${TRUS_SCRA}
+
+An archive has been created to share the questionable configuration for further studies:
+${TRUS_STOR}/${TRUS_ARCH}
+
+END_MAIL
+
+	    ## Send with detailed subject
+	    mail -s "[NEMO Trusting][$rev][${TRUS_BRAN}][${TRUS_REFE}] ${TRUS_RSLT} ${TRUS_RORR}" ${TRUS_MAIL} \
+		<  trusting.mail
+	fi
+
+    fi
+}
+
+get_out() {
+    local time_step=0
+
+    TRUS_RORR=$1
+
+    printf "\n\nEnd of test\n"
+
+    ## In case of compilation error
+    cd ${TRUS_SCRA}
+
+    if [ ${TRUS_RSLT} == 'FAILED' ]; then
+	echo 'Failure'
+
+        ## Error identification
+	case ${TRUS_RORR} in
+            ## Compilation
+	    '1') TRUS_RORR='XIOS compilation failed' ;; '2') TRUS_RORR='NEMO compilation failed';;
+	    ## Submission
+	    '3') TRUS_RORR='Missing input files'     ;; '4') TRUS_RORR='Job submission error'   ;;
+	    ## Computation
+	    '5') TRUS_RORR='Crashed at time step'    ;; '6') TRUS_RORR='Exceeded time limit'    ;;
+	    ## Results
+	    '7') TRUS_RORR='Missing previous outputs';; '8') TRUS_RORR='New outputs differ'     ;;
+	    ## Other
+	    '*') TRUS_RORR='Unknown error'           ;;
+	esac
+
+    else
+	echo 'Success' && TRUS_RORR='Code is reliable'
+    fi
+
+    ## Eventual comments from ocean.output
+    if [ "${TRUS_RORR}" == 'Crashed at time step' ]; then
+	comments 'E R R O R'
+	[ -e time.step ] && time_step=$( grep -o [0-9]* time.step )
+	TRUS_RORR+=' '$time_step
+    else
+	comments 'W A R N I N G'
+	[ "${TRUS_RORR}" == 'Exceeded time limit' ] && TRUS_RORR+=' '$(( ${TRUS_TOUT}/3600 ))'h'
+    fi
+
+    ## Last messenger files
+    #export TRUS_RORR
+    sed -i "2 s/.*/$TRUS_RSLT/" ${FILE_RSLT}; sed -i "2 s/.*/$TRUS_RORR/" ${FILE_STAT}
+
+    ## Save tested configuration if trusting failed in production mode (-p|--prod)
+    if [[ ${TRUS_RSLT} == 'FAILED' && ${TRUS_PROD} -eq 1 ]]; then
+	echo 'Creating archive '${TRUS_ARCH}' under '${TRUS_STOR}
+	tar -czf ${TRUS_STOR}/${TRUS_ARCH}               *                    \
+	    -C   ${TRUS_NGCM}/CONFIG/${TRUS_CONF}/MY_SRC .                    \
+	    -C   ${TRUS_NGCM}/CONFIG/${TRUS_CONF}        cpp_${TRUS_CONF}.fcm
+    fi
+
+    ## Logfile construct & eventual sending of notification email
+    printf "\nTrusting digest:\n----------------\n"
+    log_make
+    prod_publish
+
+    exit 0
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/trusting_help.txt
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/trusting_help.txt	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inc/trusting_help.txt	(revision 6808)
@@ -0,0 +1,42 @@
+Usage: ./trusting.sh        -u $USER -m $ARCH [OPTIONS]
+       ./install_new_branch -u $USER -m $ARCH [OPTIONS]
+
+./trusting.sh            Launch trusting test on $ARCH machine from $USER installation
+./install_new_branch     Install new branch in $USER installation for trusting test on $ARCH machine
+
+Examples: `./trusting.sh        -u romr005 -m X64_CURIE -p -b nemo_v3_6_STABLE`
+          `./install_new_branch -u romr005 -m X64_ADA   -w $HOME/NEMO         `
+
+Mandatory
+    Default settings to source in ./config, templates (arch_template.cfg & user_template.cfg)
+    -m,--machine      Architecture environment (compilation & computation settings)
+    -u,--user         User             ""      (NEMO & XIOS installation)		   
+
+
+Options (modify default settings)
+SVN
+    -b,--branch	      Branch name in working directory ('trunk'|'nemo_v3_6_stable'|...)
+    -v,--version      Action on working copy ('status' by default)
+  		           '{'YYYY-MM-DD'}'  Update to revision available at this date
+		           [0-9]*	       ""   ""    ""    number
+		           HEAD|up|update      ""   "" last revision
+		           st|status	     Show differences with repository
+    -w,--workdir      Installation directory for testing branches
+
+Inputs
+    -a,--archive      Forcing input files archive to extract, if void it will copy all files from given folder (see next line)
+    -f,--forcdir      Path to your personal folder of forcing inputs
+
+Testing configuration
+    -n,--new_conf     Testing   configuration folder created in ./CONFIG
+    -r,--ref_conf     Reference      " "      for trusting test
+
+Compiling & computation
+    -j,--job          Number of processes for compiling
+    -t,--time         Timeout for computation (s)
+
+Trusting output
+    -d,--debug        Verbose output for debugging purpose (`set -vx`)
+    -e,--email        Email trusting digest report to following addresses only on failure
+    -h,--help         Print this help & exit
+    -p,--prod         Production mode (append trusting logfile)
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/AMM12/iodef.xml
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/AMM12/iodef.xml	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/AMM12/iodef.xml	(revision 6808)
@@ -0,0 +1,157 @@
+<?xml version="1.0"?>
+<simulation> 
+
+ <context id="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="one_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 id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="sst"          name="tos" />
+	  <field field_ref="sss"          name="sos" />
+	  <field field_ref="ssh"          name="zos" />
+	</file>
+
+	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="ssu"          name="uos" />
+	</file>
+	
+	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="ssv"          name="vos" />
+	</file>
+	
+      </file_group>
+
+      <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="file4" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="thetao" />
+	  <field field_ref="soce"         name="so"     />
+	  <field field_ref="sst"          name="tos"    />
+	  <field field_ref="sst2"         name="tossq"  />
+	  <field field_ref="sss"          name="sos"    />
+	  <field field_ref="ssh"          name="zos"    />
+	  <field field_ref="ssh2"         name="zossq"  />
+	  <field field_ref="empmr"        name="wfo"    />
+	  <field field_ref="qsr"          name="rsntds" />
+	  <field field_ref="qt"           name="tohfls" />
+	  <field field_ref="taum"     />
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
+	</file>
+	
+	<file id="file5" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="uoce"         name="uo"    />
+	  <field field_ref="ssu"          name="uos"   />
+	  <field field_ref="utau"         name="tauuo" />
+	</file>
+	
+	<file id="file6" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="voce"         name="vo"    />
+	  <field field_ref="ssv"          name="vos"   />
+	  <field field_ref="vtau"         name="tauvo" />
+	</file>
+	
+	<file id="file7" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="woce"         name="wo"     />
+	  <field field_ref="avt"          name="difvho" />
+	</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="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </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 id="gznl_T_2D" domain_ref="gznl"/>
+     <grid id="gznl_T_3D" domain_ref="gznl" axis_ref="deptht"/>
+     <grid id="gznl_W_3D" domain_ref="gznl" axis_ref="depthw"/>
+    </grid_definition>   
+  </context>
+  
+
+  <context id="xios">
+
+      <variable_definition>
+	
+     <!-- 
+        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
+-->
+	  <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>
+	
+      </variable_definition>
+               
+  </context>
+  
+</simulation>
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/AMM12/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/AMM12/namelist_cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/AMM12/namelist_cfg	(revision 6808)
@@ -0,0 +1,434 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  : AMM12 configuration namelist used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "AMM12_trust"  	!  experience name
+   nn_it000    =       1   	 	!  first time step
+   nn_itend    =     576   	 	!  last  time step (std 1 day = 144)
+   nn_date0    =  20120102 	 	!  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
+   nn_leapy    =       1   	 	!  Leap year calendar (1) or not (0)
+   ln_rstart   =  .true.         	!  start from rest (F) or from a restart file (T)
+   nn_euler    =       1   	 	!  = 0 : start with forward time step if ln_rstart=.true.
+   cn_ocerst_in   = "amm12_restart_oce" !  suffix of ocean restart name (input)
+   cn_ocerst_out  = "restart_oce_out"   !  suffix of ocean restart name (input)
+   nn_stock    =    1296   	 	!  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =     144   	 	!  frequency of write in the output file   (modulo referenced to nit000) 
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "amm"                !  name of the configuration
+   jp_cfg      =     011               !  resolution of the configuration
+   jpidta      =     198               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     224               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      51               !  number of levels      ( >= jpk )
+   jpiglo      =     198               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     224               !  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)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zps      = .false.   !  z-coordinate - partial steps   (T/F)
+   ln_sco      = .true.    !  s- or hybrid z-s-coordinate    (T/F)
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+   ln_s_sh94   = .false.   !  Song & Haidvogel 1994 hybrid S-sigma   (T)|
+   ln_s_sf12   = .true.    !  Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied
+   ln_sigcrit  = .true.    !  use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
+                           !  stretching coefficients for all functions
+   rn_hc       =   50.0    !  critical depth for transition to stretched coordinates
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_msh      =       0               !  create (=1) a mesh file or not (=0)
+   rn_rdt      =   600.    !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_rdtmin   =   600.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   =   600.          !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =   600.          !  depth variation of tracer time step  (used if nn_acc=1)
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =  999999.0             !  ORCA r4, r2 and r05 coefficients
+   ppa0        =  999999.0             ! (default coefficients)
+   ppa1        =  999999.0             !
+   ppkth       =      23.563           !
+   ppacr       =       9.0             !
+   ppdzmin     =       6.0             !  Minimum vertical spacing
+   pphmax      =    5720.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.
+/
+!-----------------------------------------------------------------------
+&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
+!-----------------------------------------------------------------------
+   ln_bt_nn_auto =    .FALSE.          !  Set nn_baro automatically to be just below
+                                       !  a user defined maximum courant number (rn_bt_cmax)
+   nn_baro       =    30               !  Number of iterations of barotropic mode
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                           !     (also = the frequency of sea-ice model call)
+   ln_flx      = .true.    !  flux formulation       (T => fill namsbc_flx )
+   ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core)
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
+   ln_apr_dyn  = .false.    !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!          !  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_utau     = 'amm12_utau'     ,          1        ,  'utau'      , .false.      , .false. , 'daily'   ,  ''      ,  ''  , ''
+   sn_vtau     = 'amm12_vtau'     ,          1        ,  'vtau'      , .false.      , .false. , 'daily'   ,  ''      ,  ''  , ''
+   sn_qtot     = 'amm12_flx'      ,          3        ,  'sonsfldo'  ,  .true.      , .false. , 'daily'   ,  ''      ,  ''  , ''
+   sn_qsr      = 'amm12_flx'      ,          3        ,  'soshfldo'  ,  .true.      , .false. , 'daily'   ,  ''      ,  ''  , ''
+   sn_emp      = 'amm12_flx'      ,          3        ,  'sowafldo'  ,  .true.      , .false. , 'daily'   ,  ''      ,  ''  , ''
+   cn_dir      = './fluxes/'        !  root directory for the location of the flux files
+/
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
+   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
+/
+!-----------------------------------------------------------------------
+&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      = 'amm12_rivers'       ,        24         , 'rorunoff',   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   sn_cnf      = 'runoff_1m_nomask'   ,         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   sn_s_rnf    = 'amm12_rivers'       ,        24         , 'rosaline',   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   sn_t_rnf    = 'amm12_rivers'       ,        24         , 'rotemper',   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   sn_dep_rnf  = 'amm12_rivers'       ,        24         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+   ln_rnf_depth = .true.    !  read in depth information for runoff
+   ln_rnf_tem   = .true.    !  read in temperature information for runoff
+   ln_rnf_sal   = .true.    !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&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     = 'amm12_mslp'     ,          1        ,  'p_msl'      , .false.      , .false. , 'daily'   ,  ''      ,  ''  , ''
+
+   cn_dir      = './fluxes/' !  root directory for the location of the bulk files
+   rn_pref     = 101000.     !  reference atmospheric pressure   [N/m2]/
+   ln_ref_apr  = .false.    !  ref. pressure: global mean Patm (T) or a constant (F)
+   ln_apr_obc  = .true.    !  inverse barometer added to OBC ssh data
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!          !  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_sst      = 'amm12_sstref'    ,        24         ,  'sst'     ,     .true.     , .false. , 'daily'   , .false. , ''       , '' , ''
+   sn_sss      = 'sss_data'        ,        -1         ,  'sss'     ,     .true.     , .true.  , 'yearly'  , .false. , ''       , '' , ''
+
+   cn_dir      = 'fluxes/' !  root directory for the location of the runoff files
+   nn_sstr     =     1     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
+   nn_sssr     =     0     !  add a damping     term in the surface freshwater flux (=2)
+                           !  or to SSS only (=1) or no damping term (=0)
+   rn_deds     =  -27.7    !  magnitude of the damping on salinity   [mm/day]
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =     0     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobc        !   open boundaries parameters                           ("key_obc")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide      !   tide parameters (#ifdef key_tide)
+!-----------------------------------------------------------------------
+   clname(1)     =   'Q1'   !  name of constituent
+   clname(2)     =   'O1'
+   clname(3)     =   'P1'
+   clname(4)     =   'S1'
+   clname(5)     =   'K1'
+   clname(6)     =   '2N2'
+   clname(7)     =   'MU2'
+   clname(8)     =   'N2'
+   clname(9)     =   'NU2'
+   clname(10)    =   'M2'
+   clname(11)    =   'L2'
+   clname(12)    =   'T2'
+   clname(13)    =   'S2'
+   clname(14)    =   'K2'
+   clname(15)    =   'M4'
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+    nb_bdy         =  1
+    cn_dyn2d       = 'flather'
+    nn_dyn2d_dta   =  3
+    cn_tra         =  'frs'
+    nn_tra_dta    =   1 
+/
+!-----------------------------------------------------------------------
+&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_dyn2d' ,         24        , 'sossheig' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_u2d =     'amm12_bdyU_dyn2d' ,         24        , 'vobtcrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_v2d =     'amm12_bdyV_dyn2d' ,         24        , 'vobtcrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_u3d  =    'amm12_bdyU_dyn3d' ,         24        , 'vozocrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_v3d  =    'amm12_bdyV_dyn3d' ,         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.
+/
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri2    =    2.5e-3 !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    0.0e0  !  bottom turbulent kinetic energy background  (m2/s2)
+   ln_loglayer =    .true. !  loglayer bottom friction (only effect when nn_bfr = 2)
+   rn_bfrz0    =    0.003  !  bottom roughness (only effect when ln_loglayer = .true.)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  0      !  diffusive bbl (=1)   or not (=0)
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   ln_traldf_hor    =  .true.   !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .false.  !  iso-neutral                 (needs "key_ldfslp")
+   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]
+   rn_aht_0         =    50.    !  horizontal eddy diffusivity for tracers [m2/s]
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+   ln_hpg_prj  = .true.   !  s-coordinate (Pressure Jacobian scheme)
+/
+!-----------------------------------------------------------------------
+!namdyn_spg    !   surface pressure gradient   (CPP key only)
+!-----------------------------------------------------------------------
+!                          !  explicit free surface                     ("key_dynspg_exp")
+!                          !  filtered free surface                     ("key_dynspg_flt")
+!                          !  split-explicit free surface               ("key_dynspg_ts")
+
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   ln_dynldf_bilap  =  .true.   !  bilaplacian operator
+   ln_dynldf_lap    =  .false.  !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_level  =  .true.   !  iso-level
+   ln_dynldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
+                           !  Coefficient
+   rn_ahm_0_lap     = 60.0      !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_0_blp     = -1.0e+10  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   0.1e-6  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.1e-6  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.   !  enhanced vertical diffusion (evd) (T) or not (F)
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_charn =  100000.     !  Charnock constant for wb induced roughness length
+   nn_z0_met = 1           !  Method for surface roughness computation (0/1/2)
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation
+/
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&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")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_diaharm   !   Harmonic analysis of tidal constituents ('key_diaharm')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsto       ! Stochastic parametrization of EOS
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options
+!-----------------------------------------------------------------------
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/GYRE/iodef.xml
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/GYRE/iodef.xml	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/GYRE/iodef.xml	(revision 6808)
@@ -0,0 +1,284 @@
+<?xml version="1.0"?>
+<simulation> 
+
+ <context id="nemo" time_origin="1900-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="one_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 id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="sst"          name="tos" />
+	  <field field_ref="sss"          name="sos" />
+	  <field field_ref="ssh"          name="zos" />
+	</file>
+
+	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="ssu"          name="uos" />
+	</file>
+	
+	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="ssv"          name="vos" />
+	</file>
+
+        <file id="file4" name_suffix="_bioscalar" description="pisces sms variables" >
+          <field field_ref="tdenit"   name="tdenit"   unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field>
+          <field field_ref="tnfix"    name="tnfix"    unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field>
+          <field field_ref="tcflx"    name="tcflx"    unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="tcflxcum" name="tcflxcum" unit="PgC"    operation="instant" > tcflxcum * -1. * 12. / 1e15 </field>
+          <field field_ref="tcexp"    name="tcexp"    unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="tintpp"   name="tintpp"   unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="pno3tot"  name="pno3tot"  unit="umolN"  > pno3tot * 16. / 122. * 1e6 </field>
+          <field field_ref="ppo4tot"  name="ppo4tot"  unit="umolP"  > ppo4tot * 1. / 122. * 1e6 </field>
+          <field field_ref="psiltot"  name="psiltot"  unit="umolC"  > psiltot * 1e6  </field>
+          <field field_ref="palktot"  name="palktot"  unit="umolC"  > palktot * 1e6  </field>
+        <field field_ref="pfertot"  name="pfertot"  unit="nmolFe" > pfertot * 1e9  </field>
+                                                                                                                             </file>
+      </file_group>
+
+      <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="file5" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="thetao" />
+	  <field field_ref="soce"         name="so"     />
+	  <field field_ref="sst"          name="tos"    />
+	  <field field_ref="sst2"         name="tossq"  />
+	  <field field_ref="sss"          name="sos"    />
+	  <field field_ref="ssh"          name="zos"    />
+	  <field field_ref="ssh2"         name="zossq"  />
+	  <field field_ref="empmr"        name="wfo"    />
+	  <field field_ref="qsr"          name="rsntds" />
+	  <field field_ref="qt"           name="tohfls" />
+	  <field field_ref="taum"     />
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
+	</file>
+	
+	<file id="file6" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="uoce"         name="uo"     />
+	  <field field_ref="ssu"          name="uos"    />
+	  <field field_ref="utau"         name="tauuo"  />
+	</file>
+	
+	<file id="file7" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="voce"         name="vo"     />
+	  <field field_ref="ssv"          name="vos"    />
+	  <field field_ref="vtau"         name="tauvo"  />
+	</file>
+	
+	<file id="file8" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="woce"         name="wo"     />
+	  <field field_ref="avt"          name="difvho" />
+	</file>
+	
+	<file id="file9" name_suffix="_icemod" description="ice variables" >
+	  <field field_ref="ice_pres"   />
+	  <field field_ref="snowthic_cea" name="snd"    />
+	  <field field_ref="icethic_cea"  name="sit"    />
+	  <field field_ref="iceprod_cea"  name="sip"    />
+	  <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_group>
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."> <!-- real monthly files -->
+
+	<file id="file10" name_suffix="_ptrc_T" description="pisces sms variables" >
+          <field field_ref="DIC"      />
+          <field field_ref="Alkalini" />
+          <field field_ref="O2"       />
+          <field field_ref="PO4"      />
+          <field field_ref="Si"       />
+          <field field_ref="Fer"      />
+          <field field_ref="NCHL"     />
+          <field field_ref="DCHL"     />
+          <field field_ref="NO3"      />
+	</file>
+	
+	<file id="file11" name_suffix="_diad_T" description="additional pisces diagnostics" >
+          <field field_ref="Cflx"     />
+          <field field_ref="Dpco2"    />
+	</file>
+
+      </file_group>
+
+      <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 id="file12" name_suffix="_ptrc_T" description="pisces sms variables" >
+          <field field_ref="DIC"      />
+          <field field_ref="Alkalini" />
+          <field field_ref="O2"       />
+          <field field_ref="CaCO3"    />
+          <field field_ref="PO4"      />
+          <field field_ref="POC"      />
+          <field field_ref="Si"       />
+          <field field_ref="PHY"      />
+          <field field_ref="ZOO"      />
+          <field field_ref="DOC"      />
+          <field field_ref="PHY2"     />
+          <field field_ref="ZOO2"     />
+          <field field_ref="DSi"      />
+          <field field_ref="Fer"      />
+          <field field_ref="BFe"      />
+          <field field_ref="GOC"      />
+          <field field_ref="SFe"      />
+          <field field_ref="DFe"      />
+          <field field_ref="GSi"      />
+          <field field_ref="NFe"      />
+          <field field_ref="NCHL"     />
+          <field field_ref="DCHL"     />
+          <field field_ref="NO3"      />
+          <field field_ref="NH4"      />
+	</file>
+
+	<file id="file13" name_suffix="_diad_T" description="additional pisces diagnostics" >
+          <field field_ref="PH"       />
+          <field field_ref="CO3"      />
+          <field field_ref="CO3sat"   />
+          <field field_ref="PAR"      />
+          <field field_ref="PPPHY"    />
+          <field field_ref="PPPHY2"   />
+          <field field_ref="PPNEWN"   />
+          <field field_ref="PPNEWD"   />
+          <field field_ref="PBSi"     />
+          <field field_ref="PFeN"     />
+          <field field_ref="PFeD"     />
+          <field field_ref="xfracal"  />
+          <field field_ref="PCAL"     />
+          <field field_ref="DCAL"     />
+          <field field_ref="GRAZ1"    />
+          <field field_ref="GRAZ2"    />
+          <field field_ref="EPC100"   />
+          <field field_ref="EPFE100"  />
+          <field field_ref="EPSI100"  />
+          <field field_ref="EPCAL100" />
+          <field field_ref="Cflx"     />
+          <field field_ref="Oflx"     />
+          <field field_ref="Kg"       />
+          <field field_ref="Dpco2"    />
+          <field field_ref="Dpo2"     />
+          <field field_ref="Heup"     />
+          <field field_ref="Irondep"  />
+          <field field_ref="Ironsed"  />
+          <field field_ref="Ironice"  />
+          <field field_ref="Nfix"     />
+          <field field_ref="MuN"      />
+          <field field_ref="MuD"      />
+          <field field_ref="LNnut"    />
+          <field field_ref="LDnut"    />
+          <field field_ref="LNFe"     />
+          <field field_ref="LDFe"     />
+          <field field_ref="LNlight"  />
+          <field field_ref="LDlight"  />
+          <field field_ref="pdust"    />
+          <field field_ref="Fe2"      />
+          <field field_ref="Fe3"      />
+          <field field_ref="FeL1"     />
+          <field field_ref="FeL2"     />
+          <field field_ref="FeP"      />
+          <field field_ref="TL1"      />
+          <field field_ref="TL2"      />
+          <field field_ref="Sdenit"   />
+          <field field_ref="Totlig"   />
+	</file>
+
+      </file_group>
+
+      <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="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </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">
+
+      <variable_definition>
+	
+     <!-- 
+        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
+-->
+	  <variable id="buffer_size"               type="integer">50000000</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>
+	
+      </variable_definition>
+               
+  </context>
+  
+</simulation>
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/GYRE/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/GYRE/namelist_cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/GYRE/namelist_cfg	(revision 6808)
@@ -0,0 +1,375 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  : GYRE_PISCES Configuration namelist to overwrite reference dynamical namelist
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  'GYRE_trust'		 !  experience name
+   nn_it000    =       1   		 !  first time step
+   nn_itend    =     120   		 !  last  time step
+   nn_stock    =      60   		 !  frequency of creation of a restart file (modulo referenced to 1)
+/
+!-----------------------------------------------------------------------
+&namcfg     !   parameters of the configuration   
+!-----------------------------------------------------------------------
+   cp_cfg      =  "gyre"                 !  name of the configuration
+   jp_cfg      =       1                 !  resolution of the configuration
+   jpidta      =      32                 !  1st lateral dimension ( >= jpi ) = 30*jp_cfg+2
+   jpjdta      =      22                 !  2nd    "         "    ( >= jpj ) = 20*jp_cfg+2 
+   jpkdta      =      31                 !  number of levels      ( >= jpk )
+   jpiglo      =      32                 !  1st dimension of global domain --> i  = jpidta
+   jpjglo      =      22                 !  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)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zco      = .true.    !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
+   ln_zps      = .false.   !  z-coordinate - partial steps   (T/F)
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file
+   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_rdtmin   = 7200.           !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 7200.           !  maximum time step on tracers (used if nn_acc=1)
+   jphgr_msh   =       5                 !  type of horizontal mesh
+   ppglam0     =       0.0               !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =      29.0               ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0               !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0               !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0               !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0               !  meridional grid-spacing (degrees)
+   ppsur       =   -2033.194295283385    !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     155.8325369664153   ! (default coefficients)
+   ppa1        =     146.3615918601890   !
+   ppkth       =      17.28520372419791  !
+   ppacr       =       5.0               !
+   ppdzmin     =  999999.0               !  Minimum vertical spacing
+   pphmax      =  999999.0               !  Maximum depth
+   ldbletanh   =  .FALSE.                !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0               !  Double tanh function parameters
+   ppkth2      =  999999.0               !
+   ppacr2      =  999999.0               !
+/
+!-----------------------------------------------------------------------
+&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   cn_dir        = './'      !  root directory for the location of the runoff files
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation
+   !                       !     (also = the frequency of sea-ice model call)
+   ln_ana      = .true.    !  analytical formulation                    (T => fill namsbc_ana )
+   ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core)
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+   nn_tau000   =   100     !  gently increase the stress over the first ntau_rst time-steps
+   rn_utau0    =   0.1e0   !  uniform value for the i-stress
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+   ln_qsr_rgb  = .false.   !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .true.    !  2 bands              light penetration
+   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+   nn_sssr     =     0     !  add a damping     term in the surface freshwater flux (=2)
+   rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
+   ln_sssr_bnd =   .false. !  flag to bound erp term (associated with nn_sssr=2)
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobc        !   open boundaries parameters                           ("key_obc")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide      !    tide parameters (#ifdef key_tide)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   nn_eos      =  0       !  type of equation of state and Brunt-Vaisala frequency
+                                 !  =-1, TEOS-10 
+                                 !  = 0, EOS-80 
+                                 !  = 1, S-EOS   (simplified eos)
+   ln_useCT    = .false.  ! 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)
+!!org GYRE   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+!!org GYRE   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
+!!org  caution  now a0 = alpha / rau0   with rau0 = 1026
+/
+!-----------------------------------------------------------------------
+&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
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]
+   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .true.  !  energy    conserving scheme  
+   ln_dynvor_ens = .false. !  enstrophy conserving scheme    
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .true.    !  z-coordinate - full steps
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+/
+!-----------------------------------------------------------------------
+!namdyn_spg    !   surface pressure gradient   (CPP key only)
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   rn_ahm_0_lap     = 100000.   !  horizontal laplacian eddy viscosity   [m2/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+   nn_etau     =   0       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+/
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+/
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface
+!-----------------------------------------------------------------------
+   nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
+   nn_nmin     =    210    !  minimum of iterations for the SOR solver
+   rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&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)
+/
+!!gm   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+!!gm   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+!!gm   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+!!gm   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+!!gm   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+!!gm   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+!!gm
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+    nn_dct      = 60       !  time step frequency for transports computing
+    nn_dctwri   = 60       !  time step frequency for transports writing
+    nn_secdebug = 0        !      0 : no section to debug
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+   ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA1_LIM3_PISCES/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA1_LIM3_PISCES/namelist_cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA1_LIM3_PISCES/namelist_cfg	(revision 6808)
@@ -0,0 +1,331 @@
+
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "O1L3P_trust"        !  experience name
+   nn_itend    =     240               !  last  time step (std 5475)
+   nn_euler    =       0               !  = 0 : start with forward time step if ln_rstart=T
+   nn_stock    =     120               !  frequency of creation of a restart file (modulo referenced to 1)
+/
+!-----------------------------------------------------------------------
+&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 )
+   jpjdta      =     332               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      75               !  number of levels      ( >= jpk )
+   jpiglo      =     362               !  1st dimension of global domain --> i =jpidta
+!   jpjglo      =     292               !  2nd    -                  -    --> j  =jpjdta
+   jpjglo      =     332               !  2nd    -                  -    --> j  =jpjdta
+   jperio      =       6               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -3958.951371276829  !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     103.9530096000000 ! (default coefficients)
+   ppa1        =       2.415951269000000   !
+   ppkth       =      15.35101370000000    !
+   ppacr       =       7.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ppa2        =     100.7609285000000 !  Double tanh function parameters
+   ppkth2      =      48.02989372000000    !
+   ppacr2      =      13.00000000000   !
+   rn_rdt      =    3600.              !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_hmin     =   20. 
+   nn_msh      =       0               !  create (=1) a mesh file or not (=0)
+/
+!-----------------------------------------------------------------------
+&namsplit       
+!----------------------------------------------------------------------- 
+   ln_bt_fw      =    .TRUE.           !  Forward integration of barotropic equations
+   ln_bt_av      =    .TRUE.           !  Time filtering of barotropic variables
+   ln_bt_nn_auto =    .TRUE.           !  Set nn_baro automatically to be just below
+                                       !  a user defined maximum courant number (rn_bt_cmax)
+   nn_baro       =    30               !  Number of iterations of barotropic mode
+                                       !  during rn_rdt seconds. Only used if ln_bt_nn_auto=F
+   rn_bt_cmax    =    0.8              !  Maximum courant number allowed if ln_bt_nn_auto=T 
+   nn_bt_flt     =    1                !  Time filter choice
+                                       !  = 0 None
+                                       !  = 1 Boxcar over   nn_baro barotropic steps
+                                       !  = 2 Boxcar over 2*nn_baro     "        
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_tradmp = .false.  !  damping of ocean T & S toward T &S input data (T) or not (F)
+   sn_tem  = 'conservative_temperature_WOA13_decav_Reg1L75_clim', -1 ,'votemper' , .true. , .true. , 'yearly' , 'weights_3D_WOA13d1_2_eorca1_bilinear.nc'  ,   ''    ,    ''
+   sn_sal  = 'absolute_salinity_WOA13_decav_Reg1L75_clim'       , -1 ,'vosaline' , .true. , .true. , 'yearly' , 'weights_3D_WOA13d1_2_eorca1_bilinear.nc'  ,   ''    ,    ''
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 3         !  frequency of surface boundary condition computation
+   nn_ice_embd = 1         ! embedded sea-ice (full salt and mass exchanges and pressure)
+   ln_dm2dc    = .true.    !  Daily mean to diurnal cycle on short wave
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
+   ln_rnf      = .true.    !  runoffs                                   (T   => fill namsbc_rnf)
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+!              !   file name                  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights              ! rotation !
+!              !                              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename             ! pairing  !
+   sn_wndi     = 'u_10.15JUNE2009_fill'       ,         6         , 'U_10_MOD',   .true.     ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bicubic.nc'  , 'U1'
+   sn_wndj     = 'v_10.15JUNE2009_fill'       ,         6         , 'V_10_MOD',   .true.     ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bicubic.nc'  , 'V1'
+   sn_qsr      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'SWDN_MOD',   .false.    ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bilinear.nc' , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'LWDN_MOD',   .true.     ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bilinear.nc' , ''
+   sn_tair     = 't_10.15JUNE2009_fill'       ,         6         , 'T_10_MOD',   .false.    ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bilinear.nc' , ''
+   sn_humi     = 'q_10.15JUNE2009_fill'       ,         6         , 'Q_10_MOD',   .false.    ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bilinear.nc' , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_fill',        -1         , 'PRC_MOD1',   .true.     ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bilinear.nc' , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_fill',        -1         , 'SNOW'    ,   .true.     ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bilinear.nc' , ''
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+   sn_chl      ='merged_ESACCI_BIOMER4V1R1_CHL_REG05',  -1  , 'CHLA' , .true. , .true. , 'yearly' , 'weights_reg05_2_eorca1_bilinear.nc' , '' , ''
+/
+!-----------------------------------------------------------------------
+&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      = 'eORCA_R1_runoff_clim_v1.0_nomask',        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_cnf      = 'eORCA_R1_runoff_clim_v1.0_nomask',         0         , 'socoeff' ,   .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'  , ''       , ''       , ''
+
+   ln_rnf_mouth = .false.    !  specific treatment at rivers mouths
+   ln_rnf_depth = .false.    !  read in depth information for runoff
+   ln_rnf_tem   = .false.    !  read in temperature information for runoff
+   ln_rnf_sal   = .false.    !  read in salinity information for runoff
+   ln_rnf_depth_ini = .true. !  compute depth at initialisation from runoff file
+   rn_rnf_max   = 0.05       !  max value of the runoff climatology over global domain ( if ln_rnf_depth_ini = .true )
+   rn_dep_max = 150.         !  depth over which runoffs is spread ( ln_rnf_depth_ini = .true )
+   nn_rnf_depth_file = 1     ! create (=1) a runoff depth file or not (=0)
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_sss      = 'sss_absolute_salinity_WOA13_decav_Reg1L75_clim', -1. , 'sosaline', .true. , .true. , 'yearly' , 'weights_WOA13d1_2_eorca1_bilinear.nc' , ''
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+      ln_icebergs              = .false.
+      ln_bergdia               = .false.              ! Calculate budgets
+      nn_verbose_level         = 0                    ! Turn on more verbose output if level > 0
+      nn_verbose_write         = 120                  ! Timesteps between verbose messages
+      nn_sample_rate           = 1                    ! Timesteps between sampling for trajectory storage
+                                                      ! 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  
+      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         
+      rn_mass_scaling          = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1
+                                                      ! thickness of newly calved bergs (m)
+      rn_initial_thickness     = 40., 67., 133., 175., 250., 250., 250., 250., 250., 250.
+      rn_rho_bergs             = 850.                 ! Density of icebergs
+      rn_LoW_ratio             = 1.5                  ! Initial ratio L/W for newly calved icebergs
+      ln_operator_splitting    = .true.               ! Use first order operator splitting for thermodynamics
+      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   
+      nn_test_icebergs         =   8                  ! 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_test_box              = -180.0,  180.0,  70.0,  90.0     !
+      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 = './' 
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    0.0    !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   sn_qgh      ='Goutorbe_ghflux.nc',  -12.  , 'gh_flux'    ,   .false.     , .true. , 'yearly'  , 'weights_Goutorbe1_2_eorca1_bilinear.nc'       , ''       , ''
+   !
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_tvd    =  .true.   !  TVD scheme
+   ln_traadv_ubs    =  .false.  !  UBS scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   ln_traldf_grif   =  .false.   !  griffies skew flux formulation       (require "key_ldfslp")
+   ln_traldf_gdia   =  .false.   !  griffies operator strfn diagnostics  (require "key_ldfslp")
+   ln_botmix_grif   =  .false.   !  griffies operator with lateral mixing on bottom (require "key_ldfslp")
+   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_aeiv_0        =  1000.    !  eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   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
+   nn_dynkeg     = 1       !  scheme for grad(KE): =0  C2  ; =1  Hollingsworth correction
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.    !  s-coordinate (standard jacobian formulation)
+   !ln_hpg_isf  = .true.    !  s-coordinate (sco ) adapted to isf
+   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
+                           !           centered      time scheme  (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   rn_ahm_0_lap     = 20000.    !  horizontal laplacian eddy viscosity   [m2/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface
+!-----------------------------------------------------------------------
+   nn_solv     =       2               !  elliptic solver: =2 successive-over-relaxation (sor)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!----------------------------------------------------------------------- 
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+   ln_diahsb  = .true.  
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends
+!              !       and/or mixed-layer trends and/or barotropic vorticity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsto       ! Stochastic parametrization of EOS
+!-----------------------------------------------------------------------
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA1_LIM3_PISCES/namelist_ice_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA1_LIM3_PISCES/namelist_ice_cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA1_LIM3_PISCES/namelist_ice_cfg	(revision 6808)
@@ -0,0 +1,42 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/LIM-3 : Ice configuration namelist. Overwrites SHARED/namelist_ice_lim3_ref
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!-----------------------------------------------------------------------
+&namicerun     !   Share parameters for dynamics/advection/thermo
+!-----------------------------------------------------------------------
+   ln_limdiahsb  = .false.         !  check the heat and salt budgets (T) or not (F)
+   ln_limdiaout  = .false.          !  output the heat and salt budgets (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namiceini     !   ice initialisation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namicedyn     !   ice dynamic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namicethd     !   ice thermodynamic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namicesal     !   ice salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namiceitdme   !   parameters for mechanical redistribution of ice 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namicedia     !   ice diagnostics
+!-----------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namiceitd     !   Ice discretization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicehdf     !   Ice horizontal diffusion
+!------------------------------------------------------------------------------
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM/1_namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM/1_namelist_cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM/1_namelist_cfg	(revision 6808)
@@ -0,0 +1,228 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  Configuration namelist used to overwrite SHARED/1_namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =   "O2LA_trust"        !  experience name 
+   nn_itend    =     300  	       !  last  time step
+   nn_stock    =     150               !  frequency of creation of a restart file (modulo referenced to 1)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "default"             !  name of the configuration
+   jp_cfg      =      -1               !  resolution of the configuration
+   jpidta      =     182               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     149               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     182               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     149               !  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)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------  
+   nn_msh      =       0               !  create (=1) a mesh file or not (=0)
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.              !  Minimum vertical spacing
+   pphmax      =  999999.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.              !
+   rn_rdt      = 2880.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_rdtmin   = 14400.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 14400.          !  maximum time step on tracers (used if nn_acc=1)
+/
+!-----------------------------------------------------------------------
+&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  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
+/
+!-----------------------------------------------------------------------
+&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_core2_agrif_bicubic.nc'      , 'Uwnd'   , ''
+   sn_wndj     = 'v_10.15JUNE2009_fill'        ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bicubic.nc'      , 'Vwnd'   , ''
+   sn_qsr      = 'ncar_rad.15JUNE2009_fill'    ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_fill'    ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+   sn_tair     = 't_10.15JUNE2009_fill'        ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+   sn_humi     = 'q_10.15JUNE2009_fill'        ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_fill' ,        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_fill' ,        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   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)
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , 'weights_bilin.nc'       , ''
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers 
+!-----------------------------------------------------------------------
+
+   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/  
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_dynldf_lap    =  .false.  !  laplacian operator         
+   ln_dynldf_bilap  =  .true.   !  bilaplacian operator    
+   rn_ahm_0_blp     = -8.5e+11  !  horizontal bilaplacian eddy viscosity [m4/s] 
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+/
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp_dyndist !   Massively Parallel Distribution for AGRIF zoom      ("key_agrif" && "key_mpp_dyndist")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage                                      ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM/namelist_cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM/namelist_cfg	(revision 6808)
@@ -0,0 +1,203 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =   "O2LA_trust"        !  experience name 
+   nn_itend    =     150  	       !  last  time step
+   nn_stock    =      75               !  frequency of creation of a restart file (modulo referenced to 1)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       2               !  resolution of the configuration
+   jpidta      =     182               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     149               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     182               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     149               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       4               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_msh      =       0               !  create (=1) a mesh file or not (=0)
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.              !  Minimum vertical spacing
+   pphmax      =  999999.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.              !
+/
+!-----------------------------------------------------------------------
+&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fwb      =       0               !  FreshWater Budget: =0 unchecked
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface
+!-----------------------------------------------------------------------
+   nn_solv     =      2    !  elliptic solver: =2 successive-over-relaxation (sor)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage                                      ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/iodef.xml
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/iodef.xml	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/iodef.xml	(revision 6808)
@@ -0,0 +1,284 @@
+<?xml version="1.0"?>
+<simulation> 
+
+ <context id="nemo" time_origin="1900-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="one_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 id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="sst"          name="tos" />
+	  <field field_ref="sss"          name="sos" />
+	  <field field_ref="ssh"          name="zos" />
+	</file>
+
+	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="ssu"          name="uos" />
+	</file>
+	
+	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="ssv"          name="vos" />
+	</file>
+
+        <file id="file4" name_suffix="_bioscalar" description="pisces sms variables" >
+          <field field_ref="tdenit"   name="tdenit"   unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field>
+          <field field_ref="tnfix"    name="tnfix"    unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field>
+          <field field_ref="tcflx"    name="tcflx"    unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="tcflxcum" name="tcflxcum" unit="PgC"    operation="instant" > tcflxcum * -1. * 12. / 1e15 </field>
+          <field field_ref="tcexp"    name="tcexp"    unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="tintpp"   name="tintpp"   unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="pno3tot"  name="pno3tot"  unit="umolN"  > pno3tot * 16. / 122. * 1e6 </field>
+          <field field_ref="ppo4tot"  name="ppo4tot"  unit="umolP"  > ppo4tot * 1. / 122. * 1e6 </field>
+          <field field_ref="psiltot"  name="psiltot"  unit="umolC"  > psiltot * 1e6  </field>
+          <field field_ref="palktot"  name="palktot"  unit="umolC"  > palktot * 1e6  </field>
+        <field field_ref="pfertot"  name="pfertot"  unit="nmolFe" > pfertot * 1e9  </field>
+                                                                                                                             </file>
+      </file_group>
+
+      <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="file5" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="thetao" />
+	  <field field_ref="soce"         name="so"     />
+	  <field field_ref="sst"          name="tos"    />
+	  <field field_ref="sst2"         name="tossq"  />
+	  <field field_ref="sss"          name="sos"    />
+	  <field field_ref="ssh"          name="zos"    />
+	  <field field_ref="ssh2"         name="zossq"  />
+	  <field field_ref="empmr"        name="wfo"    />
+	  <field field_ref="qsr"          name="rsntds" />
+	  <field field_ref="qt"           name="tohfls" />
+	  <field field_ref="taum"     />
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
+	</file>
+	
+	<file id="file6" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="uoce"         name="uo"     />
+	  <field field_ref="ssu"          name="uos"    />
+	  <field field_ref="utau"         name="tauuo"  />
+	</file>
+	
+	<file id="file7" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="voce"         name="vo"     />
+	  <field field_ref="ssv"          name="vos"    />
+	  <field field_ref="vtau"         name="tauvo"  />
+	</file>
+	
+	<file id="file8" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="woce"         name="wo"     />
+	  <field field_ref="avt"          name="difvho" />
+	</file>
+	
+	<file id="file9" name_suffix="_icemod" description="ice variables" >
+	  <field field_ref="ice_pres"   />
+	  <field field_ref="snowthic_cea" name="snd"    />
+	  <field field_ref="icethic_cea"  name="sit"    />
+	  <field field_ref="iceprod_cea"  name="sip"    />
+	  <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_group>
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."> <!-- real monthly files -->
+
+	<file id="file10" name_suffix="_ptrc_T" description="pisces sms variables" >
+          <field field_ref="DIC"      />
+          <field field_ref="Alkalini" />
+          <field field_ref="O2"       />
+          <field field_ref="PO4"      />
+          <field field_ref="Si"       />
+          <field field_ref="Fer"      />
+          <field field_ref="NCHL"     />
+          <field field_ref="DCHL"     />
+          <field field_ref="NO3"      />
+	</file>
+	
+	<file id="file11" name_suffix="_diad_T" description="additional pisces diagnostics" >
+          <field field_ref="Cflx"     />
+          <field field_ref="Dpco2"    />
+	</file>
+
+      </file_group>
+
+      <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 id="file12" name_suffix="_ptrc_T" description="pisces sms variables" >
+          <field field_ref="DIC"      />
+          <field field_ref="Alkalini" />
+          <field field_ref="O2"       />
+          <field field_ref="CaCO3"    />
+          <field field_ref="PO4"      />
+          <field field_ref="POC"      />
+          <field field_ref="Si"       />
+          <field field_ref="PHY"      />
+          <field field_ref="ZOO"      />
+          <field field_ref="DOC"      />
+          <field field_ref="PHY2"     />
+          <field field_ref="ZOO2"     />
+          <field field_ref="DSi"      />
+          <field field_ref="Fer"      />
+          <field field_ref="BFe"      />
+          <field field_ref="GOC"      />
+          <field field_ref="SFe"      />
+          <field field_ref="DFe"      />
+          <field field_ref="GSi"      />
+          <field field_ref="NFe"      />
+          <field field_ref="NCHL"     />
+          <field field_ref="DCHL"     />
+          <field field_ref="NO3"      />
+          <field field_ref="NH4"      />
+	</file>
+
+	<file id="file13" name_suffix="_diad_T" description="additional pisces diagnostics" >
+          <field field_ref="PH"       />
+          <field field_ref="CO3"      />
+          <field field_ref="CO3sat"   />
+          <field field_ref="PAR"      />
+          <field field_ref="PPPHY"    />
+          <field field_ref="PPPHY2"   />
+          <field field_ref="PPNEWN"   />
+          <field field_ref="PPNEWD"   />
+          <field field_ref="PBSi"     />
+          <field field_ref="PFeN"     />
+          <field field_ref="PFeD"     />
+          <field field_ref="xfracal"  />
+          <field field_ref="PCAL"     />
+          <field field_ref="DCAL"     />
+          <field field_ref="GRAZ1"    />
+          <field field_ref="GRAZ2"    />
+          <field field_ref="EPC100"   />
+          <field field_ref="EPFE100"  />
+          <field field_ref="EPSI100"  />
+          <field field_ref="EPCAL100" />
+          <field field_ref="Cflx"     />
+          <field field_ref="Oflx"     />
+          <field field_ref="Kg"       />
+          <field field_ref="Dpco2"    />
+          <field field_ref="Dpo2"     />
+          <field field_ref="Heup"     />
+          <field field_ref="Irondep"  />
+          <field field_ref="Ironsed"  />
+          <field field_ref="Ironice"  />
+          <field field_ref="Nfix"     />
+          <field field_ref="MuN"      />
+          <field field_ref="MuD"      />
+          <field field_ref="LNnut"    />
+          <field field_ref="LDnut"    />
+          <field field_ref="LNFe"     />
+          <field field_ref="LDFe"     />
+          <field field_ref="LNlight"  />
+          <field field_ref="LDlight"  />
+          <field field_ref="pdust"    />
+          <field field_ref="Fe2"      />
+          <field field_ref="Fe3"      />
+          <field field_ref="FeL1"     />
+          <field field_ref="FeL2"     />
+          <field field_ref="FeP"      />
+          <field field_ref="TL1"      />
+          <field field_ref="TL2"      />
+          <field field_ref="Sdenit"   />
+          <field field_ref="Totlig"   />
+	</file>
+
+      </file_group>
+
+      <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="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </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">
+
+      <variable_definition>
+	
+     <!-- 
+        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
+-->
+	  <variable id="buffer_size"               type="integer">50000000</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>
+	
+      </variable_definition>
+               
+  </context>
+  
+</simulation>
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_cfg	(revision 6808)
@@ -0,0 +1,205 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "O2LP_trust"         !  experience name
+   nn_itend    =     150               !  last  time step (std 5475)
+   nn_euler    =       0               !  = 0 : start with forward time step if ln_rstart=T
+   nn_stock    =      75               !  frequency of creation of a restart file (modulo referenced to 1)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       2               !  resolution of the configuration
+   jpidta      =     182               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     149               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     182               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     149               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       4               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_msh      =       0               !  create (=1) a mesh file or not (=0)
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.              !  Minimum vertical spacing
+   pphmax      =  999999.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.              !
+/
+!-----------------------------------------------------------------------
+&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fwb      =       0               !  FreshWater Budget: =0 unchecked
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface
+!-----------------------------------------------------------------------
+   nn_solv     =       2               !  elliptic solver: =2 successive-over-relaxation (sor)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsto       ! Stochastic parametrization of EOS
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends
+!              !       and/or mixed-layer trends and/or barotropic vorticity
+!-----------------------------------------------------------------------
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_pisces_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_pisces_cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_pisces_cfg	(revision 6808)
@@ -0,0 +1,72 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! PISCES  :   Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_pis_ref
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisext     !   air-sea exchange
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisatm     !  Atmospheric prrssure 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_presatm  = .false.   ! constant atmopsheric pressure (F) or from a file (T)
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisbio     !   biological parameters
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampislim     !   parameters for nutrient limitations
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisopt     !   parameters for optics
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_varpar   =  .false.  ! boolean for PAR variable
+/ 
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisprod     !   parameters for phytoplankton growth
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismort     !   parameters for phytoplankton sinks
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismes     !   parameters for mesozooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiszoo     !   parameters for microzooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisfer     !   parameters for iron chemistry
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/  
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisrem     !   parameters for remineralization
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiscal     !   parameters for Calcite chemistry
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampissbc     !   parameters for inputs deposition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_dust     =  .false.  ! boolean for dust input from the atmosphere
+   ln_solub    =  .false.  ! boolean for variable solubility of atm. Iron
+   ln_river    =  .false.  ! boolean for river input of nutrients
+   ln_ndepo    =  .false.  ! boolean for atmospheric deposition of N
+   ln_ironsed  =  .false.  ! boolean for Fe input from sediments
+   ln_hydrofe  =  .false.  ! boolean for from hydrothermal vents
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisdmp     !  Damping 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_pisdmp   =  .false.  !  Relaxation fo some tracers to a mean value
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismass     !  Mass conservation
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_top_cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_top_cfg	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_top_cfg	(revision 6808)
@@ -0,0 +1,97 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP1 :  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_top_ref
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namtrc_run     !   run information
+!-----------------------------------------------------------------------
+!   ln_top_euler  = .true.    !  use Euler time-stepping for TOP
+/
+!-----------------------------------------------------------------------
+&namtrc     !   tracers definition
+!-----------------------------------------------------------------------
+   ln_trcdta     =  .false.  !  Initialisation from data input file (T) or not (F)
+!                !    name   !           title of the field              ! initial data ! initial data ! save   !
+!                !           !                                           !  units       ! from file    ! or not ! 
+!                !           !                                           !              ! or not       !        !
+   sn_tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   ,  .true.     ,  .true.
+   sn_tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(4)   = 'CaCO3   ' , 'Calcite Concentration                  ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(6)   = 'POC     ' , 'Small organic carbon Concentration     ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(8)   = 'PHY     ' , 'Nanophytoplankton Concentration        ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(9)   = 'ZOO     ' , 'Microzooplankton Concentration         ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(10)  = 'DOC     ' , 'Dissolved organic Concentration        ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(11)  = 'PHY2    ' , 'Diatoms Concentration                  ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(13)  = 'DSi     ' , 'Diatoms Silicate Concentration         ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(15)  = 'BFe     ' , 'Big iron particles Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(16)  = 'GOC     ' , 'Big organic carbon Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(17)  = 'SFe     ' , 'Small iron particles Concentration     ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(18)  = 'DFe     ' , 'Diatoms iron  Concentration            ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(19)  = 'GSi     ' , 'Sinking biogenic Silicate Concentration',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(20)  = 'NFe     ' , 'Nano iron Concentration                ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(21)  = 'NCHL    ' , 'Nano chlorophyl Concentration          ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(22)  = 'DCHL    ' , 'Diatoms chlorophyl Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(24)  = 'NH4     ' , 'Ammonium Concentration                 ',  'mol-C/L' ,  .false.    ,  .true.
+/
+!-----------------------------------------------------------------------
+&namtrc_dta      !    Initialisation from data input file
+!-----------------------------------------------------------------------
+!          !  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_trcdta(1)  = 'data_DIC_nomask'        ,        -12        ,  'DIC'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(2)  = 'data_Alkalini_nomask'   ,        -12        ,  'Alkalini',    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(3)  = 'data_O2_nomask'         ,        -1         ,  'O2'      ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(5)  = 'data_PO4_nomask'        ,        -1         ,  'PO4'     ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(7)  = 'data_Si_nomask'         ,        -1         ,  'Si'      ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(10) = 'data_DOC_nomask'        ,        -12        ,  'DOC'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(14) = 'data_Fer_nomask'        ,        -12        ,  'Fer'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(23) = 'data_NO3_nomask'        ,        -1         ,  'NO3'     ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   rn_trfac(1)   =   1.0e-06  !  multiplicative factor
+   rn_trfac(2)   =   1.0e-06  !  -      -      -     -
+   rn_trfac(3)   =  44.6e-06  !  -      -      -     -
+   rn_trfac(5)   = 122.0e-06  !  -      -      -     -
+   rn_trfac(7)   =   1.0e-06  !  -      -      -     -
+   rn_trfac(10)  =   1.0      !  -      -      -     -
+   rn_trfac(14)  =   1.0      !  -      -      -     -
+   rn_trfac(23)  =   7.6e-06  !  -      -      -     -
+/
+!-----------------------------------------------------------------------
+&namtrc_adv    !   advection scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcadv_tvd     =  .false.  !  TVD scheme
+   ln_trcadv_muscl   =  .true.   !  MUSCL scheme
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_rad        !  treatment of negative concentrations 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_dia       !   parameters for passive tracer additional diagnostics
+!----------------------------------------------------------------------
+   ln_diatrc     =  .false.   !  save additional diag. (T) or not (F)
+/
+!----------------------------------------------------------------------
+&namtrc_bc        !   data for boundary conditions
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp    !   passive tracer newtonian damping   
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_ice       !    Representation of sea ice growth & melt effects
+!-----------------------------------------------------------------------
+/
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/install_new_branch.sh
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/install_new_branch.sh	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/install_new_branch.sh	(revision 6808)
@@ -0,0 +1,99 @@
+#!/bin/bash
+
+
+cd $( dirname $0 )
+
+## Set defaults
+##---------------------------------------------------
+TRUS_DBUG=0; TRUS_PROD=0; TRUS_HELP=0
+
+
+## Get options (for replacing initials settings)
+##---------------------------------------------------
+while [ $# -ne 0 ]; do
+    case $1 in
+	'-d'|'--debug'  ) TRUS_DBUG=1 ; shift  ;; '-j'|'--job' 	  ) TRUS_NPRO=$2; shift 2;;
+	'-m'|'--machine') TRUS_HPCC=$2; shift 2;; '-h'|'--help'	  ) TRUS_HELP=1 ; shift  ;;
+	'-u'|'--user'   ) TRUS_USER=$2; shift 2;; "*"             ) TRUS_HELP=1 ; shift  ;;
+    esac
+done
+
+
+## Initialization (HPC & user environment)
+##---------------------------------------------------
+if [[ ! -e config/${TRUS_USER}.cfg || ! -e config/${TRUS_HPCC}.cfg || ${TRUS_HELP} -eq 1 ]]; then
+    cat ./inc/trusting_help.txt
+
+    if [ ${TRUS_HELP} -eq 0 ]; then
+	printf "\n\n\033[0;33m"
+	printf "At least one configuration (arch or user) file is missing or misspelled:"
+	printf "\t'%s'.cfg\t'%s'.cfg" ${TRUS_USER} ${TRUS_HPCC}
+	printf "\033[0m"
+    fi
+
+    printf "\n\nContent of 'config' folder:\n"
+    find config -name *.cfg | cut -d/ -f2 \
+	| xargs -n 4 printf "\t- %-25s\t- %-25s\t- %-25s\t- %-25s\n"
+    exit 1
+else
+    . ./inc/trusting.env
+    [ ${TRUS_DBUG} -eq 1 ] && set -vx
+fi
+
+
+## List last branches from NEMO Forge
+##---------------------------------------------------
+printf "\nWhat branch do you want to install in "${TRUS_WORK}" for trusting test ? "
+echo 'Enter 0 to abort'
+select branch in 'trunk' $( svn ls ${TRUS_SVNH}/branches/2015 | tr -d / | sort -r ); do
+
+    if [ $REPLY -eq 0 ]; then exit 1; else export TRUS_BRAN=$branch; fi
+
+    printf "\nInstallation of a working copy of '%s' branch in '%s'? " ${TRUS_BRAN} ${TRUS_WORK}
+    printf "\nType [Y|y|yes] to confirm, if not back to branches list number\n"
+    read answer
+    [[ $answer == 'Y' || $answer == 'y' || $answer == 'yes' ]] && break
+
+done
+
+echo
+
+
+## First checkout of selected branch
+##---------------------------------------------------
+echo 'Initial checkout of '${TRUS_BRAN}' branch'
+mkdir -p ${TRUS_WORK}/${TRUS_BRAN}/NEMOGCM
+cd       ${TRUS_WORK}/${TRUS_BRAN}/NEMOGCM
+
+svn_bran=branches/2015/${TRUS_BRAN}
+[ ${TRUS_BRAN} == 'trunk' ] && svn_bran=${TRUS_BRAN}
+
+for elmt in ${TRUS_CKOT}; do
+    [ $elmt == '\' ] && continue
+    printf "%s " $elmt
+
+    if [ $elmt == 'TOOLS/maketools' ]; then
+	svn co -q ${TRUS_SVNH}/${svn_bran}/NEMOGCM/TOOLS --depth empty
+	svn up -q $elmt
+    else
+	svn co -q ${TRUS_SVNH}/${svn_bran}/NEMOGCM/$elmt $elmt
+    fi
+
+done
+
+printf "\n\n"
+
+
+## Compile rebuild_nemo.exe in anticipation
+##---------------------------------------------------
+if [ $( find ARCH -name arch-${TRUS_HPCC}.fcm ) ]; then
+    echo 'Compile NEMO rebuild tool'
+    cd TOOLS && ./maketools -n REBUILD_NEMO -m ${TRUS_HPCC} -j ${TRUS_NPRO} >& /dev/null
+    [ -e REBUILD_NEMO/rebuild_nemo.exe ] && printf "\033[0;32mOK\033[0m" || printf "\033[0;31mKO\033[0m"
+    printf "\n\n"
+else
+    printf "\033[0;31mNo arch file found to compile NEMO rebuild tool\033[0m\n\n"
+fi
+
+exit 0
+
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/trusting.sh
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/trusting.sh	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/trusting.sh	(revision 6808)
@@ -0,0 +1,181 @@
+#!/bin/bash
+
+
+cd $( dirname $0 )
+
+## Set defaults
+##---------------------------------------------------
+TRUS_DIRE=$PWD
+TRUS_DBUG=0; TRUS_PROD=0; TRUS_HELP=0
+## No update on SVN directories & 'FAILED' result for 'Unknown error' )
+TRUS_SVNA='svn status'; TRUS_RSLT='FAILED'; TRUS_RORR=0
+xios_mode='--full'; stdout_redir='>&'
+rev=$( svn info | awk '(NR == 9) {print $NF}' )
+
+
+## Get options (replacing initials settings)
+##---------------------------------------------------
+while [ $# -ne 0 ]; do
+    case $1 in
+	'-a'|'--archive') TRUS_TARF=$2; shift 2;; '-b'|'--branch' ) TRUS_BRAN=$2; shift 2;;
+	'-d'|'--debug'  ) TRUS_DBUG=1 ; shift  ;; '-e'|'--email'  ) TRUS_MAIL=$2; shift 2;;
+	'-f'|'--forcdir') TRUS_FORC=$2; shift 2;; '-j'|'--job'    ) TRUS_NPRO=$2; shift 2;;
+	'-h'|'--help'   ) TRUS_HELP=1 ; shift  ;; '-m'|'--machine') TRUS_HPCC=$2; shift 2;;
+	'-n'|'--newconf') TRUS_CONF=$2; shift 2;; '-r'|'--refconf') TRUS_REFE=$2; shift 2;;
+	'-t'|'--time'   ) TRUS_TOUT=$2; shift 2;; '-p'|'--prod'   ) TRUS_PROD=1 ; shift  ;;
+	'-u'|'--user'   ) TRUS_USER=$2; shift 2;; '-v'|'--version') TRUS_SVNV=$2; shift 2;;
+	'-w'|'--workdir') TRUS_WORK=$2; shift 2;; "*"             ) TRUS_HELP=1 ; shift  ;;
+    esac
+done
+
+
+## Initialization (HPC & user environment)
+##---------------------------------------------------
+if [[ ! -e config/${TRUS_USER}.cfg || ! -e config/${TRUS_HPCC}.cfg || ${TRUS_HELP} -eq 1 ]]; then
+    cat ./inc/trusting_help.txt
+
+    if [ ${TRUS_HELP} -eq 0 ]; then
+	printf "\n\n\033[0;33m"
+	printf "At least one configuration (arch or user) file is missing or misspelled:"
+	printf "\t'%s'.cfg\t'%s'.cfg" ${TRUS_USER} ${TRUS_HPCC}
+	printf "\033[0m"
+    fi
+
+    printf "\n\nContent of 'config' folder:"
+    find config -name *.cfg | cut -d/ -f2 \
+	| xargs -n 4 printf "%-25s\t%-25s\t%-25s\n"
+    exit 1
+else
+    . ./inc/trusting.env && . ./inc/trusting_func.sh
+
+    ## DEBUG option to speed up & expand verbosity of compilation
+    [ ${TRUS_DBUG} -eq 1 ] && { set -vx; xios_mode=''; stdout_redir='>'; }
+
+    ## If -v|--version option has been set, modify default SVN action on directories
+    if   [ $( echo ${TRUS_SVNV} | grep  "HEAD\|up\|update"                     ) ]; then
+	TRUS_SVNA='svn update -r HEAD'
+    elif [ $( echo ${TRUS_SVNV} | grep -o '{[0-9]\{4\}-[0-9]\{2\}-[0-9]\{2\}}' ) ]; then
+	TRUS_SVNA='svn update -r     '$( echo ${TRUS_SVNV} | grep -o '{[0-9]\{4\}-[0-9]\{2\}-[0-9]\{2\}}' )
+    elif [ $( echo ${TRUS_SVNV} | grep -o '[0-9]*'                             ) ]; then
+	TRUS_SVNA='svn update -r     '$( echo ${TRUS_SVNV} | grep -o '[0-9]*' )
+    fi
+
+fi
+
+
+## Display contextual summary of trusting test
+##---------------------------------------------------
+echo
+if [ -t 0 ]; then cat ./inc/banner.txt; else cat ./inc/banner.html; fi
+echo
+echo '****************************************************************************************************'
+echo '*                                                                                                  *'
+echo '*                           NEMO Trusting (Continuous Integration Tool)                            *'
+echo "*                                             ver.$rev                                             *"
+echo '*                                                                                                  *'
+echo '****************************************************************************************************'
+echo
+printf "\t§ Testing configuration\t\t%s based on %s\n" ${TRUS_CONF} ${TRUS_REFE}
+printf "\t§ SVN working copy\t\t%s/%s\n"               ${TRUS_WORK} ${TRUS_BRAN}
+printf "\t§ Benchmark folder\t\t%s\n"       	       ${TRUS_STOR}
+printf "\t§ (Super)Computer\t\t%s\n" 		       ${TRUS_HPCC}
+printf "\t§ User installation\t\t%s\n\n" 	       ${TRUS_USER}
+
+
+## Make timestamped directory with messenger files
+##---------------------------------------------------
+print_step 'Timestamped testing directory'
+mkdir -p ${TRUS_SCRA} ${TRUS_STOR}
+cd       ${TRUS_SCRA}
+echo     ${TRUS_SCRA}
+init_files
+get_date
+
+
+## Get SVN revision on XIOS & NEMO essentials directories
+##---------------------------------------------------
+print_step "SVN action on NEMO directories: ${TRUS_SVNA}"
+get_nemo_rev
+
+
+## Check softwares versions (after sourced arch environment)
+##---------------------------------------------------
+print_step 'Get testing environement'
+get_soft_rel
+cat model.log | awk '{printf "%-20s %s %s\n", $1, $2, $3}'
+env | sort > env.log
+
+
+## XIOS compilation from scratch
+##---------------------------------------------------
+print_step 'Compile XIOS'
+cd ${TRUS_XIOS}
+eval ./make_xios ${xios_mode} --arch ${TRUS_HPCC} --job ${TRUS_NPRO} \
+    ${stdout_redir} /dev/null
+[ ! -e lib/libxios.a ] && get_out 1 || echo 'Success'
+
+
+## NEMO compilation from scratch
+##---------------------------------------------------
+print_step "Compile ${TRUS_REFE} configuration"
+cd ${TRUS_NGCM}/CONFIG
+[[ -d ${TRUS_CONF} && ${TRUS_DBUG} -eq 0 ]] && ./makenemo -n ${TRUS_CONF} clean_config \
+    > /dev/null <<EOF
+y
+EOF
+
+eval ./makenemo -n ${TRUS_CONF} -r ${TRUS_REFE} -m ${TRUS_HPCC} -j ${TRUS_NPRO} \
+                ${TRUS_KEYA} ${TRUS_KEYD}                                       \
+    ${stdout_redir} /dev/null
+[ ! -e ${TRUS_CONF}/BLD/bin/nemo.exe ] && get_out 2 || echo 'Success'
+
+
+## Get all inputs for running
+##---------------------------------------------------
+print_step 'Set job (copying or extracting inputs)'
+cd ${TRUS_SCRA}
+get_inputs
+cp   ${TRUS_NGCM}/CONFIG/${TRUS_CONF}/cpp_* .
+find ${TRUS_NGCM}/CONFIG/${TRUS_CONF}/EXP00 -regex '.*\(_cfg\|.in\|opa\|_ref\|.xml\)' \
+                                            -exec  cp {} . \;
+
+
+## Check inputs
+##---------------------------------------------------
+print_step 'Compare inputs'
+diff_inputs
+
+
+## Job submission & computation
+##---------------------------------------------------
+print_step 'Submit job'
+cp ${TRUS_DIRE}/batch/${TRUS_JSPT} ${TRUS_SCRA} ## Copy the submitting script to testing folder
+TRUS_JIDN=$( eval ${TRUS_JSUB} )
+[ $? -ne 0 ] && get_out 4 || printf "Success (job ID %s)\n" ${TRUS_JIDN}
+print_step 'Pending job'
+job_pending
+print_step 'Job finished'
+
+
+## Check job state & get computation performances if succeeded
+##---------------------------------------------------
+print_step 'Test job state'
+[[ ! -e time.step || $( grep 'E R R O R' ocean.output ) ]] && get_out 5 || echo 'Success' ## Must be reviewed
+print_step 'Get job performances'
+get_time
+get_memy
+
+
+## Check outputs
+##---------------------------------------------------
+TRUS_RSLT='OK' ## 'OK' by default
+print_step 'Compare outputs'
+diff_results
+print_step 'Compare restarts'
+diff_restart
+[ $TRUS_RSLT == 'FAILED' ] && get_out 8
+
+
+## End, at least nothing has changed ;-)
+##---------------------------------------------------
+get_out 0
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/html/sortabletable.css
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/html/sortabletable.css	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/html/sortabletable.css	(revision 6808)
@@ -0,0 +1,50 @@
+.sort-table {
+	font:		Icon;
+	border:		1px Solid ThreeDShadow;
+	background:	Window;
+	color:		WindowText;
+}
+
+.sort-table thead {
+	background:	ButtonFace;
+}
+
+.sort-table td {
+	padding:	2px 5px;
+}
+
+.sort-table thead td {
+	border:			1px solid;
+	border-color:	ButtonHighlight ButtonShadow
+					ButtonShadow ButtonHighlight;
+	cursor:			default;
+}
+
+.sort-table thead td:active {
+	border-color:	ButtonShadow ButtonHighlight
+					ButtonHighlight ButtonShadow;
+	padding:		3px 4px 1px 6px;
+}
+
+.sort-table thead td[_sortType=None]:active {
+	border-color:	ButtonHighlight ButtonShadow
+					ButtonShadow ButtonHighlight;
+	padding:		2px 5px;
+}
+
+.sort-arrow {
+	width:					11px;
+	height:					11px;
+	background-position:	center center;
+	background-repeat:		no-repeat;
+	margin:					0 2px;
+}
+
+.sort-arrow.descending {
+	background-image:		url("images/downsimple.png");
+
+}
+
+.sort-arrow.ascending {
+	background-image:		url("images/upsimple.png");
+}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/html/sortabletable.js
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/html/sortabletable.js	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/html/sortabletable.js	(revision 6808)
@@ -0,0 +1,438 @@
+/*----------------------------------------------------------------------------\
+|                            Sortable Table 1.12                              |
+|-----------------------------------------------------------------------------|
+|                         Created by Erik Arvidsson                           |
+|                  (http://webfx.eae.net/contact.html#erik)                   |
+|                      For WebFX (http://webfx.eae.net/)                      |
+|-----------------------------------------------------------------------------|
+| A DOM 1 based script that allows an ordinary HTML table to be sortable.     |
+|-----------------------------------------------------------------------------|
+|                  Copyright (c) 1998 - 2006 Erik Arvidsson                   |
+|-----------------------------------------------------------------------------|
+| Licensed under the Apache License, Version 2.0 (the "License"); you may not |
+| use this file except in compliance with the License.  You may obtain a copy |
+| of the License at http://www.apache.org/licenses/LICENSE-2.0                |
+| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
+| Unless  required  by  applicable law or  agreed  to  in  writing,  software |
+| distributed under the License is distributed on an  "AS IS" BASIS,  WITHOUT |
+| WARRANTIES OR  CONDITIONS OF ANY KIND,  either express or implied.  See the |
+| License  for the  specific language  governing permissions  and limitations |
+| under the License.                                                          |
+|-----------------------------------------------------------------------------|
+| 2003-01-10 | First version                                                  |
+| 2003-01-19 | Minor changes to the date parsing                              |
+| 2003-01-28 | JScript 5.0 fixes (no support for 'in' operator)               |
+| 2003-02-01 | Sloppy typo like error fixed in getInnerText                   |
+| 2003-07-04 | Added workaround for IE cellIndex bug.                         |
+| 2003-11-09 | The bDescending argument to sort was not correctly working     |
+|            | Using onclick DOM0 event if no support for addEventListener    |
+|            | or attachEvent                                                 |
+| 2004-01-13 | Adding addSortType and removeSortType which makes it a lot     |
+|            | easier to add new, custom sort types.                          |
+| 2004-01-27 | Switch to use descending = false as the default sort order.    |
+|            | Change defaultDescending to suit your needs.                   |
+| 2004-03-14 | Improved sort type None look and feel a bit                    |
+| 2004-08-26 | Made the handling of tBody and tHead more flexible. Now you    |
+|            | can use another tHead or no tHead, and you can chose some      |
+|            | other tBody.                                                   |
+| 2006-04-25 | Changed license to Apache Software License 2.0                 |  
+|-----------------------------------------------------------------------------|
+| Created 2003-01-10 | All changes are in the log above. | Updated 2006-04-25 |
+\----------------------------------------------------------------------------*/
+
+
+function SortableTable(oTable, oSortTypes) {
+
+	this.sortTypes = oSortTypes || [];
+
+	this.sortColumn = null;
+	this.descending = null;
+
+	var oThis = this;
+	this._headerOnclick = function (e) {
+		oThis.headerOnclick(e);
+	};
+
+	if (oTable) {
+		this.setTable( oTable );
+		this.document = oTable.ownerDocument || oTable.document;
+	}
+	else {
+		this.document = document;
+	}
+
+
+	// only IE needs this
+	var win = this.document.defaultView || this.document.parentWindow;
+	this._onunload = function () {
+		oThis.destroy();
+	};
+	if (win && typeof win.attachEvent != "undefined") {
+		win.attachEvent("onunload", this._onunload);
+	}
+}
+
+SortableTable.gecko = navigator.product == "Gecko";
+SortableTable.msie = /msie/i.test(navigator.userAgent);
+// Mozilla is faster when doing the DOM manipulations on
+// an orphaned element. MSIE is not
+SortableTable.removeBeforeSort = SortableTable.gecko;
+
+SortableTable.prototype.onsort = function () {};
+
+// default sort order. true -> descending, false -> ascending
+SortableTable.prototype.defaultDescending = false;
+
+// shared between all instances. This is intentional to allow external files
+// to modify the prototype
+SortableTable.prototype._sortTypeInfo = {};
+
+SortableTable.prototype.setTable = function (oTable) {
+	if ( this.tHead )
+		this.uninitHeader();
+	this.element = oTable;
+	this.setTHead( oTable.tHead );
+	this.setTBody( oTable.tBodies[0] );
+};
+
+SortableTable.prototype.setTHead = function (oTHead) {
+	if (this.tHead && this.tHead != oTHead )
+		this.uninitHeader();
+	this.tHead = oTHead;
+	this.initHeader( this.sortTypes );
+};
+
+SortableTable.prototype.setTBody = function (oTBody) {
+	this.tBody = oTBody;
+};
+
+SortableTable.prototype.setSortTypes = function ( oSortTypes ) {
+	if ( this.tHead )
+		this.uninitHeader();
+	this.sortTypes = oSortTypes || [];
+	if ( this.tHead )
+		this.initHeader( this.sortTypes );
+};
+
+// adds arrow containers and events
+// also binds sort type to the header cells so that reordering columns does
+// not break the sort types
+SortableTable.prototype.initHeader = function (oSortTypes) {
+	if (!this.tHead) return;
+	var cells = this.tHead.rows[0].cells;
+	var doc = this.tHead.ownerDocument || this.tHead.document;
+	this.sortTypes = oSortTypes || [];
+	var l = cells.length;
+	var img, c;
+	for (var i = 0; i < l; i++) {
+		c = cells[i];
+		if (this.sortTypes[i] != null && this.sortTypes[i] != "None") {
+			img = doc.createElement("IMG");
+			img.src = "html/images/blank.png";
+			c.appendChild(img);
+			if (this.sortTypes[i] != null)
+				c._sortType = this.sortTypes[i];
+			if (typeof c.addEventListener != "undefined")
+				c.addEventListener("click", this._headerOnclick, false);
+			else if (typeof c.attachEvent != "undefined")
+				c.attachEvent("onclick", this._headerOnclick);
+			else
+				c.onclick = this._headerOnclick;
+		}
+		else
+		{
+			c.setAttribute( "_sortType", oSortTypes[i] );
+			c._sortType = "None";
+		}
+	}
+	this.updateHeaderArrows();
+};
+
+// remove arrows and events
+SortableTable.prototype.uninitHeader = function () {
+	if (!this.tHead) return;
+	var cells = this.tHead.rows[0].cells;
+	var l = cells.length;
+	var c;
+	for (var i = 0; i < l; i++) {
+		c = cells[i];
+		if (c._sortType != null && c._sortType != "None") {
+			c.removeChild(c.lastChild);
+			if (typeof c.removeEventListener != "undefined")
+				c.removeEventListener("click", this._headerOnclick, false);
+			else if (typeof c.detachEvent != "undefined")
+				c.detachEvent("onclick", this._headerOnclick);
+			c._sortType = null;
+			c.removeAttribute( "_sortType" );
+		}
+	}
+};
+
+SortableTable.prototype.updateHeaderArrows = function () {
+	if (!this.tHead) return;
+	var cells = this.tHead.rows[0].cells;
+	var l = cells.length;
+	var img;
+	for (var i = 0; i < l; i++) {
+		if (cells[i]._sortType != null && cells[i]._sortType != "None") {
+			img = cells[i].lastChild;
+			if (i == this.sortColumn)
+				img.className = "sort-arrow " + (this.descending ? "descending" : "ascending");
+			else
+				img.className = "sort-arrow";
+		}
+	}
+};
+
+SortableTable.prototype.headerOnclick = function (e) {
+	// find TD element
+	var el = e.target || e.srcElement;
+	while (el.tagName != "TD")
+		el = el.parentNode;
+
+	this.sort(SortableTable.msie ? SortableTable.getCellIndex(el) : el.cellIndex);
+};
+
+// IE returns wrong cellIndex when columns are hidden
+SortableTable.getCellIndex = function (oTd) {
+	var cells = oTd.parentNode.childNodes
+	var l = cells.length;
+	var i;
+	for (i = 0; cells[i] != oTd && i < l; i++)
+		;
+	return i;
+};
+
+SortableTable.prototype.getSortType = function (nColumn) {
+	return this.sortTypes[nColumn] || "String";
+};
+
+// only nColumn is required
+// if bDescending is left out the old value is taken into account
+// if sSortType is left out the sort type is found from the sortTypes array
+
+SortableTable.prototype.sort = function (nColumn, bDescending, sSortType) {
+	if (!this.tBody) return;
+	if (sSortType == null)
+		sSortType = this.getSortType(nColumn);
+
+	// exit if None
+	if (sSortType == "None")
+		return;
+
+	if (bDescending == null) {
+		if (this.sortColumn != nColumn)
+			this.descending = this.defaultDescending;
+		else
+			this.descending = !this.descending;
+	}
+	else
+		this.descending = bDescending;
+
+	this.sortColumn = nColumn;
+
+	if (typeof this.onbeforesort == "function")
+		this.onbeforesort();
+
+	var f = this.getSortFunction(sSortType, nColumn);
+	var a = this.getCache(sSortType, nColumn);
+	var tBody = this.tBody;
+
+	a.sort(f);
+
+	if (this.descending)
+		a.reverse();
+
+	if (SortableTable.removeBeforeSort) {
+		// remove from doc
+		var nextSibling = tBody.nextSibling;
+		var p = tBody.parentNode;
+		p.removeChild(tBody);
+	}
+
+	// insert in the new order
+	var l = a.length;
+	for (var i = 0; i < l; i++)
+		tBody.appendChild(a[i].element);
+
+	if (SortableTable.removeBeforeSort) {
+		// insert into doc
+		p.insertBefore(tBody, nextSibling);
+	}
+
+	this.updateHeaderArrows();
+
+	this.destroyCache(a);
+
+	if (typeof this.onsort == "function")
+		this.onsort();
+};
+
+SortableTable.prototype.asyncSort = function (nColumn, bDescending, sSortType) {
+	var oThis = this;
+	this._asyncsort = function () {
+		oThis.sort(nColumn, bDescending, sSortType);
+	};
+	window.setTimeout(this._asyncsort, 1);
+};
+
+SortableTable.prototype.getCache = function (sType, nColumn) {
+	if (!this.tBody) return [];
+	var rows = this.tBody.rows;
+	var l = rows.length;
+	var a = new Array(l);
+	var r;
+	for (var i = 0; i < l; i++) {
+		r = rows[i];
+		a[i] = {
+			value:		this.getRowValue(r, sType, nColumn),
+			element:	r
+		};
+	};
+	return a;
+};
+
+SortableTable.prototype.destroyCache = function (oArray) {
+	var l = oArray.length;
+	for (var i = 0; i < l; i++) {
+		oArray[i].value = null;
+		oArray[i].element = null;
+		oArray[i] = null;
+	}
+};
+
+SortableTable.prototype.getRowValue = function (oRow, sType, nColumn) {
+	// if we have defined a custom getRowValue use that
+	if (this._sortTypeInfo[sType] && this._sortTypeInfo[sType].getRowValue)
+		return this._sortTypeInfo[sType].getRowValue(oRow, nColumn);
+
+	var s;
+	var c = oRow.cells[nColumn];
+	if (typeof c.innerText != "undefined")
+		s = c.innerText;
+	else
+		s = SortableTable.getInnerText(c);
+	return this.getValueFromString(s, sType);
+};
+
+SortableTable.getInnerText = function (oNode) {
+	var s = "";
+	var cs = oNode.childNodes;
+	var l = cs.length;
+	for (var i = 0; i < l; i++) {
+		switch (cs[i].nodeType) {
+			case 1: //ELEMENT_NODE
+				s += SortableTable.getInnerText(cs[i]);
+				break;
+			case 3:	//TEXT_NODE
+				s += cs[i].nodeValue;
+				break;
+		}
+	}
+	return s;
+};
+
+SortableTable.prototype.getValueFromString = function (sText, sType) {
+	if (this._sortTypeInfo[sType])
+		return this._sortTypeInfo[sType].getValueFromString( sText );
+	return sText;
+	/*
+	switch (sType) {
+		case "Number":
+			return Number(sText);
+		case "CaseInsensitiveString":
+			return sText.toUpperCase();
+		case "Date":
+			var parts = sText.split("-");
+			var d = new Date(0);
+			d.setFullYear(parts[0]);
+			d.setDate(parts[2]);
+			d.setMonth(parts[1] - 1);
+			return d.valueOf();
+	}
+	return sText;
+	*/
+	};
+
+SortableTable.prototype.getSortFunction = function (sType, nColumn) {
+	if (this._sortTypeInfo[sType])
+		return this._sortTypeInfo[sType].compare;
+	return SortableTable.basicCompare;
+};
+
+SortableTable.prototype.destroy = function () {
+	this.uninitHeader();
+	var win = this.document.parentWindow;
+	if (win && typeof win.detachEvent != "undefined") {	// only IE needs this
+		win.detachEvent("onunload", this._onunload);
+	}
+	this._onunload = null;
+	this.element = null;
+	this.tHead = null;
+	this.tBody = null;
+	this.document = null;
+	this._headerOnclick = null;
+	this.sortTypes = null;
+	this._asyncsort = null;
+	this.onsort = null;
+};
+
+// Adds a sort type to all instance of SortableTable
+// sType : String - the identifier of the sort type
+// fGetValueFromString : function ( s : string ) : T - A function that takes a
+//    string and casts it to a desired format. If left out the string is just
+//    returned
+// fCompareFunction : function ( n1 : T, n2 : T ) : Number - A normal JS sort
+//    compare function. Takes two values and compares them. If left out less than,
+//    <, compare is used
+// fGetRowValue : function( oRow : HTMLTRElement, nColumn : int ) : T - A function
+//    that takes the row and the column index and returns the value used to compare.
+//    If left out then the innerText is first taken for the cell and then the
+//    fGetValueFromString is used to convert that string the desired value and type
+
+SortableTable.prototype.addSortType = function (sType, fGetValueFromString, fCompareFunction, fGetRowValue) {
+	this._sortTypeInfo[sType] = {
+		type:				sType,
+		getValueFromString:	fGetValueFromString || SortableTable.idFunction,
+		compare:			fCompareFunction || SortableTable.basicCompare,
+		getRowValue:		fGetRowValue
+	};
+};
+
+// this removes the sort type from all instances of SortableTable
+SortableTable.prototype.removeSortType = function (sType) {
+	delete this._sortTypeInfo[sType];
+};
+
+SortableTable.basicCompare = function compare(n1, n2) {
+	if (n1.value < n2.value)
+		return -1;
+	if (n2.value < n1.value)
+		return 1;
+	return 0;
+};
+
+SortableTable.idFunction = function (x) {
+	return x;
+};
+
+SortableTable.toUpperCase = function (s) {
+	return s.toUpperCase();
+};
+
+SortableTable.toDate = function (s) {
+	var parts = s.split("-");
+	var d = new Date(0);
+	d.setFullYear(parts[0]);
+	d.setDate(parts[2]);
+	d.setMonth(parts[1] - 1);
+	return d.valueOf();
+};
+
+
+// add sort types
+SortableTable.prototype.addSortType("Number", Number);
+SortableTable.prototype.addSortType("CaseInsensitiveString", SortableTable.toUpperCase);
+SortableTable.prototype.addSortType("Date", SortableTable.toDate);
+SortableTable.prototype.addSortType("String");
+// None is a special case
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/html/tab-view.css
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/html/tab-view.css	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/html/tab-view.css	(revision 6808)
@@ -0,0 +1,60 @@
+	.dhtmlgoodies_tabPane{
+		height:21px;	/* Height of tabs */
+		border-bottom:1px solid #919b9c;
+	}
+	.dhtmlgoodies_aTab{
+		border-left:1px solid #919b9c;
+		border-right:1px solid #919b9c;
+		border-bottom:1px solid #919b9c;
+		font-family: Trebuchet MS, Lucida Sans Unicode, Arial, sans-serif;
+		padding:5px;		
+		
+	}
+	.dhtmlgoodies_tabPane DIV{
+		float:left;
+		height:100%;	/* Height of tabs */
+		padding-left:3px;
+		vertical-align:middle;
+		background-repeat:no-repeat;
+		background-position:bottom left;
+		cursor:pointer;
+		position:relative;
+		bottom:-1px;
+		margin-left:0px;
+		margin-right:0px;
+	}
+	.dhtmlgoodies_tabPane .tabActive{
+		background-image:url('../images/tab_left_active.gif');
+		margin-left:0px;
+		margin-right:0px;	
+		z-index:10;	
+	}
+	.dhtmlgoodies_tabPane .tabInactive{
+		background-image:url('../images/tab_left_inactive.gif');
+		margin-left:0px;
+		margin-right:0px;
+		z-index:1;
+	}
+
+	.dhtmlgoodies_tabPane .inactiveTabOver{
+		background-image:url('../images/tab_left_over.gif');
+		margin-left:0px;
+		margin-right:0px;
+	}
+	.dhtmlgoodies_tabPane span{
+		font-family:arial;
+		vertical-align:top;
+		font-size:11px;
+		padding-left:3px;
+		padding-right:3px;		
+		line-height:21px;
+		float:left;
+	}
+	.dhtmlgoodies_tabPane .tabActive span{
+		padding-bottom:1px;
+		line-height:20px;
+	}
+	
+	.dhtmlgoodies_tabPane img{
+		float:left;
+	}
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/html/tab-view.js
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/html/tab-view.js	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/html/tab-view.js	(revision 6808)
@@ -0,0 +1,375 @@
+	/************************************************************************************************************
+	(C) www.dhtmlgoodies.com, October 2005
+	
+	This is a script from www.dhtmlgoodies.com. You will find this and a lot of other scripts at our website.	
+	
+	Terms of use:
+	You are free to use this script as long as the copyright message is kept intact. However, you may not
+	redistribute, sell or repost it without our permission.
+	
+	Updated:
+		
+		March, 14th, 2006 - Create new tabs dynamically
+		March, 15th, 2006 - Dynamically delete a tab
+		
+	Thank you!
+	
+	www.dhtmlgoodies.com
+	Alf Magne Kalleland
+	
+	************************************************************************************************************/		
+	var textPadding = 3; // Padding at the left of tab text - bigger value gives you wider tabs
+	var strictDocType = true; 
+	var tabView_maxNumberOfTabs = 6;	// Maximum number of tabs
+	
+	/* Don't change anything below here */
+	var dhtmlgoodies_tabObj = new Array();
+	var activeTabIndex = new Array();
+	var MSIE = navigator.userAgent.indexOf('MSIE')>=0?true:false;
+	
+	var regExp = new RegExp(".*MSIE ([0-9]\.[0-9]).*","g");
+	var navigatorVersion = navigator.userAgent.replace(regExp,'$1');
+	
+	var ajaxObjects = new Array();
+	var tabView_countTabs = new Array();
+	var tabViewHeight = new Array();
+	var tabDivCounter = 0;
+	var closeImageHeight = 8;	// Pixel height of close buttons
+	var closeImageWidth = 8;	// Pixel height of close buttons
+	
+	
+	function setPadding(obj,padding){
+		var span = obj.getElementsByTagName('SPAN')[0];
+		span.style.paddingLeft = padding + 'px';	
+		span.style.paddingRight = padding + 'px';	
+	}
+	function showTab(parentId,tabIndex)
+	{
+		var parentId_div = parentId + "_";
+		if(!document.getElementById('tabView' + parentId_div + tabIndex)){
+			return;
+		}
+		if(activeTabIndex[parentId]>=0){
+			if(activeTabIndex[parentId]==tabIndex){
+				return;
+			}
+	
+			var obj = document.getElementById('tabTab'+parentId_div + activeTabIndex[parentId]);
+			
+			obj.className='tabInactive';
+			var img = obj.getElementsByTagName('IMG')[0];
+			if(img.src.indexOf('tab_')==-1)img = obj.getElementsByTagName('IMG')[1];
+			img.src = 'images/tab_right_inactive.gif';
+			document.getElementById('tabView' + parentId_div + activeTabIndex[parentId]).style.display='none';
+		}
+		
+		var thisObj = document.getElementById('tabTab'+ parentId_div +tabIndex);	
+			
+		thisObj.className='tabActive';
+		var img = thisObj.getElementsByTagName('IMG')[0];
+		if(img.src.indexOf('tab_')==-1)img = thisObj.getElementsByTagName('IMG')[1];
+		img.src = 'images/tab_right_active.gif';
+		
+		document.getElementById('tabView' + parentId_div + tabIndex).style.display='block';
+		activeTabIndex[parentId] = tabIndex;
+		
+
+		var parentObj = thisObj.parentNode;
+		var aTab = parentObj.getElementsByTagName('DIV')[0];
+		countObjects = 0;
+		var startPos = 2;
+		var previousObjectActive = false;
+		while(aTab){
+			if(aTab.tagName=='DIV'){
+				if(previousObjectActive){
+					previousObjectActive = false;
+					startPos-=2;
+				}
+				if(aTab==thisObj){
+					startPos-=2;
+					previousObjectActive=true;
+					setPadding(aTab,textPadding+1);
+				}else{
+					setPadding(aTab,textPadding);
+				}
+				
+				aTab.style.left = startPos + 'px';
+				countObjects++;
+				startPos+=2;
+			}			
+			aTab = aTab.nextSibling;
+		}
+		
+		return;
+	}
+	
+	function tabClick()
+	{
+		var idArray = this.id.split('_');		
+		showTab(this.parentNode.parentNode.id,idArray[idArray.length-1].replace(/[^0-9]/gi,''));
+		
+	}
+	
+	function rolloverTab()
+	{
+		if(this.className.indexOf('tabInactive')>=0){
+			this.className='inactiveTabOver';
+			var img = this.getElementsByTagName('IMG')[0];
+			if(img.src.indexOf('tab_')<=0)img = this.getElementsByTagName('IMG')[1];
+			img.src = 'images/tab_right_over.gif';
+		}
+		
+	}
+	function rolloutTab()
+	{
+		if(this.className ==  'inactiveTabOver'){
+			this.className='tabInactive';
+			var img = this.getElementsByTagName('IMG')[0];
+			if(img.src.indexOf('tab_')<=0)img = this.getElementsByTagName('IMG')[1];
+			img.src = 'images/tab_right_inactive.gif';
+		}
+		
+	}
+	
+	function hoverTabViewCloseButton()
+	{
+		this.src = this.src.replace('close.gif','close_over.gif');
+	}
+	
+	function stopHoverTabViewCloseButton()
+	{
+		this.src = this.src.replace('close_over.gif','close.gif');
+	}
+	
+	function initTabs(mainContainerID,tabTitles,activeTab,width,height,closeButtonArray,additionalTab)
+	{
+		if(!closeButtonArray)closeButtonArray = new Array();
+		
+		if(!additionalTab || additionalTab=='undefined'){			
+			dhtmlgoodies_tabObj[mainContainerID] = document.getElementById(mainContainerID);
+			width = width + '';
+			if(width.indexOf('%')<0)width= width + 'px';
+			dhtmlgoodies_tabObj[mainContainerID].style.width = width;
+						
+			height = height + '';
+			if(height.length>0){
+				if(height.indexOf('%')<0)height= height + 'px';
+				dhtmlgoodies_tabObj[mainContainerID].style.height = height;
+			}
+			
+
+			tabViewHeight[mainContainerID] = height;
+			
+			var tabDiv = document.createElement('DIV');		
+			var firstDiv = dhtmlgoodies_tabObj[mainContainerID].getElementsByTagName('DIV')[0];	
+			
+			dhtmlgoodies_tabObj[mainContainerID].insertBefore(tabDiv,firstDiv);	
+			tabDiv.className = 'dhtmlgoodies_tabPane';			
+			tabView_countTabs[mainContainerID] = 0;
+
+		}else{
+			var tabDiv = dhtmlgoodies_tabObj[mainContainerID].getElementsByTagName('DIV')[0];
+			var firstDiv = dhtmlgoodies_tabObj[mainContainerID].getElementsByTagName('DIV')[1];
+			height = tabViewHeight[mainContainerID];
+			activeTab = tabView_countTabs[mainContainerID];		
+	
+			
+		}
+		
+		
+		
+		for(var no=0;no<tabTitles.length;no++){
+			var aTab = document.createElement('DIV');
+			aTab.id = 'tabTab' + mainContainerID + "_" +  (no + tabView_countTabs[mainContainerID]);
+			aTab.onmouseover = rolloverTab;
+			aTab.onmouseout = rolloutTab;
+			aTab.onclick = tabClick;
+			aTab.className='tabInactive';
+			tabDiv.appendChild(aTab);
+			var span = document.createElement('SPAN');
+			span.innerHTML = tabTitles[no];
+			span.style.position = 'relative';
+			aTab.appendChild(span);
+			
+			if(closeButtonArray[no]){
+				var closeButton = document.createElement('IMG');
+				closeButton.src = 'images/close.gif';
+				closeButton.height = closeImageHeight + 'px';
+				closeButton.width = closeImageHeight + 'px';
+				closeButton.setAttribute('height',closeImageHeight);
+				closeButton.setAttribute('width',closeImageHeight);
+				closeButton.style.position='absolute';
+				closeButton.style.top = '6px';
+				closeButton.style.right = '0px';
+				closeButton.onmouseover = hoverTabViewCloseButton;
+				closeButton.onmouseout = stopHoverTabViewCloseButton;
+				
+				span.innerHTML = span.innerHTML + '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;';	
+				
+				var deleteTxt = span.innerHTML+'';
+
+				closeButton.onclick = function(){ deleteTab(this.parentNode.innerHTML) };
+				span.appendChild(closeButton);
+			}
+			
+			var img = document.createElement('IMG');
+			img.valign = 'bottom';
+			img.src = 'images/tab_right_inactive.gif';
+			// IE5.X FIX
+			if((navigatorVersion && navigatorVersion<6) || (MSIE && !strictDocType)){
+				img.style.styleFloat = 'none';
+				img.style.position = 'relative';	
+				img.style.top = '4px'
+				span.style.paddingTop = '4px';
+				aTab.style.cursor = 'hand';
+			}	// End IE5.x FIX
+			aTab.appendChild(img);
+		}
+
+		var tabs = dhtmlgoodies_tabObj[mainContainerID].getElementsByTagName('DIV');
+		var divCounter = 0;
+		for(var no=0;no<tabs.length;no++){
+			if(tabs[no].className=='dhtmlgoodies_aTab' && tabs[no].parentNode.id == mainContainerID){
+				if(height.length>0)tabs[no].style.height = height;
+				tabs[no].style.display='none';
+				tabs[no].id = 'tabView' + mainContainerID + "_" + divCounter;
+				divCounter++;
+			}			
+		}	
+		tabView_countTabs[mainContainerID] = tabView_countTabs[mainContainerID] + tabTitles.length;	
+		showTab(mainContainerID,activeTab);
+
+		return activeTab;
+	}	
+	
+	function showAjaxTabContent(ajaxIndex,parentId,tabId)
+	{
+		var obj = document.getElementById('tabView'+parentId + '_' + tabId);
+		obj.innerHTML = ajaxObjects[ajaxIndex].response;		
+	}
+	
+	function resetTabIds(parentId)
+	{
+		var tabTitleCounter = 0;
+		var tabContentCounter = 0;
+		
+		
+		var divs = dhtmlgoodies_tabObj[parentId].getElementsByTagName('DIV');
+
+		
+		for(var no=0;no<divs.length;no++){
+			if(divs[no].className=='dhtmlgoodies_aTab'){
+				divs[no].id = 'tabView' + parentId + '_' + tabTitleCounter;
+				tabTitleCounter++;
+			}
+			if(divs[no].id.indexOf('tabTab')>=0){
+				divs[no].id = 'tabTab' + parentId + '_' + tabContentCounter;	
+				tabContentCounter++;
+			}	
+			
+				
+		}
+	
+		tabView_countTabs[parentId] = tabContentCounter;
+	}
+	
+	
+	function createNewTab(parentId,tabTitle,tabContent,tabContentUrl,closeButton)
+	{
+		if(tabView_countTabs[parentId]>=tabView_maxNumberOfTabs)return;	// Maximum number of tabs reached - return
+		var div = document.createElement('DIV');
+		div.className = 'dhtmlgoodies_aTab';
+		dhtmlgoodies_tabObj[parentId].appendChild(div);		
+
+		var tabId = initTabs(parentId,Array(tabTitle),0,'','',Array(closeButton),true);
+		if(tabContent)div.innerHTML = tabContent;
+		if(tabContentUrl){		
+			var ajaxIndex = ajaxObjects.length;
+			ajaxObjects[ajaxIndex] = new sack();
+			ajaxObjects[ajaxIndex].requestFile = tabContentUrl;	// Specifying which file to get
+
+			ajaxObjects[ajaxIndex].onCompletion = function(){ showAjaxTabContent(ajaxIndex,parentId,tabId); };	// Specify function that will be executed after file has been found
+			ajaxObjects[ajaxIndex].runAJAX();		// Execute AJAX function	
+		
+		}
+				
+	}
+	
+	function getTabIndexByTitle(tabTitle)
+	{
+		var regExp = new RegExp("(.*?)&nbsp.*$","gi");
+		tabTitle = tabTitle.replace(regExp,'$1');
+		for(var prop in dhtmlgoodies_tabObj){
+			var divs = dhtmlgoodies_tabObj[prop].getElementsByTagName('DIV');
+			for(var no=0;no<divs.length;no++){
+				if(divs[no].id.indexOf('tabTab')>=0){
+					var span = divs[no].getElementsByTagName('SPAN')[0];
+					var regExp2 = new RegExp("(.*?)&nbsp.*$","gi");
+					var spanTitle = span.innerHTML.replace(regExp2,'$1');
+					
+					if(spanTitle == tabTitle){
+						
+						var tmpId = divs[no].id.split('_');						
+						return Array(prop,tmpId[tmpId.length-1].replace(/[^0-9]/g,'')/1);
+					}		
+				}
+			}
+		}
+		
+		return -1;
+		
+	}
+	
+	/* Call this function if you want to display some content from external file in one of the tabs 
+	Arguments: Title of tab and relative path to external file */
+	
+	function addAjaxContentToTab(tabTitle,tabContentUrl)
+	{
+		var index = getTabIndexByTitle(tabTitle);
+		if(index!=-1){
+			var ajaxIndex = ajaxObjects.length;
+			
+			tabId = index[1];
+			parentId = index[0];
+			
+			
+			ajaxObjects[ajaxIndex] = new sack();
+			ajaxObjects[ajaxIndex].requestFile = tabContentUrl;	// Specifying which file to get
+
+			ajaxObjects[ajaxIndex].onCompletion = function(){ showAjaxTabContent(ajaxIndex,parentId,tabId); };	// Specify function that will be executed after file has been found
+			ajaxObjects[ajaxIndex].runAJAX();		// Execute AJAX function				
+			
+		}	
+	}
+
+	
+	
+	function deleteTab(tabLabel,tabIndex,parentId)
+	{
+
+		if(tabLabel){
+			var index = getTabIndexByTitle(tabLabel);
+			if(index!=-1){
+				deleteTab(false,index[1],index[0]);
+			}
+			
+		}else if(tabIndex>=0){
+			if(document.getElementById('tabTab' + parentId + '_' + tabIndex)){
+				var obj = document.getElementById('tabTab' + parentId + '_' + tabIndex);
+				var id = obj.parentNode.parentNode.id;
+				obj.parentNode.removeChild(obj);
+				var obj2 = document.getElementById('tabView' + parentId + '_' + tabIndex);
+				obj2.parentNode.removeChild(obj2);
+				resetTabIds(parentId);
+				activeTabIndex[parentId]=-1;
+				showTab(parentId,'0');
+			}			
+		}
+		
+
+			
+		
+		
+	}
+	
+	
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/index.html
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/index.html	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/index.html	(revision 6808)
@@ -0,0 +1,354 @@
+<html>
+
+  <head>
+
+    <title>NEMO Trusting Dashboard</title>
+    <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+    <script type="text/javascript" src="html/sortabletable.js"></script>
+    <link type="text/css" rel="StyleSheet" href="html/sortabletable.css" />
+    <link rel="stylesheet" href="html/tab-view.css" type="text/css" media="screen">
+    <script type="text/javascript" src="html/tab-view.js"></script>
+    <style type="text/css">
+      body    { font-family:Helvetica, Arial, Sans-Serif;                      	    	      }
+      a1      { color:#000000; text-decoration:none;                           	    	      }
+      .title  { background:#AABBBB; font-weight:bold;                          	    	      }
+      .even   { background:#eee;                                               	    	      }
+      .odd    { background:#ddd;                                               	    	      }
+      td      { font-family:Arial    ; font-size:10pt; padding:1px 5px 1px 5px;	    	      }
+      .td1    { font-family:Monospace; font-size:10pt; padding:1px 5px 1px 5px;	    	      }
+      .table1 { background:#E6EEC9; border-collapse:collapse;                  	    	      }
+      .table2 { background:#E6EEC9; border-collapse:collapse;                  	    	      }
+      .myh3   { font-weight:bold; font-style:italic; font-family:Arial,Helvetica,sans-serif
+                background-color:#FFD700; border:2px outset #FFFFFF
+                padding: 1px 20px 1px 20px; width:120px; -moz-border-radius:6px 6px 6px 6px;  }
+    </style>
+
+  </head>
+
+  <body>
+
+    <?php
+       ini_set('display_errors', 'Off'); error_reporting(E_ALL);
+       include 'read_trusting.php';
+       $DODS_TGCC="http://dods.extra.cea.fr/store/martin/trusting"; $DODS_IDRIS="http://dodsp.idris.fr/romr005/trusting";
+       $file_headers=get_headers("${DODS_TGCC}/ORCA2_LIM_PISCES/nemo_v3_6_STABLE/trusting_info.html");
+       if ($file_headers[0] == '' ) { $LOCATION="./src/martin"; } else { $LOCATION="${DODS_TGCC}"; }
+    ?>
+
+       <!--$ctx=stream_context_create(array('http'=>array('timeout'=>1)));
+       $test=file_get_contents("${DODS_TGCC}/ORCA2_LIM_PISCES/nemo_v3_6_STABLE/trusting_info.html", 0, $ctx);
+       if ($test == FALSE ) { $LOCATION="./src/martin"; } else { $LOCATION="${DODS_TGCC}"; }-->
+
+    <!-----Begin NEMO trust----->
+    <div id="dhtmlgoodies_tabViewNEMO">
+
+      <!-----Begin v36 trust----->
+      <?php $BRANCH="nemo_v3_6_STABLE" ?>
+      <div class="dhtmlgoodies_aTab">
+	<div id="dhtmlgoodies_tabViewConf">
+
+	  <!-----Begin O2LP trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA2_LIM_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html"); ?>
+	    <div id="dhtmlgoodies_tabViewHPCC">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-1" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-1"),
+	                   [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-2" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-2"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O2LP trust----->
+
+	  <!-----Begin O1L3P trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA1_LIM3_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC2">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-3" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-3"),
+	                   [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-4" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-4"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O1L3P trust----->
+
+	  <!-----Begin AMM12 trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="AMM12"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC3">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-5" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-5"),
+	                   [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-6" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-6"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End AMM12 trust----->
+
+	</div>
+      </div>
+      <!-----End v36 trust----->
+
+
+      <!-----Begin trunk trust----->
+      <?php $BRANCH="trunk" ?>
+      <div class="dhtmlgoodies_aTab">
+	<div id="dhtmlgoodies_tabViewConf2">
+
+	  <!-----Begin O2LP trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA2_LIM_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC4">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-7" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-7"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End   Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-8" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-8"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O2LP trust----->
+
+	  <!-----Begin O1L3P trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA1_LIM3_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC5">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-9" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-9"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End   Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-10" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-10"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O1L3P trust----->
+
+	  <!-----Begin AMM12 trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="AMM12"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC6">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-11" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-11"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End   Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-12" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-12"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O1L3P trust----->
+
+	</div>
+      </div>
+      <!-----End trunk trust----->
+
+    </div>
+    <!-----End NEMO trust----->
+
+    <!-------------------------------------------------------------------------------------------->
+    <script type="text/javascript">
+      initTabs('dhtmlgoodies_tabViewNEMO'        ,
+               Array('<B>&nbsp;3.6&nbsp;  </B>',
+	             '<B>&nbsp;trunk&nbsp;</B>' 
+                                                ),
+               0,1820,15100                      ,
+               Array(false)                       )
+      initTabs('dhtmlgoodies_tabViewConf'                                        ,
+               Array('<B style="color: green">&nbsp;ORCA2_LIM_PISCES&nbsp;  </B>',
+	       	     '<B style="color: green">&nbsp;ORCA1_LIM3_PISCES&nbsp; </B>',
+	       	     '<B style="color: green">&nbsp;AMM12&nbsp;             </B>',
+	       	     '<B style="color: red  ">&nbsp;C1D_PAPA&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE&nbsp;              </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_BFM&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_PISCES&nbsp;       </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_XIOS&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM3&nbsp;        </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM_CFC_C14b&nbsp;</B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_OFF_PISCES&nbsp;  </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_SAS_LIM&nbsp;     </B>' 
+	                                                                          ),
+               0,1810,15050                                                        ,
+               Array(false)                                                         )
+      initTabs('dhtmlgoodies_tabViewConf2'                                       ,
+               Array('<B style="color: green">&nbsp;ORCA2_LIM_PISCES&nbsp;  </B>',
+	       	     '<B style="color: green">&nbsp;ORCA1_LIM3_PISCES&nbsp; </B>',
+	       	     '<B style="color: green">&nbsp;AMM12&nbsp;             </B>',
+	       	     '<B style="color: red  ">&nbsp;C1D_PAPA&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE&nbsp;              </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_BFM&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_PISCES&nbsp;       </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_XIOS&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM3&nbsp;        </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM_CFC_C14b&nbsp;</B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_OFF_PISCES&nbsp;  </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_SAS_LIM&nbsp;     </B>' 
+	                                                                          ),
+               0,1810,15050                                                        ,
+               Array(false)                                                         )
+      initTabs('dhtmlgoodies_tabViewHPCC'                         ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC2'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC3'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC4'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC5'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC6'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+    </script>
+    <!-------------------------------------------------------------------------------------------->
+
+  </body>
+
+</html>
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/index.php
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/index.php	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/index.php	(revision 6808)
@@ -0,0 +1,354 @@
+<html>
+
+  <head>
+
+    <title>Trusting Dashboard</title>
+    <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+    <script type="text/javascript" src="html/sortabletable.js"></script>
+    <link type="text/css" rel="StyleSheet" href="html/sortabletable.css" />
+    <link rel="stylesheet" href="html/tab-view.css" type="text/css" media="screen">
+    <script type="text/javascript" src="html/tab-view.js"></script>
+    <style type="text/css">
+      body    { font-family:Helvetica, Arial, Sans-Serif;                      	    	      }
+      a1      { color:#000000; text-decoration:none;                           	    	      }
+      .title  { background:#AABBBB; font-weight:bold;                          	    	      }
+      .even   { background:#eee;                                               	    	      }
+      .odd    { background:#ddd;                                               	    	      }
+      td      { font-family:Arial    ; font-size:10pt; padding:1px 5px 1px 5px;	    	      }
+      .td1    { font-family:Monospace; font-size:10pt; padding:1px 5px 1px 5px;	    	      }
+      .table1 { background:#E6EEC9; border-collapse:collapse;                  	    	      }
+      .table2 { background:#E6EEC9; border-collapse:collapse;                  	    	      }
+      .myh3   { font-weight:bold; font-style:italic; font-family:Arial,Helvetica,sans-serif
+                background-color:#FFD700; border:2px outset #FFFFFF
+                padding: 1px 20px 1px 20px; width:120px; -moz-border-radius:6px 6px 6px 6px;  }
+    </style>
+
+  </head>
+
+  <body>
+
+    <?php
+       ini_set('display_errors', 'Off'); error_reporting(E_ALL);
+       include 'read_trusting.php';
+       $DODS_TGCC="http://dods.extra.cea.fr/store/martin/trusting"; $DODS_IDRIS="http://dodsp.idris.fr/romr005/trusting";
+       $ctx=stream_context_create(array('http'=>array('timeout'=>1)));
+       $test=file_get_contents("${DODS_TGCC}/ORCA2_LIM_PISCES/nemo_v3_6_STABLE/trusting_info.html", 0, $ctx);
+       if ($test == FALSE ) { $LOCATION="./src/martin"; } else { $LOCATION="${DODS_TGCC}"; }
+    ?>
+
+    <!--$file_headers=get_headers("${DODS_TGCC}/ORCA2_LIM_PISCES/nemo_v3_6_STABLE/trusting_info.html");
+       if ($file_headers[0] == '' ) { $LOCATION="./src/martin"; } else { $LOCATION="${DODS_TGCC}"; }-->
+
+    <!-----Begin NEMO trust----->
+    <div id="dhtmlgoodies_tabViewNEMO">
+
+      <!-----Begin v36 trust----->
+      <?php $BRANCH="nemo_v3_6_STABLE" ?>
+      <div class="dhtmlgoodies_aTab">
+	<div id="dhtmlgoodies_tabViewConf">
+
+	  <!-----Begin O2LP trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA2_LIM_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html"); ?>
+	    <div id="dhtmlgoodies_tabViewHPCC">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-1" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-1"),
+	                   [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-2" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-2"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O2LP trust----->
+
+	  <!-----Begin O1L3P trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA1_LIM3_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC2">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-3" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-3"),
+	                   [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-4" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-4"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O1L3P trust----->
+
+	  <!-----Begin AMM12 trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="AMM12"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC3">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-5" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-5"),
+	                   [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-6" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-6"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End AMM12 trust----->
+
+	</div>
+      </div>
+      <!-----End v36 trust----->
+
+
+      <!-----Begin trunk trust----->
+      <?php $BRANCH="trunk" ?>
+      <div class="dhtmlgoodies_aTab">
+	<div id="dhtmlgoodies_tabViewConf2">
+
+	  <!-----Begin O2LP trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA2_LIM_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC4">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-7" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-7"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End   Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-8" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-8"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O2LP trust----->
+
+	  <!-----Begin O1L3P trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA1_LIM3_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC5">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-9" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-9"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End   Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-10" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-10"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O1L3P trust----->
+
+	  <!-----Begin AMM12 trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="AMM12"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC6">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-11" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-11"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End   Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-12" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-12"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O1L3P trust----->
+
+	</div>
+      </div>
+      <!-----End trunk trust----->
+
+    </div>
+    <!-----End NEMO trust----->
+
+    <!-------------------------------------------------------------------------------------------->
+    <script type="text/javascript">
+      initTabs('dhtmlgoodies_tabViewNEMO'        ,
+               Array('<B>&nbsp;3.6&nbsp;  </B>',
+	             '<B>&nbsp;trunk&nbsp;</B>' 
+                                                ),
+               0,1820,15100                      ,
+               Array(false)                       )
+      initTabs('dhtmlgoodies_tabViewConf'                                        ,
+               Array('<B style="color: green">&nbsp;ORCA2_LIM_PISCES&nbsp;  </B>',
+	       	     '<B style="color: green">&nbsp;ORCA1_LIM3_PISCES&nbsp; </B>',
+	       	     '<B style="color: green">&nbsp;AMM12&nbsp;             </B>',
+	       	     '<B style="color: red  ">&nbsp;C1D_PAPA&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE&nbsp;              </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_BFM&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_PISCES&nbsp;       </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_XIOS&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM3&nbsp;        </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM_CFC_C14b&nbsp;</B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_OFF_PISCES&nbsp;  </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_SAS_LIM&nbsp;     </B>' 
+	                                                                          ),
+               0,1810,15050                                                        ,
+               Array(false)                                                         )
+      initTabs('dhtmlgoodies_tabViewConf2'                                       ,
+               Array('<B style="color: green">&nbsp;ORCA2_LIM_PISCES&nbsp;  </B>',
+	       	     '<B style="color: green">&nbsp;ORCA1_LIM3_PISCES&nbsp; </B>',
+	       	     '<B style="color: green">&nbsp;AMM12&nbsp;             </B>',
+	       	     '<B style="color: red  ">&nbsp;C1D_PAPA&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE&nbsp;              </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_BFM&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_PISCES&nbsp;       </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_XIOS&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM3&nbsp;        </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM_CFC_C14b&nbsp;</B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_OFF_PISCES&nbsp;  </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_SAS_LIM&nbsp;     </B>' 
+	                                                                          ),
+               0,1810,15050                                                        ,
+               Array(false)                                                         )
+      initTabs('dhtmlgoodies_tabViewHPCC'                         ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC2'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC3'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC4'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC5'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC6'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+    </script>
+    <!-------------------------------------------------------------------------------------------->
+
+  </body>
+
+</html>
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/read_trusting.php
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/read_trusting.php	(revision 6808)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TRUST/web/read_trusting.php	(revision 6808)
@@ -0,0 +1,52 @@
+
+<?php
+
+$num=1;
+
+function read_trusting ($file) { 
+
+  global $num;
+  $row = 1;
+
+  if (($handle = fopen($file, "r")) !== FALSE) {
+
+    while (($data = fgetcsv($handle, 1000, ";")) !== FALSE) {
+
+      switch ($row) {
+        case 1: 
+	  $num1 = count($data);
+	  print("<thead>\n\n"); print("<tr class=\"title\">\n");
+	  break;
+        default:	
+	  if   ( $row % 2 == 1 ) { print("<tr class=\"odd\">\n") ; }
+	  else                   { print("<tr class=\"even\">\n"); }
+      }
+
+      $num = count($data);
+      #echo "<p> $num champs ligne $row: <br /></p>\n";
+
+      for ($c=0; $c<$num1; $c++) {
+        #echo $data[$c] . "<br />\n";
+	if ($c > $num ) { $var=""; } else { $var=trim($data[$c]); }
+
+	switch ($var) { 
+	  case "FAILED"   : print("<td bgcolor=\"#FF6666\">".$var."</td>\n"); break;
+	  case "Different": print("<td bgcolor=\"#FFFF99\">".$var."</td>\n"); break;
+	  case "OK"       : print("<td bgcolor=\"#92CA89\">".$var."</td>\n"); break;
+	  default         : print("<td>".$var."</td>\n")                           ;
+	}
+
+      }
+
+      print("</tr>\n\n");
+      if ( $row == 1 ) { print("</thead>\n\n");	print("<tbody>\n\n"); }
+      $row++;
+    }
+
+    fclose($handle);
+  }
+
+  print("</tbody>\n");
+}
+
+?>
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/fcm-make/inc/keys-orca2_lim.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/fcm-make/inc/keys-orca2_lim.cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/fcm-make/inc/keys-orca2_lim.cfg	(revision 6808)
@@ -1,2 +1,2 @@
 preprocess.prop{fpp.defs} = \
-  key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc
+  key_trabbl key_lim2 key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_asminc
Index: /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/fcm-make/inc/keys-orca2_lim3.cfg
===================================================================
--- /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/fcm-make/inc/keys-orca2_lim3.cfg	(revision 6807)
+++ /branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/fcm-make/inc/keys-orca2_lim3.cfg	(revision 6808)
@@ -1,2 +1,2 @@
 preprocess.prop{fpp.defs} = \
-  key_trabbl key_lim3 key_vvl key_dynspg_ts key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc
+  key_trabbl key_lim3 key_vvl key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_asminc
